LRNITEGL ;SLC/FHS - LOAD INTERGRITY FILE 69.91 ; 4/7/89 00:05 ;
;;5.2;LAB SERVICE;**153**;Sep 27, 1994
LOAD ;load routines into ^LAB(69.91,VNODE
D STOP S LOAD=1 D VER^LRNITEG G STOP:Y<0
S %ZIS="Q" D ^%ZIS G STOP:POP I $D(IO("Q")) S ZTRTN="QUE^LRNITEGL",ZTDESC="Loading LR INTEGRITY file #69.91 ",ZTIO=ION F I="LOAD","VNODE","VER","VERDAT" S ZTSAVE(I)=""
I $D(IO("Q")) D ^%ZTLOAD G STOP
U IO
QUE ;
S U="^",XLOAD=^%ZOSF("LOAD"),DIF="^TMP(""LRNITEG"""_","_$J_",",LROSYS=$S(^%ZOSF("OS")["M/VX"!(^%ZOSF("OS")["M/11")!(^%ZOSF("OS")["Open"):"^ROUTINE(ROU)",1:"^ (ROU)")
S DA(1)=VNODE,DIE="^LAB(69.91,"_DA(1)_",""ROU"",",DIC(0)="L",DLAYGO=69 S:'$D(@(DIE_"0)")) @(DIE_"0)")="^69.911^^" S DA=$S($D(@(DIE_"0)")):+$P(^(0),U,3)+1,1:1) S CNT=$S(DA=1:1,1:+$P(@(DIE_"0)"),U,4)+1)
S (DIC(0),ROU)="LR" F CNT=CNT:1 S ROU=$O(@LROSYS) Q:$E(ROU,1)'="L" W !,ROU D GLB
S $P(@(DIE_"0)"),U,3)=DA,CNT=CNT-1,$P(^(0),U,4)=CNT W !!,"TOTAL = ",CNT,@IOF S:$D(ZTQUEUED) ZTREQ="@" G STOP
GLB ; Stuff new routine in to global using auto load [if it doesn,t already exist] in global
Q:$E(ROU,1,5)="LRINI"!($E(ROU,1,5)="LRLSI")
K ER2,^TMP("LRNITEG",$J) S X=ROU,XCNP=0 X XLOAD I '$D(^TMP("LRNITEG",$J,2,0)) S CNT=CNT-1 W !?10,"ONLY ONE LINE IN ROUTINE ",! Q
I $P(^TMP("LRNITEG",$J,2,0),";",4)'["LAB" S ER2=1 D ER2 S CNT=CNT-1 Q
I $P(^TMP("LRNITEG",$J,2,0),";",3)'=VER D ER2 S CNT=CNT-1 Q
I $D(@(DIE_"""B"","""_ROU_""")")) S CNT=CNT-1 Q
GLB1 I $D(@(DIE_DA_",0)")) S DA=DA+1 G GLB1
K ^TMP("LRNITEG",$J) S DR=".01///^S X="""_ROU_""";" D ^DIE
S $P(@(DIE_"0)"),U,3)=DA,$P(^(0),U,4)=CNT Q
STOP ; clean-up
D ^%ZISC K DIC,DIE,%ZIS,ER2
K A,BIT,CNT,DLAYGO,DIF,ER,I,II,IX,L,LN,LOAD,LROSYS,NT,ROU,SIZE,VER,VERDDT,VNODE,XBIT,XCMP,XCNP,XLOAD,XSIZE,XTEST,YBIT,^TMP("LRNITEG",$J) Q
ER2 ; Error msg when the version being loaded do not match the version selected for auto loading
I $D(ER2) W !?10,ROU," WAS NOT LOADED",! K ER2 Q
W !?10,ROU," is version ",$S($L($P(^TMP("LRNITEG",$J,2,0),";",3)):$P(^(0),";",3),1:"Unknown ")," NOT LOADED",$C(7),! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRNITEGL 2042 printed Oct 16, 2024@18:18:54 Page 2
LRNITEGL ;SLC/FHS - LOAD INTERGRITY FILE 69.91 ; 4/7/89 00:05 ;
+1 ;;5.2;LAB SERVICE;**153**;Sep 27, 1994
LOAD ;load routines into ^LAB(69.91,VNODE
+1 DO STOP
SET LOAD=1
DO VER^LRNITEG
if Y<0
GOTO STOP
+2 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO STOP
IF $DATA(IO("Q"))
SET ZTRTN="QUE^LRNITEGL"
SET ZTDESC="Loading LR INTEGRITY file #69.91 "
SET ZTIO=ION
FOR I="LOAD","VNODE","VER","VERDAT"
SET ZTSAVE(I)=""
+3 IF $DATA(IO("Q"))
DO ^%ZTLOAD
GOTO STOP
+4 USE IO
QUE ;
+1 SET U="^"
SET XLOAD=^%ZOSF("LOAD")
SET DIF="^TMP(""LRNITEG"""_","_$JOB_","
SET LROSYS=$SELECT(^%ZOSF("OS")["M/VX"!(^%ZOSF("OS")["M/11")!(^%ZOSF("OS")["Open"):"^ROUTINE(ROU)",1:"^ (ROU)")
+2 SET DA(1)=VNODE
SET DIE="^LAB(69.91,"_DA(1)_",""ROU"","
SET DIC(0)="L"
SET DLAYGO=69
if '$DATA(@(DIE_"0)"))
SET @(DIE_"0)")="^69.911^^"
SET DA=$SELECT($DATA(@(DIE_"0)")):+$PIECE(^(0),U,3)+1,1:1)
SET CNT=$SELECT(DA=1:1,1:+$PIECE(@(DIE_"0)"),U,4)+1)
+3 SET (DIC(0),ROU)="LR"
FOR CNT=CNT:1
SET ROU=$ORDER(@LROSYS)
if $EXTRACT(ROU,1)'="L"
QUIT
WRITE !,ROU
DO GLB
+4 SET $PIECE(@(DIE_"0)"),U,3)=DA
SET CNT=CNT-1
SET $PIECE(^(0),U,4)=CNT
WRITE !!,"TOTAL = ",CNT,@IOF
if $DATA(ZTQUEUED)
SET ZTREQ="@"
GOTO STOP
GLB ; Stuff new routine in to global using auto load [if it doesn,t already exist] in global
+1 if $EXTRACT(ROU,1,5)="LRINI"!($EXTRACT(ROU,1,5)="LRLSI")
QUIT
+2 KILL ER2,^TMP("LRNITEG",$JOB)
SET X=ROU
SET XCNP=0
XECUTE XLOAD
IF '$DATA(^TMP("LRNITEG",$JOB,2,0))
SET CNT=CNT-1
WRITE !?10,"ONLY ONE LINE IN ROUTINE ",!
QUIT
+3 IF $PIECE(^TMP("LRNITEG",$JOB,2,0),";",4)'["LAB"
SET ER2=1
DO ER2
SET CNT=CNT-1
QUIT
+4 IF $PIECE(^TMP("LRNITEG",$JOB,2,0),";",3)'=VER
DO ER2
SET CNT=CNT-1
QUIT
+5 IF $DATA(@(DIE_"""B"","""_ROU_""")"))
SET CNT=CNT-1
QUIT
GLB1 IF $DATA(@(DIE_DA_",0)"))
SET DA=DA+1
GOTO GLB1
+1 KILL ^TMP("LRNITEG",$JOB)
SET DR=".01///^S X="""_ROU_""";"
DO ^DIE
+2 SET $PIECE(@(DIE_"0)"),U,3)=DA
SET $PIECE(^(0),U,4)=CNT
QUIT
STOP ; clean-up
+1 DO ^%ZISC
KILL DIC,DIE,%ZIS,ER2
+2 KILL A,BIT,CNT,DLAYGO,DIF,ER,I,II,IX,L,LN,LOAD,LROSYS,NT,ROU,SIZE,VER,VERDDT,VNODE,XBIT,XCMP,XCNP,XLOAD,XSIZE,XTEST,YBIT,^TMP("LRNITEG",$JOB)
QUIT
ER2 ; Error msg when the version being loaded do not match the version selected for auto loading
+1 IF $DATA(ER2)
WRITE !?10,ROU," WAS NOT LOADED",!
KILL ER2
QUIT
+2 WRITE !?10,ROU," is version ",$SELECT($LENGTH($PIECE(^TMP("LRNITEG",$JOB,2,0),";",3)):$PIECE(^(0),";",3),1:"Unknown ")," NOT LOADED",$CHAR(7),!
QUIT
