source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DID2.m@ 1446

Last change on this file since 1446 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1DID2 ;SFISC/GFT-MODIFIED DD ;9:41 AM 23 Dec 2002
2 ;;22.0;VA FileMan;**7,105**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 I $D(DINM) G DZ:X'["C"!(X["X")!'$D(^DD(F(Z),DJ(Z),9.1)) S %Y=X,X=^(9.1),W=" -- "_X D ^DIM,W1^DIDH1:'$D(X) S X=%Y G Q:M=U G DZ
5 F I=9.2:.1 Q:'$D(^(I))#2 W ! S W=I_" = "_^(I) D W G Q:M=U
6 I $D(^(9.1))#2 S W=^(9.1),%Y="9.1 = " S:X["C" %Y="ALGORITHM: " W !,?DDL1,%Y D W S W=$P(" (ALWAYS "_$E(N,$L(N)-1)_" DECIMAL DIGITS)",U,N?.E1" S X=$J(X,0,"1N1")") D W G Q:M=U
7DZ ;
8 I $D(^("DT")) S Y=^("DT") D D^DIQ W !?DDL1,"LAST EDITED: " S W=Y D W1^DIDH1 G Q:M=U
9H K W I $D(^DD(F(Z),DJ(Z),3)),^(3)]"" W !?DDL1,"HELP-PROMPT:" S W=^(3) D W1^DIDH1 G Q:M=U
10 F %Y=21,23 I $O(^DD(F(Z),DJ(Z),%Y,0))>0 D DE^DIDH1 G:M=U Q
11SC ;
12 I $D(^DD(F(Z),DJ(Z),12.1)),'$D(DINM) I X["P"!(X["S") W !?DDL1,"SCREEN:" S W=^(12.1) D W I $D(^(12)) W !?DDL1,"EXPLANATION:" S W=^(12) D W G Q:M=U
13 I '$D(DINM),$D(^DD(F(Z),DJ(Z),4)),^(4)]"" W !?DDL1,"EXECUTABLE HELP:" S W=^(4) D W G Q:M=U
14 I $D(^(9.02))#2 W !?DDL1,"SUM:" S W=^(9.02) D W G Q:M=U
15AUD S W=$G(^DD(F(Z),DJ(Z),"AUDIT")) I "n"'[W D G:M=U Q
16 . W !?DDL1,"AUDIT: "
17 . S W=$S(W="y":"YES, ALWAYS",W="e":"EDITED OR DELETED",1:W) D W Q:M=U
18 . S W=$G(^DD(F(Z),DJ(Z),"AX"))
19 . I '$D(DINM),W]"" W !?DDL1,"AUDIT CONDITION: " D W
20PRELKUP I '$D(DINM),DJ(Z)=.01,$G(^DD(F(Z),DJ(Z),7.5))]"" W !?DDL1,"PRE-LOOKUP: " S W=^(7.5) D W G:M=U Q
21DEL N DIDND
22 I '$D(DINM) S DIDND=$O(^DD(F(Z),DJ(Z),"DEL","")) I DIDND]"" D G:M=U Q W !
23 . W !?DDL1,"DELETE TEST: "
24 . F D S DIDND=$O(^DD(F(Z),DJ(Z),"DEL",DIDND)) Q:DIDND=""!(M=U) W !!
25 .. W ?DDL2,$$QT(DIDND)_",0)= "
26 .. S W=$G(^DD(F(Z),DJ(Z),"DEL",DIDND,0)) D W
27LAYGO I '$D(DINM),DJ(Z)=.01 S DIDND=$O(^DD(F(Z),DJ(Z),"LAYGO","")) I DIDND]"" D G:M=U Q W !
28 . W !?DDL1,"LAYGO TEST: "
29 . F D S DIDND=$O(^DD(F(Z),DJ(Z),"LAYGO",DIDND)) Q:DIDND=""!(M=U) W !!
30 .. W ?DDL2,$$QT(DIDND)_",0)= "
31 .. S W=$G(^DD(F(Z),DJ(Z),"LAYGO",DIDND,0)) D W
32D I $D(^(8.5)) W !?DDL1,"DELETE AUTHORITY: " S W=^(8.5) D W G Q:M=U
33 I X'["C",$D(^(9))#2,^(9)]"" W !?DDL1,"WRITE AUTHORITY:" S W=^(9) D W G Q:M=U
34RD I $D(^(8))#2,^(8)]"" W !?DDL1,"READ AUTHORITY:" S W=^(8) D W G Q:M=U
35 I $D(^(10))#2,^(10)]"" W !?DDL1,"SOURCE OF DATA:" S W=^(10) D W G Q:M=U
36 I $O(^(11,0))>0 W !?DDL1,"DATA DESTINATION:" S I=0 F S I=$O(^DD(F(Z),DJ(Z),11,I)) Q:I="" S:$D(^DIC(.2,+^(I,0),0)) W=$P(^(0),U)
37 I S I=-1 D W G Q:M=U
38 I $O(^DD(F(Z),DJ(Z),20,0))>0 W !?DDL1,"GROUP:" S I=0 F S I=$O(^DD(F(Z),DJ(Z),20,I)) Q:I="" S W=$P(^(I,0),U)
39 I S I=-1 D W
40 Q
41 ;
42W F K=0:0 S:(($L(W)+DDL2)>IOM) DDL2=32 W ?DDL2 S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1) Q:%Y="" S W=%Y W !
43 I $Y+6>IOSL S DC=DC+1 D ^DIDH
44 I $D(^DD(F(Z),DJ(Z),0))
45 Q
46 ;
47Q G ND^DID1
48 ;
49MOD ;FROM DID
50 S X=U,%=2 W !,"WANT THE LISTING TO INCLUDE MUMPS CODE" D YN^DICN Q:%<0 S:%=2 DINM=1 I '% W !?5,"Enter YES, to see the MUMPS code as in the STANDARD listing.",!?5,"Enter NO, to eliminate MUMPS code from the listing." G MOD
51MOD2 S %=2 W !,"WANT TO RESTRICT LISTING TO CERTAIN GROUPS OF FIELDS" D YN^DICN S:%=2 X=0 Q:%<0!(%=2) I '% W !?5,"Enter YES, to select the Groups you wish to see in this listing.",!?5,"Enter NO, to see all fields." G MOD2
52 W ! S DP="",L=""","_$S(Y-2:"DJ(Z)",1:"D1")_"))"
53G R "Include GROUP: ",X:DTIME S:'$T X=U,DTOUT=1 I X[""""!($L(X)>30)!(X'?.ANP) W $C(7),!,"SORRY, THAT ISN'T WHAT A 'GROUP' NAME CAN LOOK LIKE",! G G
54 Q:X[U I X'?."?" S C="!" S:X?1"'"1E.E X=$E(X,2,99),C="&'" S DP=DP_C_"$D(^DD(F(Z),""GR"","""_X_L W !,"And " G G
55 I X="" S:DP]"" DIGR="I "_$E(DP,2,999) Q
56 W !?5,"To list only those fields which have a particular 'GROUP'",!?5,"(or several 'GROUPS') associated with them, Enter the GROUP NAME",!
57 W ?5,"To screen out a group, Type ""'"" in front of its name.",!
58 G G
59 ;
60QT(X) ;Quote X if noncanonic
61 Q:X=+$P(X,"E") X
62 S X=$NA(X(X)),X=$E(X,3,$L(X)-1)
63 Q X
Note: See TracBrowser for help on using the repository browser.