DIKZ11 ;SFISC/DCM-XREF COMPILER ;9/3/93 13:44
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
OVFL ;
S ^UTILITY($J,"OVFL",1)=DNM_0_" ; DRIVER FOR COMPILED XREFS FOR FILE !"_DH(1)_" (cont); "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),^(2)=" ; "
S ^UTILITY($J,0,7)=" I $D(DIKKS) D:DIKZ1=DH(1) "_$P(DIKGO,",")_" S DA=DIKUP D:DIKZ1=DH(1) "_$P(DIKGO,",",2)_" D:DIKZ1'=DH(1) KILL D:DIKZ1'=DH(1) DA D:DIKZ1'=DH(1) SET"_U_DNM_0_" D DA Q"
S ^UTILITY($J,0,9)=" I $D(DIKST) D:DIKZ1=DH(1) "_$P(DIKGO,",",2)_" D:DIKZ1'=DH(1) SET"_U_DNM_0_" D DA Q"
S ^UTILITY($J,0,17)=" S (DIKY,DA)=$O(^(DA)) G C:$P($G(^(DA,0)),U)']"""" S DU=1,DCNT=DCNT+1 S:DA="""" (DIKY,DA)=-1 D:DIKZ1=DH(1) "_$P(DIKGO,",",2)_" D:DIKZ1'=DH(1) SET"_U_DNM_0_" D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C"
F DIKZZ=0:0 S DIKZZ=$O(^UTILITY($J,0,DIKZZ)) Q:DIKZZ="" S %=^(DIKZZ) I $E(%,1,4)="SET " D OVFL1 Q
Q
OVFL1 S DIKZZ1=4,^UTILITY($J,"OVFL",DIKZZ1)=% K ^UTILITY($J,0,DIKZZ)
F S DIKZZ=$O(^UTILITY($J,0,DIKZZ)) Q:DIKZZ="" S %=^(DIKZZ) Q:$E(%,1,5)="KIL1 " S DIKZZ1=DIKZZ1+1,^UTILITY($J,"OVFL",DIKZZ1)=% K ^UTILITY($J,0,DIKZZ)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIKZ11 1359 printed Nov 22, 2024@17:59:10 Page 2
DIKZ11 ;SFISC/DCM-XREF COMPILER ;9/3/93 13:44
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
OVFL ;
+1 SET ^UTILITY($JOB,"OVFL",1)=DNM_0_" ; DRIVER FOR COMPILED XREFS FOR FILE !"_DH(1)_" (cont); "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
SET ^(2)=" ; "
+2 SET ^UTILITY($JOB,0,7)=" I $D(DIKKS) D:DIKZ1=DH(1) "_$PIECE(DIKGO,",")_" S DA=DIKUP D:DIKZ1=DH(1) "_$PIECE(DIKGO,",",2)_" D:DIKZ1'=DH(1) KILL D:DIKZ1'=DH(1) DA D:DIKZ1'=DH(1) SET"_U_DNM_0_" D DA Q"
+3 SET ^UTILITY($JOB,0,9)=" I $D(DIKST) D:DIKZ1=DH(1) "_$PIECE(DIKGO,",",2)_" D:DIKZ1'=DH(1) SET"_U_DNM_0_" D DA Q"
+4 SET ^UTILITY($JOB,0,17)=" S (DIKY,DA)=$O(^(DA)) G C:$P($G(^(DA,0)),U)']"""" S DU=1,DCNT=DCNT+1 S:DA="""" (DIKY,DA)=-1 D:DIKZ1=DH(1) "_$PIECE(DIKGO,",",2)_" D:DIKZ1'=DH(1) SET"_U_DNM_0_" D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C"
+5 FOR DIKZZ=0:0
SET DIKZZ=$ORDER(^UTILITY($JOB,0,DIKZZ))
if DIKZZ=""
QUIT
SET %=^(DIKZZ)
IF $EXTRACT(%,1,4)="SET "
DO OVFL1
QUIT
+6 QUIT
OVFL1 SET DIKZZ1=4
SET ^UTILITY($JOB,"OVFL",DIKZZ1)=%
KILL ^UTILITY($JOB,0,DIKZZ)
+1 FOR
SET DIKZZ=$ORDER(^UTILITY($JOB,0,DIKZZ))
if DIKZZ=""
QUIT
SET %=^(DIKZZ)
if $EXTRACT(%,1,5)="KIL1 "
QUIT
SET DIKZZ1=DIKZZ1+1
SET ^UTILITY($JOB,"OVFL",DIKZZ1)=%
KILL ^UTILITY($JOB,0,DIKZZ)
+2 QUIT
