Annotation of freem_fileman/DICQ.m, revision 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

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