| 1 | DICATT5 ;SFISC/XAK-POINTERS ;12:04 PM 25 Jan 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**26**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | 7 K DIC S Y="",%=$P(O,U,3),DIC(0)="EFQIZ"
|
|---|
| 5 | S:$P(O,U,2)["P"&$L(%) Y=$S($D(@("^"_%_"0)")):$P(^(0),U),1:"")
|
|---|
| 6 | W !,"POINT TO WHICH FILE: " W:Y]"" Y_"// " R X:DTIME S:'$T DTOUT=1 G CHECK^DICATT:X=U!'$T I Y]"",X="" S X=Y,DIC(0)=DIC(0)_"O"
|
|---|
| 7 | S DIC=1,DIC("S")="I Y'=1.1 S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %"
|
|---|
| 8 | D ^DIC K DIC,DIFILE,DIAC G:Y<0 7:X["?",T S X=^(0,"GL"),DE=Y G 77
|
|---|
| 9 | T K DIC G CHECK^DICATT:$D(DTOUT),NO^DICATT2
|
|---|
| 10 | 77 S DIFILE=+Y,DIAC="LAYGO" D ^DIAC S %=0 S:'DIAC!($P($G(^DD(DIFILE,0,"DI")),U,2)["Y") %=2 K DIFILE,DIAC
|
|---|
| 11 | P I % W !,$C(7) D A W !,"WILL NOT " D B
|
|---|
| 12 | E S %=1+$S($P(O,U,2)["'":1,$P(O,U,2)']"":1,1:0) W !,"SHOULD " D A W ! D B,YN^DICN G T:%<1
|
|---|
| 13 | S Z="P"_+DE_$E("'",%=2)_X,C="Q",L=9,E=X G H:DUZ(0)'="@" D S G T:X=U,H
|
|---|
| 14 | S ;
|
|---|
| 15 | S D=$S($D(^DD(A,DA,12.1)):^(12.1),1:""),%=2-(D]""),P=$S($D(^(12)):^(12),1:""),I=$S($D(^(12.2)):^(12.2),1:"")
|
|---|
| 16 | W !,"SHOULD '"_$P(DE,U,2)_"' ENTRIES BE SCREENED" D YN^DICN S:%<0 X=U Q:X=U I '% W !?5,"Answer YES if there is a condition which should prohibit",!?5,"selection of some entries." G S
|
|---|
| 17 | I %=2 K ^(12.1),^(12),^(12.2) Q
|
|---|
| 18 | G M ;W !,"ENTER A TRUTH-VALUED EXPRESSION WHICH MUST BE TRUE OF ANY ENTRY POINTED TO:",!?4 I I]"" W I_"// " W:$X>35 !?4
|
|---|
| 19 | R X:DTIME S:'$T DTOUT=1 G T:X=U!'$T S:X="" X=I I X="" G M:DUZ(0)="@",S
|
|---|
| 20 | K DG,K S ^(12.2)=X,K=100,DQI="Y(",DG(K)=K,K(1,1)=K,(DLV,DLV0)=K,J(K)=+DE,I(K)=E,K=0 D EN^DICOMP
|
|---|
| 21 | G S:'$D(X) I $D(X)>1!(X[" ^DIC") W $C(7),!,"TOO COMPLICATED!" G S
|
|---|
| 22 | S I=0 I 'DBOOL W $C(7),!?8,"WARNING-- THIS DOESN'T LOOK LIKE A TRUTH-VALUED EXPRESSION"
|
|---|
| 23 | D0 S I=$F(X,E_"D0",I) I I S X=$E(X,1,I-3)_"Y"_$E(X,I,999) G D0
|
|---|
| 24 | Q S I=$F(X,"""",I) I I S X=$E(X,1,I-1)_""""_$E(X,I,999),I=I+1 G Q
|
|---|
| 25 | S (D,X)="S DIC(""S"")="""_X_" I X""" G E:DUZ(0)'="@"
|
|---|
| 26 | M W !,"MUMPS CODE THAT WILL SET 'DIC(""S"")': " W:D]"" D S Y=D D:D]"" RW^DIR2 G S:X="@" I D']"" R X:DTIME S:'$T DTOUT=1 Q:X=U!'$T
|
|---|
| 27 | I X="" S X=D G S:X=""
|
|---|
| 28 | I X?."?" D HELP^DICATT4 G M
|
|---|
| 29 | D ^DIM:'$T I '$D(X) S X="" G S
|
|---|
| 30 | I X'["DIC(""S"")" W $C(7),!,?8,"WARNING - Screen Does Not Contain DIC(""S"")"
|
|---|
| 31 | E W !,"EXPLANATION OF SCREEN: " W:P]"" P_"// " R %:DTIME S:'$T %=U,DTOUT=1 S:%="" %=P G S:%=U I %?.P W !?5,$C(7),"An explanation must be entered." G E
|
|---|
| 32 | I $D(^DD(A,DA,12.1)) S:X'=^(12.1) M(1)=0
|
|---|
| 33 | S ^DD(A,DA,12)=%,^(12.1)=X,Z="*"_Z S:Z?1"*P".E C=X_" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X" Q
|
|---|
| 34 | H S DIZ=Z G ^DICATT1
|
|---|
| 35 | ;
|
|---|
| 36 | A W "'ADDING A NEW "_$P(DE,U,2)_" FILE ENTRY' (""LAYGO"")" Q
|
|---|
| 37 | B W "BE ALLOWED WHEN ANSWERING THE "_F_"' QUESTION" Q
|
|---|
| 38 | Q
|
|---|
