- LRINTEGL ;SLC/FHS - LOAD INTERGRITY FILE 69.91 ; 4/7/89 00:05 ;
- ;;V~5.0~;LAB;**24**;02/27/90 17:09
- LOAD ;load routines into ^LAB(69.91,VNODE
- D STOP S LOAD=1 D VER^LRINTEG G STOP:Y<0
- S %ZIS="Q" D ^%ZIS G STOP:POP I $D(IO("Q")) S ZTRTN="QUE^LRINTEGL",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="^UTILITY(""LRINTEG"""_","_$J_",",LROSYS=$S(^%ZOSF("OS")["M/VX"!(^%ZOSF("OS")["M/11"):"^ROUTINE(ROU)",1:"^ (ROU)")
- S DA(1)=VNODE,DIE="^LAB(69.91,"_DA(1)_",""ROU"",",DIC(0)="L" 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)="L" 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 K:$D(ZTSK) ^%ZSTK(ZTSK),ZTSK G STOP
- GLB ; Stuff new routine in to global using auto load [if it doesn,t already exist] in global
- K ^UTILITY("LRINTEG",$J) S X=ROU,XCNP=0 X XLOAD I '$D(^UTILITY("LRINTEG",$J,2,0)) S CNT=CNT-1 W !?10,"ONLY ONE LINE IN ROUTINE ",! Q
- I ^UTILITY("LRINTEG",$J,2,0)'[";;V~" D ER2 S CNT=CNT-1 Q
- I ^UTILITY("LRINTEG",$J,2,0)'[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 ^UTILITY("LRINTEG",$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
- X ^%ZIS("C") K DIC,DIE,%ZIS
- K A,BIT,CNT,DIF,ER,I,II,IX,L,LN,LOAD,LROSYS,NT,ROU,SIZE,VER,VERDDT,VNODE,XBIT,XCMP,XCNP,XLOAD,XSIZE,XTEST,YBIT,^UTILITY("LRINTEG",$J) Q
- ER2 ; Error msg when the version being loaded do not match the version selected for auto loading
- W !?10,ROU," is version ",$S($L($P(^UTILITY("LRINTEG",$J,2,0),"~",2)):$P(^(0),"~",2),1:"Unknown ")," NOT LOADED",*7,! Q
- LRINTEGL ;SLC/FHS - LOAD INTERGRITY FILE 69.91 ; 4/7/89 00:05 ;
- +1 ;;V~5.0~;LAB;**24**;02/27/90 17:09
- LOAD ;load routines into ^LAB(69.91,VNODE
- +1 DO STOP
- SET LOAD=1
- DO VER^LRINTEG
- IF Y<0
- GOTO STOP
- +2 SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- GOTO STOP
- IF $DATA(IO("Q"))
- SET ZTRTN="QUE^LRINTEGL"
- 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="^UTILITY(""LRINTEG"""_","_$JOB_","
- SET LROSYS=$SELECT(^%ZOSF("OS")["M/VX"!(^%ZOSF("OS")["M/11"):"^ROUTINE(ROU)",1:"^ (ROU)")
- +2 SET DA(1)=VNODE
- SET DIE="^LAB(69.91,"_DA(1)_",""ROU"","
- SET DIC(0)="L"
- 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)="L"
- 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(ZTSK)
- KILL ^%ZSTK(ZTSK),ZTSK
- GOTO STOP
- GLB ; Stuff new routine in to global using auto load [if it doesn,t already exist] in global
- +1 KILL ^UTILITY("LRINTEG",$JOB)
- SET X=ROU
- SET XCNP=0
- XECUTE XLOAD
- IF '$DATA(^UTILITY("LRINTEG",$JOB,2,0))
- SET CNT=CNT-1
- WRITE !?10,"ONLY ONE LINE IN ROUTINE ",!
- QUIT
- +2 IF ^UTILITY("LRINTEG",$JOB,2,0)'[";;V~"
- DO ER2
- SET CNT=CNT-1
- QUIT
- +3 IF ^UTILITY("LRINTEG",$JOB,2,0)'[VER
- DO ER2
- SET CNT=CNT-1
- QUIT
- +4 IF $DATA(@(DIE_"""B"","""_ROU_""")"))
- SET CNT=CNT-1
- QUIT
- GLB1 IF $DATA(@(DIE_DA_",0)"))
- SET DA=DA+1
- GOTO GLB1
- +1 KILL ^UTILITY("LRINTEG",$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 XECUTE ^%ZIS("C")
- KILL DIC,DIE,%ZIS
- +2 KILL A,BIT,CNT,DIF,ER,I,II,IX,L,LN,LOAD,LROSYS,NT,ROU,SIZE,VER,VERDDT,VNODE,XBIT,XCMP,XCNP,XLOAD,XSIZE,XTEST,YBIT,^UTILITY("LRINTEG",$JOB)
- QUIT
- ER2 ; Error msg when the version being loaded do not match the version selected for auto loading
- +1 WRITE !?10,ROU," is version ",$SELECT($LENGTH($PIECE(^UTILITY("LRINTEG",$JOB,2,0),"~",2)):$PIECE(^(0),"~",2),1:"Unknown ")," NOT LOADED",*7,!
- QUIT
