Return to DICATT2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICATT2.m, revision 1.1

1.1     ! snw         1: DICATT2        ;SFISC/GFT,XAK-DEFINING MULTIPLES ;10/4/94  11:00
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S T=$E(Z,1) G CHECK^DICATT:$D(DTOUT)
        !             5:        F P="I","O","L" S:$P(O,U,2)[P Z=$P(Z,U)_P_U_$P(Z,U,2)
        !             6: 1      K DS S:$P(Z,U)'["K" V=W[";0"
        !             7:        S P=0,N=DICL,DQ=4,DP=6,DQI=" S:$D(X) DINUM=+X",DREF=$F(O,DQI)-1=$L(O),DE(7,0)="NO",DG(7)="N"
        !             8:        S:T="*" T=$S($P(Z,U,1)["S":"S",1:"P") G 1^DICATT22:DA=.001
        !             9:        G W:T="W" S:$D(DTIME)[0 DTIME=300
        !            10:        I T'["F",T'["S",T'["K",'O!DREF S:DREF DE(7,0)="YES",DG(7)="Y"
        !            11: S      F Y=4:1:6 S DQ(Y)=$P($T(DQ+Y),S,3)_F_$P($T(DQ+Y),S,4)_" (Y/N)^RS^Y:YES;N:NO^"_Y_"^Q" I 'V,DA-.01!'N Q
        !            12:        S DG(5)="Y",DE(4,0)="NO",DP=-1,DL=1
        !            13:        I T["P"!(T["N") S DE(5,0)="YES"
        !            14:        I O S DE(6,0)=$E("NY",$P(O,U,2)["M"+1) S:$P(O,U,2)["R" DE(4,0)="Y" I DA=.01,N S P=$O(^DD(J(N-1),"SB",A,0)) S:P="" P=-1 S Y=$P(^DD(J(N-1),P,0),U,2),DE(5,0)=$E("YN",Y["A"+1)
        !            15:        K Y S DIFLD=-1 D RE^DIED K DQ,DIFLD G:$D(Y) N^DICATT:$P(Z,U,1)["X",CHECK^DICATT I $D(DTOUT) K DTOUT G CHECK^DICATT
        !            16:        S:DG(5)="N" T=T_"A" I DG(4)="Y",$P(Z,U,1)'["R" S Z="R"_Z
        !            17:        I $D(DG(6)),DG(6)="Y",$P(Z,U,1)'["M" S Z="M"_Z
        !            18: G      S DIZ=Z G ^DICATT22
        !            19: Q      ;
        !            20:        K T,B,A,J,DA,DIC,E,DR,W,S,Q,P,N,V,I,L,F,DQI,DIK,C,Z,Y,DE,O,DICS,DICL,DDA Q
        !            21:        ;
        !            22: W      S %=Z["L"+1 W !,"SHALL THIS TEXT NORMALLY APPEAR IN WORD-WRAP MODE" D YN^DICN
        !            23:        G CHECK^DICATT:%<0 I % S Z=$P($P(Z,"L",1)_$P(Z,"L",2),U,1)_$E("L",%=2)_U G G
        !            24:        W !?3,"ANSWER 'YES' IF THE INTERNALLY-STORED '"_F_"' TEXT"
        !            25:        W !?5,"SHOULD NORMALLY BE PRINTED OUT IN FULL LINES, BREAKING AT WORD BOUNDARIES."
        !            26:        W !?2,"ANSWER 'NO' IF THE INTERNAL TEXT SHOULD NORMALLY BE PRINTED OUT"
        !            27:        W !?5,"LINE-FOR-LINE AS IT STANDS.",! G W
        !            28:        ;
        !            29: X      ;
        !            30:        W "   (FIELD DEFINITION IS NOT EDITABLE)" S T=$E(^(0),1),Z=$P(Y,U,2),Z=$P(Z,"M",1)_$P(Z,"M",2),Z=$P(Z,"R",1)_$P(Z,"R",2)_U_$P(Y,U,3),W=$P(Y,U,4),C=$P(Y,U,5,99) S:Z["K" V=0 G N^DICATT:N=6,1
        !            31:        ;
        !            32: NO     ;
        !            33:        W !,$C(7),"  <DATA DEFINITION UNCHANGED>" I $P(Z,U)["K"&(DUZ(0)'="@") G N^DICATT
        !            34: TYPE   K Y,M,DE,DIE,DQ,DG G Q^DIB:$D(DTOUT) S N=0,DQI=DICL+9,Y=^DD(A,DA,0),F=$P(Y,U,1),Z="" W !!,"DATA TYPE OF ",F,": " I 'O R X:DTIME S:'$T DTOUT=1 G X^DICATT:X[U!'$T S:DUZ(0)'="@" DIC("S")="I Y-9" S:DA=.001 DIC("S")="I Y<4!(Y=7)" G NEW
        !            35:        F N=9:-1:5,1:1:4 Q:$P(Y,U,2)[$E("DNSFWCPVK",N)
        !            36:        W $P(^DOPT("DICATT",N,0),U,1) G X:$P(Y,U,2)["K"&(DUZ(0)'="@")
        !            37:        G X:$P(Y,U,2)["X",6^DICATT:N=6 R "// ",X:DTIME S:'$T DTOUT=1 G N^DICATT:X[U!'$T,0^DICATT:X="" S DIC("S")="I Y-6,Y-9"_$P(",Y-5",U,N\2-2!(A=B)!(DA-.01)!$O(^DD(A,DA))>0),DIC("S")=DIC("S")_$S(N=7:",Y-8",N=8:",Y-7",1:"")
        !            38: NEW    I 'O,X=" ",E,$P(^DD(A,E,0),U,2)'["P",$P(^(0),U,2)'["V" W " <",$C(7) D E^DICATT W " DUPLICATED>" S DIZ=$S($D(DIZ):DIZ,1:DIZZ) G E^DICATT1
        !            39:        S DIC(0)="QEI",DIC="^DOPT(""DICATT""," D ^DIC I Y>0 S:N-Y&O M="",O=$P(O,U,1,2)_U_U_$P(O,U,4) S N=+Y G 0^DICATT
        !            40:        I 'O,X["?",E,$P(^DD(A,E,0),U,2)'["P",$P(^(0),U,2)'["V" D DICATT^DIQQQ,E^DICATT W ", JUST HIT THE SPACE KEY"
        !            41:        G TYPE
        !            42:        ;
        !            43: DQ     ;;
        !            44:        ;
        !            45:        ;
        !            46:        ;
        !            47:        ;;IS ; ENTRY MANDATORY
        !            48:        ;;SHOULD USER SEE AN "ADDING A NEW ;?" MESSAGE FOR NEW ENTRIES
        !            49:        ;;HAVING ENTERED OR EDITED ONE ;, SHOULD USER BE ASKED ANOTHER