Return to DIE1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIE1.m, revision 1.1.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)