Return to DIP12.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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