[BACK]Return to DIQG.m CVS log [TXT] [DIR] Up to [Coherent Logic Development] / freem_fileman / USER
File:  [Coherent Logic Development] / freem_fileman / USER / DIQG.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIQG	;SFISC/DCL-DATA RETRIEVAL PRIMITIVE;10:16 AM  1 Dec 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: GET(DIQGR,DA,DR,DIQGPARM,DIQGETA,DIQGERRA,DIQGIPAR)	; file,rec,fld,parm,targetarray,errarray,int
    5: DDENTRY	I $G(U)'="^" N U S U="^"
    6: 	N DIQGDD,DIQGWPB,DIQGWPO S DIQGPARM=$G(DIQGPARM),DIQGIPAR=$G(DIQGIPAR),DIQGDD=DIQGPARM["D",DIQGWPB=DIQGPARM["B"
    7: 	S DIQGWPO=1
    8: 	;I DIQGIPAR'["A" K DIERR,^TMP("DIERR",$J)
    9: 	N DIQGEY S DIQGEY("FILE")=$G(DIQGR),DIQGEY("RECORD")=$G(DA),DIQGEY("FIELD")=$G(DR)
   10: 	I '$D(DIQGR) N X S X(1)="FILE" Q $$F(.X,1)
   11: 	I 'DIQGR,'DIQGIPAR N X S X(1)="FILE" Q $$F(.X,12)
   12: 	I '$D(DA) N X S X(1)="RECORD" Q $$F(.X,2)
   13: 	D:$G(DA)["," IEN(DA,.DA)
   14: 	I '$D(DR) N X S X(1)="FIELD" Q $$F(.X,10)
   15: 	I 'DIQGIPAR,'DIQGDD Q:$$N9^DIQGU(DIQGR,.DA) $$F(.DIQGEY,16) I '$D(^DD(DIQGR)) N X S X(1)="FILE" Q $$F(.X,18)
   16: 	S DIQGETA=$G(DIQGETA) I DIQGETA["("&(DIQGETA'[")") N X S X(1)="TARGET ARRAY" Q $$F(.X,14)
   17: 	S:DIQGR DIQGR=$S(DIQGDD:$$DDROOT(DIQGR),1:$$ROOT^DIQGU(DIQGR,.DA)) I DIQGR="" N X S X(1)="FILE and/or IEN" Q $$F(.X,4)
   18: 	N DIQGSI S DIQGSI=$$CREF(DIQGR)
   19: 	Q:'$D(@DIQGSI@(DA)) $$F(.DIQGEY,19)
   20: 	I $D(DT)#2-1 N DT S DT=$$DT^DIQGU($H)
   21: 	I DR[":" S DIQGEY(1)=$P(DR,":") N X S X=$$GET(DIQGR,DA,$P(DR,":"),"I","","","1A") Q:X'>0 $$F(.DIQGEY,9) Q $$GET("^"_$P(^(0),"^",3),X,$P(DR,":",2,99),DIQGPARM,"","","1A")
   22: 	N DIQGPI,DIQGZN S DIQGPI=DIQGPARM["I",DIQGZN=DIQGPARM["Z"
   23: 	I DR']"" N X S X(1)="FIELD" Q $$F(.X,5)
   24: 	N %,%H,%T,I,J,N,X
   25: 	S X=0,N="D0" F  S X=$O(DA(X)) Q:X'>0  S I=X,N=N_",D"_X
   26: 	N @N
   27: 	S @("D"_+$G(I)_"=DA") I $G(I) F J=I-1:-1:0 S @("D"_J_"=DA(I-J)")
   28: 	N C,P,Y,DIQGDN,DIQGD4,DIQGDRN
   29: 	S (X,Y)="",DIQGDRN=DR
   30: 	S:$D(@DIQGSI@(0)) DIQGDN="^DD("_+$P(^(0),"^",2)_")" I '$D(DIQGDN) N X S X("FILE")=DIQGSI Q $$F(.X,6)
   31: 	I DR'?.N,$D(@DIQGDN@("B",DR)) S DIQGDRN=$O(^(DR,"")) I $O(^(DIQGDRN)) N X S X("FILE")=DIQGDN,X(1)=DR Q $$F(.X,15)
   32: 	I DIQGDD,DIQGDRN'>0 D  I $E(DIQGDRN,1,6)="$$$ NO" N X S X(1)="ATTRIBUTE" Q $$F(.X,17)
   33: 	.S DIQGDRN=$$DDN^DIQGU0(DR) Q:$E(DIQGDRN,1,6)="$$$ NO"
   34: 	.S DIQGDN="^DD("_$P(DIQGDRN,"^")_")",DIQGDRN=$P(DIQGDRN,"^",2)
   35: 	I DIQGDRN>0,$D(@DIQGDN@(DIQGDRN,0)) S DIQGD4=$P(^(0),"^",4),C=$P(^(0),"^",2),P=$P(DIQGD4,";") G:$P(DIQGD4,";",2)'>0 DIQ S Y=$P($G(@DIQGSI@(DA,P)),"^",$P(DIQGD4,";",2)) G DIQ
   36: 	Q $$F(.DIQGEY,7)
   37: DIQ	I DIQGDRN=.001 S Y=DA
   38: 	I C G BMW
   39: 	I C["Cm" N X S X(1)="MULTILINE COMPUTED" Q $$F(.X,3)
   40: 	I C["C",DIQGPI Q ""
   41: 	I C["C",DIQGDN="^DD(1.005)",DIQGDRN=1 S X=@DIQGSI@(DA,0)
   42: 	I C["C",$D(@DIQGDN@(DIQGDRN,0)) N DCC,DFF,DIQGH S DIQGH=$G(DIERR),DCC=DIQGR,DFF=+$P(DCC,"(",2) X $P(^(0),"^",5,999) D:DIQGH'=$G(DIERR)  Q $S(C["D":$$FMTE^DILIBF($G(X),"1U"),1:$G(X))
   43: 	.N X
   44: 	.D BLD^DIALOG(120,"FIELD")
   45: 	.Q
   46: 	I 'DIQGPI&(C["O"!(C["S")!(C["P")!(C["V")!(C["D"))&($D(@DIQGDN@(DIQGDRN,0))) S C=$P(^(0),"^",2) Q $$EXTERNAL^DIDU(+$P(DIQGDN,"(",2),DIQGDRN,"",Y)
   47: 	I C["F",$E($P(DIQGD4,";",2))="E" Q $E($G(@DIQGSI@(DA,P)),$E($P($P(DIQGD4,";",2),","),2,99),$P($P(DIQGD4,";",2),",",2))
   48: 	I C["F"!(C["N") Q $G(Y)
   49: 	I C["K" Q $E($G(@DIQGSI@(DA,P)),$E($P($P(DIQGD4,";",2),","),2,99),$P($P(DIQGD4,";",2),",",2))
   50: 	I C["C" Q $G(Y)
   51: BMW	I C,$P(^DD(+C,.01,0),"^",2)["W" Q:DIQGWPB "$CREF$"_DIQGR_DA_","_$$Q^DIQGU(P)_")" D  G:X="" FE Q:DIQGWPO $NA(@DIQGETA) Q:DIQGIPAR "$WP$" Q ""
   52: 	.I DIQGETA']"" K X S X(1)="TARGET ARRAY" D BLD^DIALOG(202,.X) S X="" Q
   53: 	.S X=DIQGR_DA_","_$$Q^DIQGU(P)_")"
   54: 	.I '$P($G(@X@(0)),"^",3) S X="" Q
   55: 	.I DIQGZN M @DIQGETA=@X K @DIQGETA@(0) Q
   56: 	.S Y=0 F  S Y=$O(@X@(Y)) Q:Y'>0  I $D(^(Y,0)) S @DIQGETA@(Y)=^(0)
   57: 	.Q
   58: 	I C,$P(^DD(+C,.01,0),"^",2)["M" Q $$F(.DIQGEY,11)
   59: 	I DIQGPI!(DIQGDD) Q $G(Y)
   60: 	Q $$F(.DIQGEY,8)
   61: CREF(X)	N L,X1,X2,X3 S X1=$P(X,"("),X2=$P(X,"(",2,99),L=$L(X2),X3=$TR($E(X2,L),",)"),X2=$E(X2,1,(L-1))_X3 Q X1_$S(X2]"":"("_X2_")",1:"")
   62: WP(DIQGSA,DIQGTA,DIQGZN,DIQGP)	N DIQG S DIQG=0 F  S DIQG=$O(@DIQGSA@(DIQG)) Q:DIQG'>0  I $D(^(DIQG,0)) S @$S(DIQGZN:"@DIQGTA@(DIQG,0)",1:"@DIQGTA@(DIQG)")=^(0)
   63: 	Q:DIQGP "$WP$" Q ""
   64: DY(Y)	Q $$FMTE^DILIBF(Y,"1U")
   65: IEN(IEN,DA)	S DA=$P(IEN,",") N I F I=2:1 Q:$P(IEN,",",I)=""  S DA(I-1)=$P(IEN,",",I)
   66: 	Q
   67: DDROOT(X)	Q:'$D(^DD(X)) "" Q "^DD("_X_","
   68: 	;
   69: F(DIQGEY,X)	D BLD^DIALOG($P($T(TXT+X),";",4),.DIQGEY)
   70: FE	I $G(DIQGERRA)]"" D CALLOUT^DIEFU(DIQGERRA)
   71: 	Q ""
   72: TXT	;;
   73: 	;;file root/ref invalid;202;1
   74: 	;;record invalid;202;2
   75: 	;;multiline computed;520;3
   76: 	;;file ref invalid;202;4
   77: 	;;field name/number invalid;202;5
   78: 	;;DD ref for file/field invalid;401;6
   79: 	;;unable to find field name;200;7
   80: 	;;unable to identify type of data in DD;510;8
   81: 	;;unable to resolve extended ref;501;9
   82: 	;;field ref missing;202;10
   83: 	;;multiple field - invalid parameters;309;11
   84: 	;;file number not passed or invalid;202;12
   85: 	;;;;13
   86: 	;;invalid target array;202;14
   87: 	;;ambiguous field name;505;15
   88: 	;;record unavailable;602;16
   89: 	;;invalid attribute;202;17
   90: 	;;file not found;202;18
   91: 	;;record entry does not exist;601;19
   92: 	;;;;20
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>