DavidWhitten at 19:10, 25 July 2019

2019-07-25T19:10:17Z

← Older revision		Revision as of 19:10, 25 July 2019
Line 6:		Line 6:

	<pre>		<pre>
	$ cat ~~/home/djwhitten/r/DEV/~~KBADUTFL.m		$ cat KBADUTFL.m
	KBADUTFL ;DJW ; process First Lines of routines		KBADUTFL ;DJW ; process First Lines of routines
	;;UTILITIES;1.0		;;UTILITIES;1.0

DavidWhitten: Created page with "# first cd to r directory # save first lines into a temporary list head -1 *.m > /tmp/roster.ls wrote MUMPS program KBADUTFL

 $ cat /home/djwhitten/r/DEV/KBADUTFL.m KBA..."

2019-07-25T19:09:29Z

Created page with "# first cd to r directory # save first lines into a temporary list head -1 *.m > /tmp/roster.ls wrote MUMPS program KBADUTFL <pre> $ cat /home/djwhitten/r/DEV/KBADUTFL.m KBA..."

New page

# first cd to r directory
# save first lines into a temporary list
head -1 *.m > /tmp/roster.ls

wrote MUMPS program KBADUTFL

<pre>
$ cat /home/djwhitten/r/DEV/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
</pre>

Hardhats/Roster/script - Revision history

DavidWhitten at 19:10, 25 July 2019

DavidWhitten: Created page with "# first cd to r directory # save first lines into a temporary list head -1 *.m > /tmp/roster.ls wrote MUMPS program KBADUTFL
$ cat /home/djwhitten/r/DEV/KBADUTFL.m KBA..."