Annotation of freem_fileman/DIS.m, revision 1.1.1.1

1.1       snw         1: DIS    ;SFISC/GFT-GATHER SEARCH CRITERIA ;9/30/94  15:57
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        K ^UTILITY($J),DC,DIS,%ZIS,O,N,R D ^DICRW
                      5:        G Q:'$D(DIC)!$D(DTOUT)
                      6: EN     ;
                      7:        S:DIC DIC=$S($D(^DIC(DIC,0,"GL")):^("GL"),1:"") Q:DIC=""
                      8:        K DI,DX,DY,I,J,DL,DC,DA,DTOUT,^UTILITY($J) G Q:'$D(@(DIC_"0)"))
                      9:        S (R,DI,I(0))=DIC,(DL,DC)=1,DY=999,N=0,Q="""",DV="" D DL
                     10: R      ;
                     11:        I +R=R S (J(N),DK)=R,R=""
                     12:        E  S @("(J(N),DK)=+$P("_R_"0),U,2)"),R=$P(^(0),U)
                     13: F      ;
                     14:        W ! K X,DIC,P D W S DIC(0)="EZ",C=",",DIC="^DD("_DK_C,DIC("W")="S %=$P(^(0),U,2) W:% $S($P(^DD(+%,.01,0),U,2)[""W"":""   (word-processing)"",1:""   (multiple)"")",DIC("S")="I $P(^(0),U,2)'[""m"""_$S($D(DICS):" "_DICS,1:""),DU=""
                     15:        W "SEARCH FOR "_R_" "_$P(^DD(DK,0),U,1)_": "
                     16:        R X:DTIME S:'$T DTOUT=1 G Q:X=U!'$T,TEM^DIS2:X?1"[".E D  I Y>0 K P S DE=Y(0),O(DC)=$P(DE,U,1),DU=+Y,Z=$P(DE,U,3),E=$P(DE,U,2) G G
                     17:        .N DISVX S DISVX=X D ^DIC S:Y=-1 X=DISVX Q
                     18: HARD   G UP:X="",F:X?."?",Q:X=U!($D(DTOUT)),COMP^DIS2
                     19: DL     ;S DL=$S('$D(DIARF0):DL,1:DIARF1+DL)
                     20:        Q
                     21: G      ;
                     22:        K X,DIC S DIC="^DOPT(""DIS"",",DIC(0)="QEZ" I E["B" S X="" G OK
                     23:        I E S N(DL)=N,N=N+1,DV(DL)=DV,DL(DL)=DK,DK=+E,J(N)=DK,X=$P($P(DE,U,4),";",1),I(N)=$S(+X=X:X,1:Q_X_Q),Y(0)=^DD(DK,.01,0),DL=DL+1 G WP:$P(Y(0),U,2)["W" S DV=DV_+Y_C G F
                     24:        I E["P" S P=+Y_U_Y(0),X="#"_+Y_":.01" G HARD
                     25: C      D W R "CONDITION: ",X:DTIME S:'$T DTOUT=1 G Q:X[U!'$T
                     26:        S DN=$S("'-"[$E(X):"'",1:""),X=$E(X,DN]""+1,99) D ^DIC
                     27:        G:Y<0 Q:X[U,B:X="",DISC^DIQQQ:X["?",C
                     28:        S O=$P("NOT ",U,DN]"")_$P(Y,U,2)
                     29:        I +Y=1 S X=DN_"?."" """,O(DC)=O(DC)_" "_O G OK
                     30:        S DQ=Y D W W O I E["D",Y-3 R " DATE: ",X:DTIME S:'$T DTOUT=1 G Q:X=U!'$T S %DT="TE" D ^%DT S X=Y_U_X G X:Y<0 X ^DD("DD") S Y=X_U_Y G GOT
                     31:        ;POINTERS
                     32: PT     I $D(P),+DQ=5 K DIC,DIS($C(DC+64)_DL) S DIC=U_$P(P,U,4),DIC(0)="EMQ",DU=+P W " "_$P(@(DIC_"0)"),U,1)_": " R X:DTIME S:'$T DTOUT=1 G Q:U[X!'$T D ^DIC G GOT:Y>0,PT
                     33:        R ": ",Y:DTIME I '$T S DTOUT=1 G Q
                     34:        G X:Y="" I Y[U,$P(DE,U,4)'[";E" G X
                     35:        I +DQ=3 S X="I X?"_Y D ^DIM G GOT:$D(X) S Y="?"
                     36:        G DIS^DIQQQ:Y?."?",T:E'["S",N:+DQ'=5 S Y=":"_Y
                     37:        ;SET OF CODES
                     38:        F X=1:1 S D=$P(Z,";",X) Q:D=""  I D[Y W $P(D,Y,2) S Y=$P(D,":")_U_$P(D,":",2) G T
                     39:        S %="",Y="""" W $C(7),!,"[ Enter EXTERNAL VALUE for one of the following: ",!
                     40:        G O
                     41: N      S %="[ WILL APPLY TO:" W $C(7),!?7
                     42: O      F X=1:1 S D=$P(Z,";",X),DE=$P(D,":",2) Q:D=""  W % W:X>1 "," W " " S %="'"_$P(D,":")_"' ("_DE_")",DIS(U,DC,$P(D,":",1))=DE W:$X+$L(%)>73 !?7
                     43:        W:X>2 "AND " W %_" ]"
                     44:        I +DQ=5,$P(Y,U)[Q K DIS(U,DC)
                     45: T      I DQ["THAN",+$P(Y,U)'=$P(Y,U) G X
                     46:        I DQ#3=2 G X:$P(Y,U)[Q I +$P(Y,U)'=$P(Y,U) S $P(Y,U)=Q_$P(Y,U)_Q
                     47: GOT    S X=DN_$E(" [?<=>",DQ)_$P(Y,U) I E["D" S Y=$P(Y,U,3)_U_$P(Y,U,2)
                     48:        S O(DC)=O(DC)_" "_O_" "_Y
                     49: OK     S DC(DC)=DV_DU_U_X_U_$P(Y,U,2),%=DL-1_U_(N#100)
                     50:        I DL>1,O(DC)'[R S O(DC)=R_" "_O(DC)
                     51:        S:DU["W" %=DL-2_U_(N#100-1) S DX(DC)=%,DC=DC+1
                     52: B      G F:DU'["W"
                     53: UP     I DC>1 G ^DIS0:DL<$S('$D(DIARF0):2,1:2) S DL=DL-1,DV=DV(DL),DK=DL(DL),N=N(DL),R=$S($D(R(DL)):R(DL),1:R) K R(DL) S %=N F  S %=$O(I(%)) S:%="" %=-1 G F:%<0 K I(%),J(%)
                     54: Q      G Q^DIS2:'$D(DIARU),^DIS2
                     55:        ;
                     56: WP     S DIC("S")="I Y<3",DU=+Y_"W" G C
                     57:        ;
                     58: X      ;
                     59:        W $C(7),"??",!! G B
                     60:        ;
                     61: W      W !?DL*2,"-"_$C(DC+64)_"- " Q
                     62: ENS    ; ENTRY POINT FOR RE-DOING THE SORT USING AN EXISTING SORT TEMPLATE
                     63:        G EN^DIS3

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