Return to DICQ.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICQ.m, revision 1.1.1.1

1.1       snw         1: DICQ   ;SFISC/XAK-HELP FOR LOOKUPS ;12/21/94  12:44
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        S DZ=X D:DIC(0)]"" DQ
                      5:        I '$D(DDS),$D(DDH)#2,DDH D ^DDSU
                      6:        S:$D(DZ) X=DZ K DZ,DDH,DIZ,DDD G NO^DIC:$D(DTOUT),A^DIC
                      7:        ;
                      8: DQ     S DDC=$S($D(DDS):7,1:15),DDH=$S($D(DDH):DDH,1:0)
                      9:        D:'$D(DO) DO^DIC1 K DS,%Y I DO="0^-1" K DO S DST="  Pointed-to File does not exist!" D % Q
                     10:        S DD="",Y=$P(DO,U,4),DIY=DO,DIX=D D DIY
                     11:        S X=$S($D(^DD(+DO(2),.001,0)):$P(^(0),U,1),DIC(0)["N":"NUMBER",1:""),DIZ=X]"",DIW=^DD(+DO(2),.01,0)
                     12:        S DIW=$P(DIW,U,2,3) G:$D(^DD(+DO(2),0,"QUES")) @^("QUES") I DIZ S DS=.001 D DS
                     13: IX     S X=$O(^DD(+DO(2),0,"IX",DIX,"")) S:X="" %=DO(2) I X]"" S DS=$O(^(X,0)) I $D(^DD(X,DS,0)) S:+DO(2)'=X DS=X_" "_DS S %=$P(^(0),U,2,3),X=$P(^(0),U) D DS
                     14:        I @("$D("_DIC_"DIX))>9!$D(DF)"),DD="" S DD=DIX,DIW=% S:'Y Y=2 S:'$D(^(DD)) Y=0,DIZ=0
                     15:        S DIX=$O(^(DIX)) G IX:DIC(0)["M"&(DIX]"")
                     16:        I DD="" S DIZ=1 S:$O(^("AZ"))]"" Y=0
                     17:        I $D(DZ)#2 G C:DZ["??" S:DZ["BAD" Y=0
                     18:        S DST=$$EZBLD^DIALOG(8063,$P(DO,U)) S DS=0
                     19:        F X=1:1 S DS=$O(DS(DS)) Q:DS=""  S:X>1!$G(DS(0)) DST=DST_$$EZBLD^DIALOG(8067) D:$L(DST)+$L(DS(DS))>70 N S DST=DST_" "_DS(DS)
                     20:        K DS S DST=DST_$E(":",Y) D % G 0:'Y
                     21: 20     G C:Y<11 S DDH=DDH+1,DDH(DDH,"Q")=0_U_$$EZBLD^DIALOG(8064)_$S(DO(2)'["s"&'$D(DIC("S"))&'$D(DF):$$EZBLD^DIALOG(8065,Y),1:"")_$$EZBLD^DIALOG(8066,$P(DO,U))
                     22:        S:$D(DDS) DDD=1 D ^DDSU I '$D(DDS) Q:$D(DTOUT)  G 21
                     23:        Q:$D(DDSQ)  S %=1
                     24: 21     S A1="T",DDH=$S($D(DDH):DDH,1:0) S:%=1 %Y=1 I %Y'="??" S %Y=$E(%Y,2,99) S:%=2&(DIC(0)["L") DZ=""
                     25:        G 0:%#2=0!(%<0&(%Y="")),C:%Y=""
                     26:        S DIZ=$S(+%Y=%Y:1,DD]"":0,1:DIZ) I +%Y'=%Y G 20:DD="" I $P(DIW,U,1)["D" S DS=Y,X=%Y,%DT="T" D ^%DT K %DT S %Y=Y,Y=DS,DIZ=0 I %Y<0 S DST=$C(7) D % G 20
                     27: C      I Y>1,$D(DZ)#2 S DST=" " D:DZ["??"&'$D(DDS) % S DST=$$EZBLD^DIALOG(8068) D %
                     28:        S X=$P(" D S I ",U,$D(DIC("S"))!$D(DO("SCR")))
                     29:        I DIZ S DS="I $D(^(Y,0))#2,'$D(^(-9)) S X=$P(^(0),""^"",1)"_X_" S DDH=DDH+1,DDH(DDH,Y)=Y_$E(DIEQ,1,15-$L(Y))_"" """,DIX="S Y=$O("_DIC_"Y)) S:Y="""" Y=-1 I Y'>0" G A
                     30:        S DIX="S X=$O("_DIC_""""_DD_""",X)) I X="""""
                     31:        S DS=$S(X]""!$D(DIC("W"))!($G(DZ)["?"):"S Y=0 F  S Y=$O("_DIC_""""_DD_""",X,Y)) Q:'Y "_$P(" I $D(^(Y))#2,'^(Y)",1,DD="B")_" I $D("_DIC_"Y,0)),'$D(^(-9))"_X_" D CHK Q:$D(DICQ1Q) ",1:"I 1")_" S DDH=DDH+1"
                     32: A      S X="X"
                     33: D      S Y=$P(DIW,U,1) I Y["D" S DIY=27,X=" S %="_X_"_U_"_DIZ_" D DT" G ^DICQ1
                     34:        I Y["P" S DIY=U_$P(DIW,U,2),X="$S($D("_DIY_X_",0))#2:$P(^(0),""^"",1),1:"_X_")" I @("$D("_DIY_"0))") S DIY=^(0) D DIY S DIW=$P(^(0),U,2,3) G D
                     35:        I Y["S" S DS(95)=";"_$P(DIW,U,2),X="$P($P(DS(95),"";""_"_X_"_"":"",2),"";"")"
                     36:        I Y["V" S X=" S %Y=Y,Y=X,C=$P(^DD(+DO(2),.01,0),U,2) D Y^DIQ S DDH(DDH,%Y)=$S($D(DDH(DDH,%Y)):DDH(DDH,%Y),1:"""")_"" ""_Y S Y=%Y" G ^DICQ1
                     37:        S X=" S DDH(DDH,Y)=$G(DDH(DDH,Y))"_"_"_X
                     38: M      G ^DICQ1
                     39:        ;
                     40: N      D % S DST="    " Q
                     41:        ;
                     42: %      S DDH=DDH+1,DDH(DDH,"T")=DST K DST Q
                     43:        ;
                     44: 0      K DIW,DIZ,DS Q:$D(DTOUT)  S:$D(DDS) DDD=1 G 0^DICQ1:DIC(0)["L" Q  ;END
                     45:        ;
                     46: DIY    S DIY=$P(^DD(+$P(DIY,U,2),.01,0),"$L(X)>",2),DIY=$S(DIY:DIY,1:30)+7 Q
                     47:        ;
                     48: SOUNDEX        G IX
                     49:        ;
                     50: DS     S:DO'[X DS(DS)=X I DO[X,$G(DZ)'["??" S DS(0)=1
                     51:        ;
                     52:        ;#8063  Answer with |Filename|
                     53:        ;#8064  Do you want the entire
                     54:        ;#8065  |Number of entries| Entry
                     55:        ;#8066  |Filename| List
                     56:        ;#8067  , or
                     57:        ;#8068  Choose from