Return to DIE17.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIE17.m, revision 1.1

1.1     ! snw         1: DIE17  ;SFISC/GFT-COMPILED TMPLT UTIL ;12/22/93  10:14
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        G:$A(X)-94 X:'$P(DW,";E",2),@("T^"_DNM)
        !             5:        I $D(DIE("NO^")),X=U,DIE("NO^")'["OUTOK" W !?3,"EXIT NOT ALLOWED " G X
        !             6:        I $D(DIE("NO^")),X?1"^"1.E,DIE("NO^")'["BACK" W !?3,"JUMPING NOT ALLOWED " G X
        !             7:        I $L(X,"^")-1>1 S X=$E(X,2,99) G DIE17
        !             8:        S X=$P(X,U,2),DIC(0)="E" G OUT
        !             9: Z      ;
        !            10:        S DL=1,X=0
        !            11: OUT    ;
        !            12:        I 0[X S DM=DW D FILE G ABORT:DL=1,R
        !            13:        S DIC="^DD("_DP_"," G OJ:'$D(^DIE(DIEZ,"AB")) S DIEZAB=$S(DL=1:U,1:DNM(DL,0)_U_DNM(DL)) I X?1"@".N,$D(^("AB",DIEZAB,X)) S DNM=^(X) G JMP
        !            14:        S DDBK=0 I $D(DIE("NO^")),DIE("NO^")["BACK" D DR S DDBK=1,DIC("S")="I $D(^DIE(DIEZ,""AB"",DIEZAB,Y)) D S^DIE0"
        !            15:        E  S DIC("S")="I $D(^DIE(DIEZ,""AB"",DIEZAB,Y)),DIC(0)[""F""!'$D(^(Y,""///""))"
        !            16:        S DIC="^DD("_DP_"," D ^DIC S DIC=DIE I Y<0 S D="" W:DDBK !?3,"JUMPING FORWARD NOT ALLOWED "
        !            17:        I DDBK K DR S DR(1,DP)=^DIE(DIEZ,"ROU"),DR=DI
        !            18:        K A0,A1,DDBK,DIC,DTOUT G X:Y<0 S DNM=^DIE(DIEZ,"AB",DIEZAB,+Y)
        !            19: JMP    K DIEZAB D FILE S Y=DNM,DNM=$P(Y,U,2),DQ=+Y,D=0 D @("DE^"_DNM) G @Y
        !            20:        ;
        !            21: OJ     I X?1"@".N,$D(^DIE("AF",X,DIEZ)) S DNM=^(DIEZ)
        !            22:        E  S DIC("S")="I $D(^DIE(""AF"","_DP_",Y,DIEZ)),DIC(0)[""F""!'$D(^(DIEZ,""///""))" D ^DIC K DIC S DIC=DIE G X:Y<0 S DNM=^DIE("AF",DP,+Y,DIEZ)
        !            23:        G JMP
        !            24: F      ;
        !            25:        S DC=$S($D(X)#2:X,1:0) D FILE S X=DC Q
        !            26: FILE   ;
        !            27:        K DQ Q:$D(DG)<9  S DQ="",DU=-2,DG="$D("_DIE_DA_",DU))"
        !            28: Y      S DQ=$O(DG(DQ)),DW=$P(DQ,";",2) G DE:$P(DQ,";",1)=DU
        !            29:        I DU'<0 S ^(DU)=DV,DU=-2
        !            30:        G E1:DQ="" S DU=$P(DQ,";",1),DV="" I @DG S DV=^(DU)
        !            31: 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
        !            32: PC     S $P(DV,U,DW)=DG(DQ) G Y
        !            33:        ;
        !            34: IX     D @DE(DQ)
        !            35: K      K DE(DQ)
        !            36: E1     S DQ=$O(DE(" ")) I DQ'="" G IX:$D(DG(DQ)),K
        !            37:        K DG,DE,DIFLD S DQ=0 Q
        !            38: 1      ;
        !            39:        D FILE
        !            40: R      D UP G @("R"_DQ_U_DNM)
        !            41:        ;
        !            42: UP     S DNM=DNM(DL),DQ=DNM(DL,0) K DTOUT,DNM(DL) I $D(DIEC(DL)) D DIEC^DIE1 G U
        !            43:        S DIEL=DIEL-1,%=2,DA=DA(1) K DA(1)
        !            44: DA     I $D(DA(%)) S DA(%-1)=DA(%) K DA(%) S %=%+1 G DA
        !            45: U      S DL=DL-1 Q
        !            46:        ;
        !            47: X      W:X'["?"&'$D(ZTQUEUED) $C(7),"??" G Z:$D(DB(DQ))
        !            48: B      G @(DQ_U_DNM)
        !            49: N      ;
        !            50:        D DOWN S DA=$P(DC,U,4),D=0 S ^DISV(DUZ,$E(DIC,1,28))=$E(DIC,29,999)_DA
        !            51: D1     S @("D"_DIEL)=DA G @(DGO)
        !            52: M      ;
        !            53:        S DD=X D DOWN S DO(2)=$P(DC,"^",2),DO=DOW_"^"_DO(2)_"^"_$P(DC,"^",4,5),DIC(0)=$P("QE",U,'$D(DB(DNM(DL,0))))_"LM" I @("'$D("_DIC_"0))") S ^(0)="^"_DO(2)
        !            54:        E  I DO(2)["I" S %=0,DIC("W")="" D W^DIC1
        !            55:        K DICR S D="B",DLAYGO=DP\1,X=DD D X^DIC
        !            56:        I Y>0 S DA=+Y,X=$P(Y,U,2),D=$P(Y,U,3) G D1
        !            57:        D UP G @(DQ_U_DNM)
        !            58:        ;
        !            59: DOWN   S DL=DL+1,DNM(DL)=DNM,DNM(DL,0)=DQ D FILE
        !            60:        F %=DL+1:-1:1 I $D(DA(%)) S DA(%+1)=DA(%)
        !            61:        S DA(1)=DA,DIC=DIE_DA_","""_$P(DC,U,3)_""",",DIEL=DIEL+1 Q
        !            62: ABORT  D E S Y(DM)="" Q
        !            63: 0      ;
        !            64:        D FILE
        !            65: E      K DIP,Y,DE,DOW,DB,DP,DW,DU,DC,DV,DH,DIL,DNM,DIEZ,DLB,DIEL,DGO Q
        !            66: DR     ;
        !            67:        N F,DA I $E(DR)="[" S %X="^DIE(DIEZ,""DR"",",%Y="DR(" D %XY^%RCR S DR=DR(DL,DP) Q
        !            68:        S F=0 D DICS^DIA F DDW=1:1 S DDW1=$P(DR,";",DDW) Q:DDW1=""  I $D(^DD(DI,+DDW1,0)),+$P(^(0),U,2)!(DDW1[":") S X=+DDW1,D(F)=+$P(DDW1,":",2) S:'D(F) D(F)=X D RANGE^DIA1
        !            69:        K DDW,DDW1 Q