Return to DIKZ2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIKZ2.m, revision 1.1

1.1     ! snw         1: DIKZ2  ;SFISC/XAK-XREF COMPILER ;11/12/91  1:05 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S DIKR=DIKR+1
        !             5:        S DIK1=" I $D("_DIKVR_") K DIKLM S:$D(DA("_A_")) DIKLM=1 G:$D(DA("_A_")) "_A
        !             6:        F DIK4=A:-1:1 S DIK8=DIK4-1 Q:DIK8=0  S DIK1=DIK1_" S DA("_DIK4_")=DA("_DIK8_")"
        !             7:        S ^UTILITY($J,DIKR)=DIK1_" S DA(1)=DA,DA=0 G @DIKM1"
        !             8:        S DIKR=DIKR+1,DIKCT=0 I A>1 D DAR
        !             9:        S ^UTILITY($J,DIKR)=A-1_" ;",DIKR=DIKR+1
        !            10:        S DIKCT=DIKCT+1,DIKL2=A-1,DIK1=$C(64+DIKCT)_" S DA=$O("_DIK2_DIK8(DH)_"DA))"
        !            11:        S ^UTILITY($J,DIKR)=DIK1_" I DA'>0 S DA=0 "_$S(DIKL2=0:"",1:"Q:DIKM1="_DIKL2_"  ")_"G "_$S(A'<2:$C(64+A-1),1:"END"),DIKR=DIKR+1
        !            12:        K DIK6
        !            13:        Q
        !            14: CRT    ;
        !            15:        I '$D(^DD(DV,"IX")) K DU(DV) Q
        !            16:        S DIK(X,DV)="",DIK4(DV)=DW,DIK2(DV)="DA("_A_"),,DIKM1="_A_",DIKUM'<"_A
        !            17:        I A=1 S DIK8(DV)=$P(DIK2(DV),",",1,2)_DIK4(DV)_","
        !            18:        S DIKQ=DH,DIKC=DV
        !            19:        I $D(DIK2(DH)) S DIK8(DV)="" F DIK8=A:-1:1 S DIK8(DV)=DIK8(DV)_$P(DIK2(DIKC),",",1,2)_$S($D(DIK4(^DD(DIKC,0,"UP"))):DIK4(^("UP")),1:DIK4(DV))_"," S (DIKC,DH)=^("UP") Q:'$D(^DD(DH,0,"UP"))
        !            20:        I A>2 S DIK8(DV)=$P(DIK8(DV),",",1)_","_$P(DIK8(DV),",",4)_","_$P(DIK8(DV),",",3)_","_$P(DIK8(DV),",",2)_","_$P(DIK8(DV),",",5,99)
        !            21:        S DH=DIKQ
        !            22:        Q
        !            23: DAR    ;
        !            24:        S (DIKC,DIK1,%,DIKL2)=1,DIKQ=0
        !            25:        F DIK8=A-1:-1:1 S DIKC=DIKC+2,DIKCT=DIKCT+1,DIK4=" S DA("_DIK8_")=$O("_DIK2_$P(DIK8(DH),",",1,DIKC)_"))" S:'$D(%) ^UTILITY($J,DIKR)=DIKL2_" ;",DIKR=DIKR+1,DIKL2=DIKL2+1 K % D DAR2 K DIK1
        !            26:        Q
        !            27: DAR2   ;
        !            28:        S ^UTILITY($J,DIKR)=$C(64+DIKCT)_DIK4_" I DA("_DIK8_")'>0 S DA("_DIK8_")=0 "_$S($D(DIK6)&('$D(DIK1)):"Q:DIKM1="_DIKQ_"  ",1:"")_"G "_$S($D(DIK1):"END",1:$C(64+DIKCT-1)),DIKR=DIKR+1,DIKQ=DIKQ+1,DIK6=1
        !            29:        Q