| 1 | DIQG ;SFISC/DCL-DATA RETRIEVAL PRIMITIVE ;29JUL2006
|
|---|
| 2 | ;;22.0;VA FileMan;**76,118,133,149**;Mar 30, 1999;Build 2
|
|---|
| 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 | I '$G(DA) N X S X(1)="RECORD" Q $$F(.X,2)
|
|---|
| 7 | S DIQGIPAR=$G(DIQGIPAR),DIQGPARM=$G(DIQGPARM)
|
|---|
| 8 | I 'DIQGIPAR N DIQGAUDR,DIQGAUDD S DIQGAUDD=+$P(DIQGPARM,"A",2) I DIQGAUDD D GET^DIAUTL(DIQGR,DA,DIQGAUDD,"DIQGAUDR")
|
|---|
| 9 | N DFF,DIQGSI,DIQGDD,DIQGWPB,DIQGWPO S DIQGDD=DIQGPARM["D",DIQGWPB=DIQGPARM["B"
|
|---|
| 10 | S DIQGWPO=1
|
|---|
| 11 | N DIQGEY S DIQGEY("FILE")=$G(DIQGR),DIQGEY("RECORD")=$G(DA),DIQGEY("FIELD")=$G(DR)
|
|---|
| 12 | I '$D(DIQGR) N X S X(1)="FILE" Q $$F(.X,1)
|
|---|
| 13 | I 'DIQGR,'DIQGIPAR N X S X(1)="FILE" Q $$F(.X,12)
|
|---|
| 14 | DA D:$G(DA)["," IEN(DA,.DA)
|
|---|
| 15 | I $G(DR)="" N X S X(1)="FIELD" Q $$F(.X,10)
|
|---|
| 16 | 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)
|
|---|
| 17 | S DIQGETA=$G(DIQGETA) I DIQGETA["("&(DIQGETA'[")") N X S X(1)="TARGET ARRAY" Q $$F(.X,14)
|
|---|
| 18 | I DIQGR S DFF=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)
|
|---|
| 19 | DFF S DIQGSI=$$CREF(DIQGR) I '$D(DFF) S DFF=+$P($G(@DIQGSI@(0)),U,2) I 'DFF,DIQGPARM'["D" N X S X("FILE")=DIQGSI Q $$F(.X,6) ;does the file exist?
|
|---|
| 20 | I '$D(@DIQGSI@(DA)),'DIQGIPAR,DIQGPARM'["A" Q $$F(.DIQGEY,19) ;Entry may have existed audited in the past
|
|---|
| 21 | I '$G(DT) N DT S DT=$$DT^DIQGU($H)
|
|---|
| 22 | N DIQGPI,DIQGZN S DIQGPI=DIQGPARM["I",DIQGZN=DIQGPARM["Z"
|
|---|
| 23 | N %,%H,%T,I,J,N,X
|
|---|
| 24 | D0 S X=0,N="D0" F S X=$O(DA(X)) Q:X'>0 S I=X,N=N_",D"_X
|
|---|
| 25 | N @N
|
|---|
| 26 | S @("D"_+$G(I)_"=DA") I $G(I) F J=I-1:-1:0 S @("D"_J_"=DA(I-J)")
|
|---|
| 27 | N C,P,Y,DIQGDN,DIQGD4,DIQGDRN
|
|---|
| 28 | S (X,Y)="",DIQGDRN=DR
|
|---|
| 29 | DD S DIQGDN="^DD("_$S(DIQGPARM["D":0,1:DFF)_")" ;name of ^DD
|
|---|
| 30 | FIELD 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)
|
|---|
| 31 | I DIQGDD,DIQGDRN'>0 D I $E(DIQGDRN,1,6)="$$$ NO" N X S X(1)="ATTRIBUTE" Q $$F(.X,17)
|
|---|
| 32 | .S DIQGDRN=$$DDN^DIQGU0(DR) Q:$E(DIQGDRN,1,6)="$$$ NO"
|
|---|
| 33 | .S DIQGDN="^DD("_$P(DIQGDRN,"^")_")",DIQGDRN=$P(DIQGDRN,"^",2)
|
|---|
| 34 | 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
|
|---|
| 35 | TRYCOMP N X,DIQGS I 'DIQGIPAR D EXPR(DFF,DR) ;DON'T ALLOW COMPUTED EXPRESSIONS EXCEPT FROM $$GET1^DIQ
|
|---|
| 36 | I $D(X) S C=Y G C:C["m" D CMPAUD(DR,$G(X("USED"))) I $D(X) X X Q X
|
|---|
| 37 | GIVEUP Q $$F(.DIQGEY,7)
|
|---|
| 38 | ;
|
|---|
| 39 | DIQ I DIQGDRN=.001 S Y=DA
|
|---|
| 40 | G BMW:C,REAL:C'["C"
|
|---|
| 41 | C I C["m" N X S X(1)="MULTILINE COMPUTED" Q $$F(.X,3)
|
|---|
| 42 | ;I DIQGPI Q "" MAR2001 GFT
|
|---|
| 43 | I DIQGDN="^DD(1.005)",DIQGDRN=1 S X=@DIQGSI@(DA,0)
|
|---|
| 44 | N DCC,DIQGH,X,DFF S DIQGH=$G(DIERR),DCC=DIQGR,DFF=+$P(DCC,"(",2)
|
|---|
| 45 | I $D(@DIQGDN@(DIQGDRN,9.01)),$D(^(9.1)) D CMPAUD(^(9.1),^(9.01)) I $D(X) X X I 1
|
|---|
| 46 | E S X="" X $P(@DIQGDN@(DIQGDRN,0),"^",5,999) ;HELLEVI
|
|---|
| 47 | D:DIQGH'=$G(DIERR)
|
|---|
| 48 | .N X
|
|---|
| 49 | .D BLD^DIALOG(120,"FIELD")
|
|---|
| 50 | I $G(X)=""!DIQGPI Q $G(X)
|
|---|
| 51 | CP I C["p",X S C=+$P(C,"p",2) I C,$D(^DIC(C,0,"GL")),$D(@(^("GL")_"0)")),$D(^(X,0)) Q $$EXTERNAL^DIDU(C,.01,"",$P(^(0),U))
|
|---|
| 52 | Q $S(C["D":$$FMTE^DILIBF(X,"1U"),1:X)
|
|---|
| 53 | ;
|
|---|
| 54 | REAL I $E($P(DIQGD4,";",2))="E" S Y=$E($G(@DIQGSI@(DA,P)),$E($P($P(DIQGD4,";",2),","),2,99),$P($P(DIQGD4,";",2),",",2)) S:Y?." " Y="" ;SPACES ARE NULL
|
|---|
| 55 | AUDIT I $G(DIQGAUDD) D ;Is there an AUDIT TRAIL for the field?
|
|---|
| 56 | .I $G(DIQGAUDR(DFF,$$DA^DIQGQ(.DA))) S Y="" Q ;If entry was created after DIQGAUDD, we know there were no FIELD values!
|
|---|
| 57 | .S P=$G(DIQGAUDR(DFF,$$DA^DIQGQ(.DA),DIQGDRN))
|
|---|
| 58 | .I P S Y=$$DIA^DIAUTL(DIQGAUDD,DIQGAUDR,P)
|
|---|
| 59 | .Q:C'["P"!'Y N F S F=+$P(C,"P",2) Q:F=DIQGEY("FILE")&(Y=DA)
|
|---|
| 60 | .S Y=$$GET1^DIQ(F,Y_",",.01,"A"_DIQGAUDD),C=$TR(C,"PO") ;Recurse to get old POINTER value (as long as recursion isn't infinite!)
|
|---|
| 61 | 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)
|
|---|
| 62 | Q $G(Y)
|
|---|
| 63 | ;
|
|---|
| 64 | 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 ""
|
|---|
| 65 | .I DIQGETA']"" K X S X(1)="TARGET ARRAY" D BLD^DIALOG(202,.X) S X="" Q
|
|---|
| 66 | .S X=DIQGR_DA_","_$$Q^DIQGU(P)_")"
|
|---|
| 67 | .I '$P($G(@X@(0)),"^",3) S X="" Q
|
|---|
| 68 | .I DIQGZN M @DIQGETA=@X K @DIQGETA@(0) Q
|
|---|
| 69 | .S Y=0 F S Y=$O(@X@(Y)) Q:Y'>0 I $D(^(Y,0)) S @DIQGETA@(Y)=^(0)
|
|---|
| 70 | .Q
|
|---|
| 71 | I C,$P(^DD(+C,.01,0),"^",2)["M" Q $$F(.DIQGEY,11)
|
|---|
| 72 | I DIQGPI!(DIQGDD) Q $G(Y)
|
|---|
| 73 | Q $$F(.DIQGEY,8)
|
|---|
| 74 | 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:"")
|
|---|
| 75 | 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)
|
|---|
| 76 | Q:DIQGP "$WP$" Q ""
|
|---|
| 77 | DY(Y) Q $$FMTE^DILIBF(Y,"1U")
|
|---|
| 78 | IEN(IEN,DA) S DA=$P(IEN,",") N I F I=2:1 Q:$P(IEN,",",I)="" S DA(I-1)=$P(IEN,",",I)
|
|---|
| 79 | Q
|
|---|
| 80 | DDROOT(X) Q:'$D(^DD(X)) "" Q "^DD("_X_","
|
|---|
| 81 | ;
|
|---|
| 82 | CMPAUD(DEXPR,DIQGS) ;DEXPR is Expression, DIQGS is string of Fields used
|
|---|
| 83 | Q:'$G(DIQGAUDD)
|
|---|
| 84 | N I,F,FD,A
|
|---|
| 85 | F I=1:1 S F=$P(DIQGS,";",I) Q:F="" D
|
|---|
| 86 | .S A=$G(DIQGAUDR(+F,$$DA^DIQGQ(.DA),$P(F,U,2)))
|
|---|
| 87 | .I A S DIQGS(1,+F,$P(F,U,2))=""""_$$CONVQQ^DILIBF($$DIA^DIAUTL(DIQGAUDD,+F,A))_""""
|
|---|
| 88 | S DIQGS("TODAY")=DIQGAUDD\1,DIQGS("TODAY","DATE")=1,DIQGS("NOW")=DIQGAUDD,DIQGS("NOW","DATE")=1 ;'TODAY' is the old date!
|
|---|
| 89 | ;now we call DICOMP with old (audit) values plugged in to the field's Computed Expression --
|
|---|
| 90 | D EXPR(DIQGAUDR,DEXPR)
|
|---|
| 91 | Q
|
|---|
| 92 | EXPR(DIFILE,DIEXPR) I DIQGPI K X Q:$TR(DIEXPR," 1234567890.?")="" S DIEXPR="INTERNAL("_DIEXPR_")"
|
|---|
| 93 | D EXPR^DICOMP(DIFILE,"",DIEXPR,.DIQGS)
|
|---|
| 94 | I 'DIQGPI,$G(Y)["D",Y'["m",$D(X)#2 S X=X_" S X=$$FMTE^DILIBF(X,""5U"")"
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | F(DIQGEY,X) D BLD^DIALOG($P($T(TXT+X),";",4),.DIQGEY)
|
|---|
| 98 | FE I $G(DIQGERRA)]"" D CALLOUT^DIEFU(DIQGERRA)
|
|---|
| 99 | Q ""
|
|---|
| 100 | TXT ;;
|
|---|
| 101 | ;;file root/ref invalid;202;1
|
|---|
| 102 | ;;record invalid;202;2
|
|---|
| 103 | ;;multiline computed;520;3
|
|---|
| 104 | ;;file ref invalid;202;4
|
|---|
| 105 | ;;field name/number invalid;202;5
|
|---|
| 106 | ;;DD ref for file/field invalid;401;6
|
|---|
| 107 | ;;unable to find field name;200;7
|
|---|
| 108 | ;;unable to identify type of data in DD;510;8
|
|---|
| 109 | ;;unable to resolve extended ref;501;9
|
|---|
| 110 | ;;field ref missing;202;10
|
|---|
| 111 | ;;multiple field - invalid parameters;309;11
|
|---|
| 112 | ;;file number not passed or invalid;202;12
|
|---|
| 113 | ;;;;13
|
|---|
| 114 | ;;invalid target array;202;14
|
|---|
| 115 | ;;ambiguous field name;505;15
|
|---|
| 116 | ;;record unavailable;602;16
|
|---|
| 117 | ;;invalid attribute;202;17
|
|---|
| 118 | ;;file not found;202;18
|
|---|
| 119 | ;;record entry does not exist;601;19
|
|---|
| 120 | ;;;;20
|
|---|
