Return to DIE1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIE1.m, revision 1.1

1.1     ! snw         1: DIE1   ;SFISC/GFT-FILE DATA, XREF IT, GO UP AND DOWN MULTIPLES ;09:14 AM  7 Nov 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K DQ,DB G E1:$D(DG)<9 I DP<0 K DG S DQ=0 Q
        !             5:        S DQ="",DU=-2,DG="$D("_DIE_DA_",DU))"
        !             6: Y      S DQ=$O(DG(DQ)),DW=$P(DQ,";",2) G DE:$P(DQ,";",1)=DU
        !             7:        I DU'<0 S ^(DU)=DV,DU=-2
        !             8:        G IX:DQ="" S DU=$P(DQ,";",1),DV="" I @DG S DV=^(DU)
        !             9: DE     I 'DW S DW=$E(DW,2,99),DE=DW-$L(DV)-1,%=$P(DW,",",2)+1,X=$E(DV,%,999),DV=$E(DV,0,DW-1)_$J("",$S(DE>0:DE,1:0))_DG(DQ) S:X'?." " DV=DV_$J("",%-DW-$L(DG(DQ)))_X G Y
        !            10: PC     S $P(DV,"^",DW)=DG(DQ) G Y
        !            11:        ;
        !            12: IX     S DQ=$O(DE(" ")) G E1:DQ="",E1:'$D(DG(DQ)) I $D(DE(DE(DQ)))#2 F DG=1:1 Q:'$D(DE(DQ,DG))  S DIC=DIE,X=DE(DE(DQ)) X DE(DQ,DG,2)
        !            13:        S X="" I DG(DQ)]"" F DG=1:1 Q:'$D(DE(DQ,DG))  S DIC=DIE,X=DG(DQ) X DE(DQ,DG,1)
        !            14: E1     K DIFLD,DG,DB,DE,DIANUM S DQ=0 Q
        !            15:        ;
        !            16: B      ;
        !            17:        I '$D(DB(DQ)) S X="?BAD" G ^DIEQ
        !            18:        S DC=DQ,DIK="",DL=1
        !            19: OUT    ;
        !            20:        D DIE1 S Y(DC)=DIK G UP:DL>1,Q:DC=0,QY
        !            21:        ;
        !            22: E      ;
        !            23:        I DP'<0 S DC=$S($D(X)#2:X,1:"") D DIE1 S X=DC G G:DI>0,UP:DL>1
        !            24: Q      K Y
        !            25: QY     I $D(DTOUT),$D(DIEDA) D
        !            26:        . N % K DA
        !            27:        . F %=1:1 Q:'$D(DIEDA(%))  S DA(%)=DIEDA(%)
        !            28:        . S DA=DIEDA
        !            29:        . Q
        !            30:        K:$D(DTOUT) DG,DQ
        !            31:        K DIP,DB,DE,DM,DK,DL,DH,DU,DV,DW,DP,DC,DIK,DOV,DIEL,DIFLD Q
        !            32:        ;
        !            33: M      ;
        !            34:        S DD=X,DIC(0)=$P("QE","^",'$D(DB(DQ)))_"LM",DO(2)=$P(DC,"^",2),DO=$E($P(DQ(DQ),"^",1),8,99)_"^"_DO(2)_"^"_$P(DC,"^",4,5) D DOWN I @("'$D("_DIC_"0))") S ^(0)="^"_DO(2)
        !            35:        E  I DO(2)["I" S %=0,DIC("W")="" D W^DIC1
        !            36:        K DICR S D="B",DLAYGO=DP\1,X=DD D X^DIC
        !            37:        I Y>0 S DA=+Y,DI=0,X=$P(Y,U,2) S:+DR=.01!(DR="")&$P(Y,U,3) DI=.01,DK=1,DM=$P($P(DR,";",1),":",2),DM=$S(DR="":9999999,DM="":+DR,1:DM) G D1
        !            38:        S DI(DL-1)=DI(DL-1)_U K DUOUT,DTOUT G U1
        !            39:        ;
        !            40: DOWN   D S,DIE1,DDA S DIE=DIC Q
        !            41:        ;
        !            42: S      S DIOV(DL)=$S('$D(DOV):0,1:DOV) K DOV
        !            43:        S DP(DL)=DP,DP=+$P(DC,"^",2),DI(DL)=$S(DV'["M":DI,$D(DSC(DP))!$D(DB(DQ)):DI,1:DI_U),DIE(DL)=DIE,DK(DL)=DK,DR(DL)=DR,DM(DL)=DM,DK=0,DL=DL+1,DIEL=DIEL+1,DM=9999999,DR="" I $D(DR(DL,DP)) S DM=0,DR=DR(DL,DP)
        !            44:        Q
        !            45:        ;
        !            46: DDA    F X=DL+1:-1:1 I $D(DA(X)) S DA(X+1)=DA(X)
        !            47:        S DA(1)=DA,DIC=DIE_DA_","""_$P(DC,U,3)_"""," Q
        !            48:        ;
        !            49: UDA    S DA=DA(1) F X=2:1 Q:'$D(DA(X))  S DA(X-1)=DA(X) K DA(X)
        !            50:        K DA(DL)
        !            51:        Q
        !            52: N      ;
        !            53:        D DOWN S DA=$P(DC,U,4),DI=.01 S ^DISV(DUZ,$E(DIC,1,28))=$E(DIC,29,999)_DA
        !            54: D1     S @("D"_DIEL)=DA
        !            55: G      G MORE^DIE
        !            56:        ;
        !            57: UP     ;
        !            58:        Q:$D(DTOUT)  S DP(0)=DP I $D(DIEC(DL)) D DIEC G U
        !            59: U1     D UDA S DIEL=DIEL-1
        !            60: U      S DQ=0,DL=DL-1,DIE=DIE(DL),DM=DM(DL),DI=DI(DL),DP=DP(DL),DR=DR(DL),DK=DK(DL) I $D(DIOV(DL)) S DOV=DIOV(DL) K DIOV(DL)
        !            61:        G G
        !            62:        ;
        !            63: DIEC   K DA S DA=DIEC(DL) F %=1:1 Q:'$D(DIEC(DL,%))  S DA(%)=DIEC(DL,%)
        !            64:        F DIEL=0:1 Q:'$D(DIEC(DL,0,DIEL))  S @("D"_DIEL)=DIEC(DL,0,DIEL)
        !            65:        S DIEL=DIEL-1 K DIEC(DL)