Return to DIKZ1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIKZ1.m, revision 1.1

1.1     ! snw         1: DIKZ1  ;SFISC/XAK-XREF COMPILER ;04:27 PM  2 Feb 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: NEWR   ;
        !             5:        K ^UTILITY($J) S DRN=""
        !             6:        S ^UTILITY($J,0,1)=DNM_" ; DRIVER FOR COMPILED XREFS FOR FILE #"_DH(1)_" ; "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),^(2)=" ; "
        !             7:        S ^UTILITY($J,0,3)=" N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY"
        !             8:        S ^UTILITY($J,0,4)=" S DIKLK=DIK_DA_"")"" L @(""+""_DIKLK) D DI L @(""-""_DIKLK) G Q"
        !             9:        S ^(5)="DI S DIKM1=0,DIKUM=0,DA(0)="""",DV=0 F  S DV=$O(DA(DV)) Q:DV'>0  S DIKUM=DIKUM+1,DIKUP(DV)=DA(DV)"
        !            10:        S ^(6)=" S:DV="""" DV=-1 S DH(1)="_DH(1)_",DIKUP=DA"
        !            11:        S ^(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 D DA Q"
        !            12:        S ^(8)=" I $D(DIKIL) D:DIKZ1=DH(1) "_$P(DIKGO,",")_" S:DIKZ1=DH(1) DIKM1=1 D:DIKZ1'=DH(1) KILL S DA=DIKUP D:DIKM1>0 KIL1 D DA Q"
        !            13:        S ^(9)=" I $D(DIKST) D:DIKZ1=DH(1) "_$P(DIKGO,",",2)_" D:DIKZ1'=DH(1) SET D DA Q"
        !            14:        S ^(10)=" I $D(DIKSAT) D SET1 D DA Q"
        !            15:        S ^(11)=" Q"
        !            16:        S ^(12)="DA K DA F DV=1:1 Q:'$D(DIKUP(DV))  S DA(DV)=DIKUP(DV)"
        !            17:        S ^(13)=" S DA=DIKUP Q"
        !            18:        S ^(14)="SET1 S (DA,DCNT)=0"
        !            19:        S ^(15)=" S DU=$E(DIK,1,$L(DIK)-1),DIKLK=$S(DIK["","":DU_"")"",1:DU) L @(""+""_DIKLK)"
        !            20:        S ^(16)="C I @(""$O(""_DIK_""DA))'>0"") S DA=$$C1(DA),^(0)=$P(@(DIK_""0)""),U,1,2)_U_DA_U_DCNT K DCNT L @(""-""_DIKLK) Q"
        !            21:        S ^(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 D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C"
        !            22:        S ^(18)=" Q"
        !            23:        S ^(19)="C1(A) Q:$P($G(@(DIK_""A,0)"")),U)]"""" A"
        !            24:        S ^(20)=" F  S @(""A=+$O(""_DIK_""A),-1)"") Q:$P($G(@(DIK_""A,0)"")),U)]""""!(A'>0)"
        !            25:        S ^(21)=" Q A"
        !            26:        S ^(22)="KILL S DIKILL=1,DIKZK=2",DIKR=22,X=2 D SUB
        !            27:        S DIKR=DIKR+1,^(DIKR)=" Q"
        !            28:        S DIKR=DIKR+1,^(DIKR)="SET S DISET=1,DIKZK=1",X=1 D SUB
        !            29:        F DIK8=1:1 S DIKRT=$T(TEXT+DIK8) Q:DIKRT=""  S ^(DIKR+DIK8)=$E(DIKRT,4,999)
        !            30:        S (DRN,DIKR)="",T=0
        !            31:        F DIKZZ=0:0 S DIKZZ=$O(^UTILITY($J,0,DIKZZ)) Q:DIKZZ'>0  S %=^(DIKZZ),T=T+$L(%) I T>DMAX S DIKZOVFL=1 D OVFL^DIKZ11 Q
        !            32:        S T=0 I $D(DIKZOVFL) D SAVE^DIKZ K ^UTILITY($J,0) F DIKZZ=0:0 S DIKZZ=$O(^UTILITY($J,"OVFL",DIKZZ)) Q:DIKZZ'>0  S %=^(DIKZZ) S ^UTILITY($J,0,DIKZZ)=%
        !            33:        I $D(DIKZOVFL) S DRN=0 K ^UTILITY($J,"OVFL")
        !            34:        G SAVE^DIKZ
        !            35:        ;
        !            36: SUB    F DIK8=0:0 S DIK8=$O(DIK(X,DIK8)) Q:DIK8'>0  S DIKR=DIKR+1,^(DIKR)=" I DIKZ1="_DIK8_","_$P(DIK2(DIK8),",",4)_" S "_$P(DIK2(DIK8),",",3)_" D "_DIK(X,DIK8)_" Q"
        !            37:        Q
        !            38: TEXT   ;;
        !            39:        ;; Q
        !            40:        ;;KIL1 K @(DIK_"DA)") Q:'$D(^(0))
        !            41:        ;; S Y=^(0),DH=$S($O(^(0))'>0:0,1:$P(Y,U,4)-1),X=$P($P(Y,U,3),U,DH>0) D 3:X=DA
        !            42:        ;; S ^(0)=$P(Y,U,1,2)_U_X_U_DH
        !            43:        ;; Q
        !            44:        ;;Q K DIKGP,DIKZ1 Q
        !            45:        ;; ;
        !            46:        ;;3 I X>1,$D(^(X-1)) S X=X-1 Q
        !            47:        ;; S DV=1 F X=X:1 S X=X+DV,DV=DV+1 I $O(^(X))'>0 S DU=X-2,DV=1 Q
        !            48:        ;;L S X=$O(^(DU)) Q:X>0  S DU=DU-DV,DV=DV+1 S:DU<0 DU=0 G L
        !            49:        ;; Q
        !            50:        ;;BUL S DIKOZ=1,DIKZA=$P("CREA^DELE",U,DIKZK)_"TE VALUE"
        !            51:        ;; I $D(^DD(DIKZ1,DIKZZ,1,DIKZR,DIKZA)) W "...(`",^(DIKZA),"` BULLETIN WILL NOT BE TRIGGERED) " Q