Annotation of freem_fileman/USER/DIA.m, revision 1.1

1.1     ! snw         1: DIA    ;SFISC/GFT-SELECT FIELDS TO EDIT ;2/16/93  15:21 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        D DICS
        !             5: 1      D F W !?F*3,"EDIT WHICH "_X I $S(DB:DIAT="",1:1) R ": ALL// ",X:DTIME S:'$T X=U,DTOUT=1 G ALL^DIA1:X=""!(X="ALL"),TEMP^DIA1:X?1"[".E&'F,L
        !             6: ED     G NDB:DIAT=""
        !             7: GDB    S Y=$P(DIAT,";",DB) I "Q"[Y G NDB:Y="" D DB G GDB
        !             8:        I Y?.NP,$P(Y,":",2),Y'["/" S Y=+Y_"-"_$P(Y,":",2)
        !             9:        I $D(DI(DB)),$D(DI(DB,F,DI,DIAO)) S Y=DI(DB,F,DI,DIAO)
        !            10:        W ": "_Y D RW
        !            11:        I X="" S X=Y I X="ALL" G ALL^DIA1
        !            12: L      S DSC=X?1"^".E I DSC S X=$E(X,2,999) I U[X K DR Q
        !            13:        I $A(X)=64 G X:X'?1P.N,P:$L(X)>1,X:'DB S DB=DB+1 G 2
        !            14:        K DIC,DIAB D DICS S DV="",J=$P(X,"-",2) I +J=J,$P(X,"-",1)=+X,J>X S D(F)=J K DA D RANGE^DIA1 K D S Y=DA G X:Y="" D DB G 2
        !            15: DIC    ;
        !            16:        S DIC(0)="EZI",DIC="^DD(DI,",Y=-1 G X^DIA3:X[";" S DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":""  (word-processing)"",1:""  (multiple)"")" D ^DIC Q:$D(DTOUT)
        !            17:        I Y>0 D SET S Y=$P(Y(0),U,2) G 2:'Y S L=L+1,(DI,J(L))=+Y,I(L)=""""_$P($P(Y(0),U,4),";",1)_"""" G DOWN
        !            18:        I $E(X)="]" S DRS=9,X=$E(X,2,999) G DIC:X]"",2
        !            19:        S DIC(0)="EY",D="GR" G DIA^DIQQQ:X?."?" I $D(^DD(DI,D)) D IX^DIC I Y>0 D SET G 2
        !            20:        G X^DIA3
        !            21:        ;
        !            22: F      S X=$P(^DD(DI,0),U,1) I F,X="FIELD" S X=$O(^(0,"NM",0))_" "_X
        !            23:        Q
        !            24:        ;
        !            25: X      ;
        !            26:        W $C(7),"??" D DICS
        !            27: 2      ;
        !            28:        G 1:'$D(DR(F+1,DI)) D F W !?F*3,"THEN EDIT "_X G ED:DB
        !            29: R      R ": ",X:DTIME E  W $C(7) S X=U,DTOUT=1
        !            30:        I X]"" G L
        !            31: UP     ;
        !            32:        G ^DIA1:'F K I(L),J(L) S L=L-1 I '$D(J(L)) F L=L-99:1 Q:'$D(J(L+1))
        !            33:        I DB S DB=DB(F),DIAO=DIAO(F),DIAT=$S(DIAO<0:"",DIAO:^DIE(DIAA,"DR",F,J(L),DIAO),$D(^DIE(DIAA,"DR",F,J(L))):^(J(L)),1:"")
        !            34:        S DIAP=DIAP(F),DI=J(L),F=F-1 G 2
        !            35:        ;
        !            36: NDB    I DB,DIAO'<0 S DIAO=DIAO+1 I $D(^DIE(DIAA,"DR",F+1,DI,DIAO)) S DIAT=^(DIAO),DB=1 G GDB
        !            37:        S DIAO=-1 G R
        !            38:        ;
        !            39: EN     ;
        !            40:        D OS^DII:'$D(DISYS),DICS
        !            41: DOWN   S F=F+1,DIAP(F)=DIAP,DIAP=0 I DB S DB(F)=DB,DB=1,DIAO(F)=DIAO,DIAO=0,DIAT=$S($D(^DIE(DIAA,"DR",F+1,DI)):^(DI),1:"")
        !            42:        G 1:$P(^DD(DI,.01,0),U,2)'["W",1:L#100=0,UP
        !            43: DICS   ;
        !            44:        S DIC("S")="I Y>.001,$P(^(0),U,2)'[""C"""_$S(DUZ(0)="@":"",1:",$P(^(0),U,2)'[""K""")_" Q:'$D(^(9))  I ^(9)'=U"_$S(DUZ(0)'="@":" F DW=1:1:$L(^(9)) I DUZ(0)[$E(^(9),DW) Q",1:"") Q
        !            45:        ;
        !            46: P      ;
        !            47:        S DRS=99,Y=X D DB G 2
        !            48:        ;
        !            49: SET    S Y=+Y_DV
        !            50: DB     ;
        !            51:        I DB,'DSC S DB=DB+1
        !            52: D      ;
        !            53:        I '$D(DR(F+1,DI)) S DR(F+1,DI)="",DIAP=0
        !            54:        E  I $L(DR(F+1,DI))+$L(Y)>230 F %=0:1 I '$D(DW(DI,%)) S DIAP=DIAP\1000+1*1000,DW(DI)=F+1,DW(DI,%)=DR(F+1,DI),DR(F+1,DI)="" Q
        !            55:        S DR(F+1,DI)=DR(F+1,DI)_Y_";",DRS=DRS+1,DIAP=DIAP+1 I $D(DIAB) S ^UTILITY($J,DIAP#1000,F,DI,DIAP\1000)=DIAB K DIAB
        !            56:        Q
        !            57: RW     I $L(Y)>19 D RW^DIR2 Q
        !            58:        W "// " R X:DTIME I '$T S X=U,DTOUT=1 W $C(7)

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>