Annotation of freem_fileman/DID2.m, revision 1.1.1.1

1.1       snw         1: DID2   ;SFISC/GFT-MODIFIED DD ;12/30/93  13:55 ;
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      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
                      7: DZ     ;
                      8:        I $D(^("DT")) S Y=^("DT") D D^DIQ W !?DDL1,"LAST EDITED: " S W=Y D W1^DIDH1 G Q:M=U
                      9: H      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
                     11: SC     ;
                     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
                     15: D      I $D(^(8.5)) W !?DDL1,"DELETE AUTHORITY: " S W=^(8.5) D W G Q:M=U
                     16:        I X'["C",$D(^(9))#2,^(9)]"" W !?DDL1,"WRITE AUTHORITY:" S W=^(9) D W G Q:M=U
                     17: RD     I $D(^(8))#2,^(8)]"" W !?DDL1,"READ AUTHORITY:" S W=^(8) D W G Q:M=U
                     18:        I $D(^(10))#2,^(10)]"" W !?DDL1,"SOURCE OF DATA:" S W=^(10) D W G Q:M=U
                     19:        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)
                     20:        I  S I=-1 D W G Q:M=U
                     21:        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)
                     22:        I  S I=-1 D W
                     23:        Q
                     24:        ;
                     25: W      F K=0:0 W ?DDL2 S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1) Q:%Y=""  S W=%Y W !
                     26:        I $Y+6>IOSL S DC=DC+1 D ^DIDH
                     27:        I $D(^DD(F(Z),DJ(Z),0))
                     28:        Q
                     29:        ;
                     30: Q      G ND^DID1
                     31:        ;
                     32: MOD    ;FROM DID
                     33:        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
                     34: MOD2   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
                     35:        W ! S DP="",L=""","_$S(Y-2:"DJ(Z)",1:"D1")_"))"
                     36: G      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
                     37:        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
                     38:        I X="" S:DP]"" DIGR="I "_$E(DP,2,999) Q
                     39:        W !?5,"To list only those fields which have a particular 'GROUP'",!?5,"(or several 'GROUPS') associated with them, Enter the GROUP NAME",!
                     40:        W ?5,"To screen out a group, Type ""'"" in front of its name.",!
                     41:        G G

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