Return to DIP12.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIP12	;SFISC/TKW-PROCESS FROM-TO (CONT.) ;10/20/94  09:53
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
OPT	;COMPUTE SEARCH EFFICIENCY
	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)
	S X="DISX("_DJ_")",DPP(DJ,"GET")=""
	I +$P(S,"E")=S,F D GET^DIOU(S,F,X,.%) S DPP(DJ,"GET")=%
	I $D(DPP(DJ,"CM")) S DPP(DJ,"GET")=DPP(DJ,"CM")
	I $G(DPP(DJ,"SRTTXT"))="SORT" S DPP(DJ,"GET")=DPP(DJ,"GET")_" S:"_X_"]"""" "_X_"="_""" ""_"_X
	I $P(DPP(DJ),U,4)["@B" S %=X,DPP(DJ,"TXT")=N G O2
	I $G(DPP(DJ,"SRTTXT"))="RANGE" S X=""" ""_"_X
	I S,F=0 D BIJ^DIOU(S,.01,.%,.F) S X="D"_$G(%(S)) K %,F
	I '$D(DPP(DJ,"F")) S %=$$NULL^DIOC(X,"'"),DPP(DJ,"TXT")=N_" not null" G O2
	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
	S %=$G(DPP(DJ,"T")),TO=$P(%,U),TO(2)=$P(%,U,3) S:TO(2)="" TO(2)=$P(%,U,2)
	S %=""
	I FR="?z" D  G O2
	.I TO="z" S %="1",DPP(DJ,"TXT")="All "_N_" (includes nulls)" Q
	.I TO="@" S %=$$NULL^DIOC(X),DPP(DJ,"TXT")=N_" is null" Q
	.S %=$$AFT^DIOC(X,TO,"'")
	.S DPP(DJ,"TXT")=N_$S(TO(2)]"":" to "_TO(2),1:"")_" (includes nulls)"
	.Q
	S DPP(DJ,"TXT")=N_$S(FR(2)]"":" from "_FR(2),1:"")
	I TO="@"!(TO="z") D  G O2
	.S %="" I TO="@" S DPP(DJ,"TXT")=DPP(DJ,"TXT")_" (includes nulls)",%=$$NULL^DIOC(X)_"!("
	.S %=%_$$AFT^DIOC(X,FR) S:TO="@" %=%_")"
	.Q
	I FR(2)]"",FR(2)=TO(2) S %=$$EQ^DIOC(X,TO),DPP(DJ,"TXT")=N_" equals "_FR(2) G O2
	S %=$$BTWI^DIOC(X,FR,TO,"","SORT")
	I TO(2)]"" S DPP(DJ,"TXT")=DPP(DJ,"TXT")_" to "_TO(2)
O2	S DPP(DJ,"QCON")="I "_%
O3	I $O(DPP(DJ,0))!($D(DPP(DJ,"CM"))) G:'$D(DPP(DJ,"PTRIX")) O2Q
	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)
	Q:%=""
	S:X]"" DPP(DJ,"SER")=X_U_%
O2Q	K DITYP Q
	;
CK	;VALIDATE FIELDS/DATA
	G QQ:X[""""!(X[U) I X="@" S Y=X K DPP(DJ,"IX"),DPP(DJ,"PTRIX") Q
	I DITYP=1 S %DT="" D  D ^%DT K %DT G:Y=-1 QQ S Y(0)=$$FMTE^DILIBF(Y,2) Q
	. S:$G(DITYP("D"))["T" %DT="T"
	. S:$G(DITYP("D"))["S" %DT=%DT_"S"
	. S %DT=%DT_$E("E",(DIFRTO="?")) Q
	I DITYP=3 D  G:Y=-1 QQ Q
	. S Y=$G(DITYP("S","E",X)) I Y]"" S Y(0)=Y_" ("_X_")" W:DIFRTO="?" "    USES INTERNAL CODE: "_Y Q
	. I $D(DITYP("S","I",X)) S Y=X,Y(0)=X_" ("_DITYP("S","I",X)_")" W:DIFRTO="?" "  "_DITYP("S","I",X) Q
	. 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
	. I DIFRTO'="?" S Y=X Q
	. S Y=-1 Q
	I +$P(X,"E")=X!(DITYP'=2) S Y=X Q
QQ	S Y=-1,DIERR="Invalid Entry" Q:$G(DIQUIET)
	W $C(7),"??",DIERR Q