Return to DIP12.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIP12.m, revision 1.1.1.1

1.1       snw         1: DIP12  ;SFISC/TKW-PROCESS FROM-TO (CONT.) ;10/20/94  09:53
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4: OPT    ;COMPUTE SEARCH EFFICIENCY
                      5:        N S,F,X,%,FR,TO,N,Y S S=$P(DPP(DJ),U),F=$P(DPP(DJ),U,2),N=$P(DPP(DJ),U,3) S:N["""" N=$$CONVQQ^DILIBF(N)
                      6:        S X="DISX("_DJ_")",DPP(DJ,"GET")=""
                      7:        I +$P(S,"E")=S,F D GET^DIOU(S,F,X,.%) S DPP(DJ,"GET")=%
                      8:        I $D(DPP(DJ,"CM")) S DPP(DJ,"GET")=DPP(DJ,"CM")
                      9:        I $G(DPP(DJ,"SRTTXT"))="SORT" S DPP(DJ,"GET")=DPP(DJ,"GET")_" S:"_X_"]"""" "_X_"="_""" ""_"_X
                     10:        I $P(DPP(DJ),U,4)["@B" S %=X,DPP(DJ,"TXT")=N G O2
                     11:        I $G(DPP(DJ,"SRTTXT"))="RANGE" S X=""" ""_"_X
                     12:        I S,F=0 D BIJ^DIOU(S,.01,.%,.F) S X="D"_$G(%(S)) K %,F
                     13:        I '$D(DPP(DJ,"F")) S %=$$NULL^DIOC(X,"'"),DPP(DJ,"TXT")=N_" not null" G O2
                     14:        S %=$G(DPP(DJ,"F")),FR=$P(%,U),FR(2)=$P(%,U,3) S:FR(2)="" FR(2)=$P(%,U,2) S:$E(FR,1)="""" FR=""""_FR
                     15:        S %=$G(DPP(DJ,"T")),TO=$P(%,U),TO(2)=$P(%,U,3) S:TO(2)="" TO(2)=$P(%,U,2)
                     16:        S %=""
                     17:        I FR="?z" D  G O2
                     18:        .I TO="z" S %="1",DPP(DJ,"TXT")="All "_N_" (includes nulls)" Q
                     19:        .I TO="@" S %=$$NULL^DIOC(X),DPP(DJ,"TXT")=N_" is null" Q
                     20:        .S %=$$AFT^DIOC(X,TO,"'")
                     21:        .S DPP(DJ,"TXT")=N_$S(TO(2)]"":" to "_TO(2),1:"")_" (includes nulls)"
                     22:        .Q
                     23:        S DPP(DJ,"TXT")=N_$S(FR(2)]"":" from "_FR(2),1:"")
                     24:        I TO="@"!(TO="z") D  G O2
                     25:        .S %="" I TO="@" S DPP(DJ,"TXT")=DPP(DJ,"TXT")_" (includes nulls)",%=$$NULL^DIOC(X)_"!("
                     26:        .S %=%_$$AFT^DIOC(X,FR) S:TO="@" %=%_")"
                     27:        .Q
                     28:        I FR(2)]"",FR(2)=TO(2) S %=$$EQ^DIOC(X,TO),DPP(DJ,"TXT")=N_" equals "_FR(2) G O2
                     29:        S %=$$BTWI^DIOC(X,FR,TO,"","SORT")
                     30:        I TO(2)]"" S DPP(DJ,"TXT")=DPP(DJ,"TXT")_" to "_TO(2)
                     31: O2     S DPP(DJ,"QCON")="I "_%
                     32: O3     I $O(DPP(DJ,0))!($D(DPP(DJ,"CM"))) G:'$D(DPP(DJ,"PTRIX")) O2Q
                     33:        S N='$G(DIQUIET),(X,%)="" D SER^DIOQ(S,DPP(DJ,"GET"),DPP(DJ,"QCON"),$D(DPP(DJ,"IX"))#2,.X,.%,N,$D(DPP(DJ,"PTRIX"))#2)
                     34:        Q:%=""
                     35:        S:X]"" DPP(DJ,"SER")=X_U_%
                     36: O2Q    K DITYP Q
                     37:        ;
                     38: CK     ;VALIDATE FIELDS/DATA
                     39:        G QQ:X[""""!(X[U) I X="@" S Y=X K DPP(DJ,"IX"),DPP(DJ,"PTRIX") Q
                     40:        I DITYP=1 S %DT="" D  D ^%DT K %DT G:Y=-1 QQ S Y(0)=$$FMTE^DILIBF(Y,2) Q
                     41:        . S:$G(DITYP("D"))["T" %DT="T"
                     42:        . S:$G(DITYP("D"))["S" %DT=%DT_"S"
                     43:        . S %DT=%DT_$E("E",(DIFRTO="?")) Q
                     44:        I DITYP=3 D  G:Y=-1 QQ Q
                     45:        . S Y=$G(DITYP("S","E",X)) I Y]"" S Y(0)=Y_" ("_X_")" W:DIFRTO="?" "    USES INTERNAL CODE: "_Y Q
                     46:        . I $D(DITYP("S","I",X)) S Y=X,Y(0)=X_" ("_DITYP("S","I",X)_")" W:DIFRTO="?" "  "_DITYP("S","I",X) Q
                     47:        . S D=$O(DITYP("S","E",X)) I D]"",$P(D,X)="" S Y=DITYP("S","E",D),Y(0)=Y_" ("_D_")" W:DIFRTO="?" $P(D,X,2,9)_"    USES INTERNAL CODE: "_Y Q
                     48:        . I DIFRTO'="?" S Y=X Q
                     49:        . S Y=-1 Q
                     50:        I +$P(X,"E")=X!(DITYP'=2) S Y=X Q
                     51: QQ     S Y=-1,DIERR="Invalid Entry" Q:$G(DIQUIET)
                     52:        W $C(7),"??",DIERR Q