DIKZ11.m

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 ---DIKZ11   1359     printed  Apr 09, 2024@21:46:50                                                                                                                                                                                                      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