Return to DIE0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIE0.m, revision 1.1

1.1     ! snw         1: DIE0   ;SFISC/GFT-BRANCHING, UP-ARROWING ;12/22/93  10:15
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        G Q^DIE1:$D(DTOUT) G:X'?1"^".E T^DIED:$P($P(DQ(DQ),U,4),";E",2),X
        !             5:        I $D(DIE("NO^")),X=U,DIE("NO^")'["OUTOK" W !?3,"EXIT NOT ALLOWED " G X
        !             6:        I $D(DIE("NO^")),X?1"^"1E.E,DIE("NO^")'["BACK" W !?3,"JUMPING NOT ALLOWED " G X
        !             7:        I $L(X,"^")-1>1 S X=$E(X,2,99) G DIE0
        !             8:        S X=$P(X,U,2),DIC(0)="E"
        !             9: OUT    I X=""!(DP<0) S DIK=X,DC=$S($D(DQ(DQ))#2:$P(DQ(DQ),U,4),1:DQ) G OUT^DIE1
        !            10:        I DR]"" G A:X?1"@".N S DIC("S")="D S^DIE0" S:'$D(DR(DL,DP)) DR(DL,DP)=DR
        !            11:        S DDBK=0,DIC="^DD(DP," D ^DIC I Y>0 D S
        !            12:        E  W:DDBK !?3,"JUMPING FORWARD NOT ALLOWED "
        !            13:        K DTOUT,DIC,DDR,DDBK,DDFND,DDONE,A0,A1,A2
        !            14:        I Y<0 S DG=DK,DH=":"_DM G X
        !            15:        S DI=$S(DH[":":+Y,1:DH),DK=DG D ^DIE1:$D(DG)>9 K DG,DB,DE,DQ,DIFLD S DQ=0 G JMP^DIE
        !            16: X      W:X'["?"&'$D(ZTQUEUED) $C(7),"??" G B^DIED:'$D(DB(DQ)),B^DIE1
        !            17:        ;
        !            18: BR     ;
        !            19:        S Y=U X DQ(0,DQ) G A^DIED:$D(Y)[0,A^DIED:Y=U S D=$S(+Y=Y:9999,1:DQ),X="" I 0[Y S DQ=0 G OUT
        !            20: D      S D=D+1 I '$D(DQ(D)) G D:$D(DQ(0,D)) S DQ=9999,X=Y,DIC(0)="FO" G OUT
        !            21:        G D:$P(DQ(D),Y,1)]"" S DQ=D G RE^DIED
        !            22:        ;
        !            23: O      ;
        !            24:        K DQ S (DI,DV,DM)=0 D DUZ I X]"",$D(@(U_$P(DC,U,3)_X_",0)"))#2 D S^DIE1,DIEC
        !            25:        S DQ=0 G MORE^DIE
        !            26:        ;
        !            27: DIEC   S DIE=U_$P(DC,U,3),DIEC(DL)=DA F %=1:1 Q:'$D(DA(%))  S DIEC(DL,%)=DA(%)
        !            28:        K DA,DB,DE,DG F %=0:1:DIEL-1 S DA="D"_%,DIEC(DL,0,%)=@DA K @DA
        !            29:        S DIEL=0,(D0,DA)=X Q
        !            30:        ;
        !            31: DUZ    Q:X=""!(DUZ(0)="@")
        !            32:        ;S DIFILE=$P(DC,U,2),DIAC="WR" D ^DIAC K DIAC,DIFILE G:'% 3
        !            33:        Q
        !            34: 3      ;W $C(7),!?7,"(YOU DO NOT HAVE 'WRITE ACCESS' TO THE '"_$P(^DIC($P(DC,U,2),0),U)_"' FILE)" S X=""
        !            35:        Q
        !            36:        ;
        !            37: DIEZ   ;
        !            38:        D DUZ I X="" G @("A"_U_DNM)
        !            39:        S D=0,DL=DL+1,DNM(DL)=DNM,DNM(DL,0)=DQ,DIEL=DIEL+1 D DIEC G @DGO
        !            40:        ;
        !            41: A      I $D(DR(DL,DP))>9 D OA
        !            42:        E  F DG=1:1 S DH=$P(DR(DL,DP),";",DG) G X:DH="" I DH=X S:$D(DOV) DOV=0 S DR=DR(DL,DP) Q
        !            43:        S DK=DG,DI=X D ^DIE1 G JMP^DIE
        !            44: OA     S %=0 F  S %=$O(DR(DL,DP,%)) Q:%=""  F DG=1:1 S DH=$P(DR(DL,DP,%),";",DG) Q:DH=""  I DH=X S DR=DR(DL,DP,%),DOV=%,%=9999 Q
        !            45:        S %=-1 Q
        !            46:        ;
        !            47: E      ;
        !            48:        I X="@" Q:DV'["I"  G NO
        !            49:        Q:X[U!(X?."?")!DV!$D(DITC)
        !            50: NO     W:'$D(DB(DQ)) $C(7),"   NO EDITING!!" K X
        !            51: Q      Q
        !            52: S      ;reg or ovfl, out= $T
        !            53:        S (%,DDFND)=0,DDR=DR(DL,DP),DDBK=0,Y=+Y
        !            54:        I $D(DIE("NO^")),DIE("NO^")["BACK" S DDBK=1
        !            55:        D S1 I DDFND Q
        !            56:        I 'DDONE,$D(DR(DL,DP))>9 F %=-1:0 S %=$O(DR(DL,DP,%)) Q:%=""  S DDR=DR(DL,DP,%) D S1 Q:DDONE!DDFND
        !            57:        Q
        !            58: S1     ;selectable?
        !            59:        S DDONE=0 F DG=1:1 D S2 Q:DDFND!DDONE!(DH="")
        !            60:        I DDFND S DOV=%,DR=$S($D(DR(DL,DP,%)):DR(DL,DP,%),$D(DR(DL,DP)):DR(DL,DP),1:"")
        !            61:        Q
        !            62: S2     ;parse for ;-piece
        !            63:        S DH=$P(DDR,";",DG) Q:(DH["///"&(DIC(0)'["F"))!'DH
        !            64:        ;list
        !            65:        I 'DDBK,+DH=Y S DDFND=1 Q
        !            66:        I DDBK,+DH=DIFLD,+DH'=Y S DDONE=1 Q
        !            67:        I DDBK,+DH=Y S DDFND=1 Q
        !            68:        Q:$P(DH,"//")'[":"
        !            69:        ;range
        !            70:        S A0=+$P(DH,":",1),A1=+$P(DH,":",2)
        !            71:        I 'DDBK,Y'<A0,Y'>A1 S DDFND=1 Q
        !            72:        F A2=A0-.000001:0 S A2=$O(^DD(DP,A2)) Q:A2>A1!'A2  S:A2=DIFLD&(A2'=Y)&DDBK DDONE=1 Q:DDONE  I A2=Y,(A2'>DIFLD) S DDFND=1 Q
        !            73:        Q