Annotation of freem_fileman/DIQG.m, revision 1.1.1.1
1.1 snw 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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIQG.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman