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