Hardhats/Roster/script

From VistApedia
Jump to: navigation, search
  1. first cd to r directory
  2. save first lines into a temporary list

head -1 *.m > /tmp/roster.ls

wrote MUMPS program KBADUTFL

$ cat KBADUTFL.m
KBADUTFL        ;DJW ; process First Lines of routines
        ;;UTILITIES;1.0
ROSTER  ; Create a roster of Hardhats
        N %,F,L,LN,COUNT
        S F="/tmp/"_$T(+0)_"_roster.lis"
        ZSY "rm "_F
        ZSY "head -1q *.m > "_F
        U $P W !," Processing first line list in "_F
        U $P W !,"Start time: "_$$FMTE^XLFDT($$NOW^XLFDT)
        D CHKINI
%OPENF  O F:(readonly) U F
        F L=0:1 Q:$ZEOF  D
%GETLN  . U F R LN
        . Q:$L(LN)=0  S %=1 ; tval(exception not seen?)
        .   ; I LN="PAD(st,ch,len)" S %=0 ; ignore this exception
        .   ; I LN="C9CTEST2" S %=0
        .   ; if no semicolon, save in COUNT and go on.
        . I LN'[";" S %=$I(COUNT("no semicolon")),%=0
        .   ; must have semicolon or unusual
        . I %,LN'?.1"%".1A.32AN.E1";".E U $P W !,"Line "_L_" unusual. ",!,LN BREAK  HALT
        .   ; get routine name to check against file name
%CHKTAG . S LN(1)=$TR($P(LN,";"),$C(9)," ")
        . I LN(1)'?.1"%".1A.32AN.1(1"(".ANP.1")")." " U $P W !,"Line "_L_" bad tag format. ",!,LN BREAK  HALT
        .   ; LN(0)=what ';' piece we are examining
%CHKINI . S LN(0)=2,LN(2)=$P(LN,";",2) I LN(2)="" S LN(0)=3,LN(2)=$P(LN,";",3)
        . S %=0 ;%=tval(pattern seen?) note:% reverse polarity rest of patterns
        . D CHKSTOP(0)
        .   ;note: Infinite? or just really longtime? loops inside pattern match:
        .   ; LN(2)="Get OR/EE teams that a patient is assigned to, Get all users assigned to
        .   ;  these teams, find patients on no teams, find patients on autolink team
        .   ;  s who are not inpatients, remove patients from autolink teams who are
        .   ;  not inpatients"
        .   ; I '%,LN(2)?.E1(." "3A1"/".E3A." ").E1(." "3A1"/".E3A." ").E S %=$I(COUNT("more than one 3A/3A"))
%CHKP1  . I '%,LN(2)?.E." "3.A1"/".E3.A." ".E." "3.A1"/".E3.A." ".E D
        . . S %=$I(COUNT("more than one 3A/3A"))
        . . ; S LN(21)=$P(LN(2),"/"),LN(22)=$P(LN(2),"/",2),LN(23)=$P(LN(2),"/",3)
        . . S %=$I(COUNT("more than one 3A/3A","LEN slashes",$L(LN(2),"/")))
        . DO CHKSTOP(1)
%CHKP2  . I '%,LN(2)?.E3.A1"/".E3.A.E S %=$I(COUNT("only one 3A/3A"))
        . DO CHKSTOP(2)
%CHKP3  . I '%,LN(2)?.E3A.E S %=$I(COUNT("only one 3A"))
        . DO CHKSTOP(3)
        . ; probable bug I LN(2)?.E1N.E,LN(2)?.E1(." "3.AN1"/".E3.AN." ").E1(." "3.AN1"/".E3.AN." ").E D
        . S %=0
%CHKP4  . I LN(2)?.E1N.E,LN(2)?.E." "3.AN1"/".E3.AN." ".E." "3.AN1"/".E3.AN." ".E D
        . . S %=$I(COUNT("more than one 3AN/3AN"))
        . . S %=$I(COUNT("more than one 3A/3A","LEN slashes",$L(LN(2),"/")))
        . . I $L(LN(2),"/")=9 D CHKSHOW
        . DO CHKSTOP(4)
%CHKP5  . I '%,LN(2)?.E1N.E,LN(2)?.E3.AN1"/".E3.AN.E S %=$I(COUNT("only one 3AN/3AN"))
        . DO CHKSTOP(5)
%CHKP6  . I '%,LN(2)?.E3AN.E S %=$I(COUNT("only one 3AN"))
        . DO CHKSTOP(6)
%CHKP7  . I '% S %=$I(COUNT("no initials"))
        . ;DO CHKSTOP(7)
%CHKP8  . ;I '%!(L#100=0) S %("NO BREAK")=1 D CHKSHOW K % S %=1
        . ;DO CHKSTOP(9)
%CHKP9  . ;I '%!(L#1000=0) S %("NO BREAK")=1 D CHKSHOW K % S %=1
        . I '%!(L#10000=0) I L'=0 D CHKSHOW
        . D CHKSTOP(8)
        C F
        U $P W !,"Results: ",! D CHKSHOW
        U $P W !,"Finish Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
        QUIT
CHKINI  ;
        K ^XUTL($T(+0),"CHKSHOW")
        K ^XUTL($T(+0),"ROU LINE")
        K ^XUTL($T(+0),"ROU STEP")
        K ^XUTL($T(+0),"PROGRESS")
        QUIT
CHKSTOP(STEP)   ;
        S ^XUTL($T(+0),"ROU LINE")=L,^XUTL($T(+0),"ROU STEP")=STEP
        U $P R LN:0 I '$T&(LN'="") U $P W !,"Key Pressed",! D CHKSHOW
        QUIT
CHKSHOW ;
        ;; S ^XUTL($T(+0),"ROU LINE")=L,^XUTL($T(+0),"ROU STEP")=STEP
        U $P ZSHOW "V":^XUTL($T(+0),"CHKSHOW",L)
        N V W ! F V="COUNT","L","F","LN" D
        . X "ZWR:$D("_V_") "_V_"(*)"
        W !
        ;; ; U $P W ! ZWR L,LN,COUNT
        BREAK:'$G(%("NO BREAK"))
        QUIT
PROGSHOW        ;
        ZWR ^XUTL("KBADUTFL",*)
        Q