source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIQGQ.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.3 KB
RevLine 
[613]1DIQGQ ;SFISC/DCL-DATA RETRIEVAL ;03:48 PM 26 Mar 2001
2 ;;22.0;VA FileMan;**76**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;RECURSIVELY CALLED FROM BELOW
5DDENTRY N DIQGQE S DIQGQE=0
6 I $G(U)'="^" N U S U="^"
7 I '$G(DA) N X S X(1)="RECORD" G 202
8 ;K DIERR,^TMP("DIERR",$J)
9 ;N DIERR
10 N DIQGCP,DIQGDD S DIQGPARM=$G(DIQGPARM),DIQGIPAR=$G(DIQGIPAR),DIQGDD=DIQGPARM["D",DIQGCP=$S(DIQGDD:"D",1:"") S:DIQGPARM["Z" DIQGCP=DIQGCP_"Z" S:DIQGPARM["F" DIQGCP=DIQGCP_"F"
11 N DIQGFE,DIQGFEN S DIQGFE=DIQGPARM["R"
12 N DIQGFET S DIQGFET=DIQGPARM["T"
13 I '$D(DIQGR) N X S X(1)="FILE" G 202
14 N DIQGI1 S DIQGI1=+DIQGIPAR=0
15 I DIQGI1,'DIQGR N X S X(1)="FILE" G 202
16 D:$G(DA)["," IEN(DA,.DA)
17 I DIQGI1,'DIQGDD,$$N9^DIQGU(DIQGR,.DA) D BLD^DIALOG(602) G OUT
18 I '$D(DR) N X S X(1)="FIELD" G 202
19 I DIQGI1,$G(DIQGTA)']"" N X S X(1)="TARGET ARRAY" G 202
20 I DIQGI1,("("[$G(DIQGTA)&(")"'[$G(DIQGTA))) N X S X(1)="TARGET ARRAY" G 202
21 S:DIQGR DIQGR=$S(DIQGDD:$$DD(DIQGR),1:$$ROOT^DIQGU(DIQGR,.DA)) I DIQGR="" N X S X(1)="FILE AND IEN COMBINATION" G 202
22 N DIQGMDD,DIQGE,DIQGI,DIQGXXE,DIQGXXI,DIQGSI,DIQGXAF,DIQGXPRI,DIQGXPRE,DIQGXPRN,DIQGXPRF,DIQGXDD,DIQGXDDN,DIQGXPRA,DIQGXTA,DIQGXDA,DIQGXPRS,DIQGPRSE S DIQGPRSE=1
23 S DIQGSI=$$CREF(DIQGR),DIQGXAF=0,DIQGXPRI=DIQGPARM["I",DIQGXPRE=DIQGPARM["E",DIQGXPRN=DIQGPARM["N",DIQGXPRF=DIQGPARM["F",DIQGXPRS=DIQGPARM["S" S:DIQGXPRS DIQGXPRE=1,DIQGXPRI=1 S DIQGXPRA=DIQGXPRE!DIQGXPRI
24 I '$D(@DIQGSI@(DA)),DIQGPARM'["A" D BLD^DIALOG(601) G OUT ;Entry may have existed in the past
25 S:$D(@DIQGSI@(0)) DIQGXDDN=+$P(^(0),"^",2),DIQGXDD="^DD("_DIQGXDDN_")" I '$D(DIQGXDD) N X S X("FILE")=DIQGR D BLD^DIALOG(401,.X) G OUT
26 S:'DIQGXDDN DIQGXDDN=+$P(DIQGR,"(",2)
27 I $D(DIQGTA)=1,DIQGTA]"",DIQGTA'>0 S DIQGXAF=1,DIQGXTA=DIQGTA S DIQGXTA=$$CREF(DIQGXTA)
28 N DIQGXDC,DIQGXDF,DIQGXDI,DIQGXDN,DIQGXDT S DIQGXDC=0
29AUDIT I DIQGIPAR'["R" N DIQGAUDR,DIQGAUDD S DIQGAUDD=+$P(DIQGPARM,"A",2) I DIQGAUDD D GET^DIAUTL(DIQGXDDN,DA_",",DIQGAUDD,"DIQGAUDR") ;is there and AUDIT TRAIL??
30 F DIQGXDI=1:1 S DIQGXDF=$P(DR,";",DIQGXDI),DIQGXDN=$P(DIQGXDF,":") Q:DIQGXDF="" D I $L(DIQGXDF,":")>1 S DIQGXDT=$P(DIQGXDF,":",2) F S DIQGXDN=$O(@DIQGXDD@(+DIQGXDN)) Q:DIQGXDN'>0!(DIQGXDN>DIQGXDT) S DIQGXDC=$P(^(DIQGXDN,0),"^",2) D ;
31 .I DIQGXDC,$P(^DD(+DIQGXDC,.01,0),"^",2)'["W" S:DR="**" DIQGXDN=DIQGXDN_"*" Q:$L(DIQGXDN,"*")'=2
32 .I DIQGXDN'?.N,$L(DIQGXDN,"*")=2,$P(DIQGXDN,"*")]"",$D(@DIQGXDD@("B",$P(DIQGXDN,"*"))) S DIQGXDN=$O(^($P(DIQGXDN,"*"),""))_"*"
33 .I $L(DIQGXDN,"*")=2,+DIQGXDN>0 S DIQGMDD=+$P($G(@DIQGXDD@(+DIQGXDN,0)),"^",2) I DIQGMDD,$P(^DD(DIQGMDD,.01,0),"^",2)'["W" D Q
34 ..N DIQGMDA,DIQGMGR
35 ..D F S DIQGMDA=$O(@DIQGMGR@(DIQGMDA)) Q:DIQGMDA'>0 D EN($S('DIQGDD:DIQGMDD,1:$$OREF(DIQGMGR)),.DIQGMDA,"**",DIQGPARM,.DIQGTA,"",''DIQGDD_"R")
36 ...N I F I=1:1 Q:'$D(DA(I)) S DIQGMDA(I+1)=DA(I)
37 ...S DIQGMDA(1)=DA,DIQGMGR=$S('DIQGDD:$$ROOT^DIQGU(DIQGMDD,.DIQGMDA,1),1:DIQGR_DA_","_$$Q($P($P(@DIQGXDD@(+DIQGXDN,0),"^",4),";"))_")"),DIQGMDA=0
38 ...Q
39 .I DIQGXDN="*"!(DIQGXDN="**") S DIQGXDN=0,DIQGXDF=":999999999" Q
40 .S DIQGXDA=$$DA(.DA),DIQGFEN=$S((DIQGFE&(DIQGXDN))!(DIQGFET):$P(@DIQGXDD@(DIQGXDN,0),"^"),1:DIQGXDN) S:DIQGFET DIQGFEN=DIQGXDN_" "_DIQGFEN
41 .I DIQGDD N DIQGXDDN S DIQGXDDN="DD"
42INTERNAL .I DIQGXPRI D Q:DIQGI="$WP$" G:$G(DIERR) ERR
43 ..I $G(DIQGAUDR(DIQGXDDN,DIQGXDA)) S DIQGI="" G XXI
44 ..I $D(DIQGAUDR(DIQGXDDN,DIQGXDA,DIQGXDN)) S DIQGI=$$DIA^DIAUTL(DIQGAUDD,DIQGAUDR,DIQGAUDR(DIQGXDDN,DIQGXDA,DIQGXDN)) G XXI
45 ..S DIQGI=$$GET^DIQG(DIQGR,.DA,DIQGXDN,"I"_DIQGCP,$S('DIQGXPRF:$$OREF(DIQGXTA)_$$Q(DIQGXDDN)_","_$$Q(DIQGXDA)_","_$$Q(DIQGFEN)_")",1:$$OREF(DIQGXTA)_$$Q(DIQGFEN)_")"),"","1A")
46XXI ..S DIQGXXI='DIQGXPRN!(DIQGXPRN&(DIQGI]""))
47 ..Q
48EXTERNAL .I DIQGXPRE!'DIQGXPRA D Q:DIQGE="$WP$"
49 ..I $G(DIQGAUDR(DIQGXDDN,DIQGXDA)) S DIQGE="" G XXE
50 ..I $D(DIQGAUDR(DIQGXDDN,DIQGXDA,DIQGXDN)) S DIQGE=$$DIA^DIAUTL(DIQGAUDD,DIQGAUDR,DIQGAUDR(DIQGXDDN,DIQGXDA,DIQGXDN),"E") G XXE
51 ..S DIQGE=$$GET^DIQG(DIQGR,.DA,DIQGXDN,DIQGCP,$S('DIQGXPRF:$$OREF(DIQGXTA)_$$Q(DIQGXDDN)_","_$$Q(DIQGXDA)_","_$$Q(DIQGFEN)_")",1:$$OREF(DIQGXTA)_$$Q(DIQGFEN)_")"),"","1A")
52XXE ..S DIQGXXE='DIQGXPRN!(DIQGXPRN&(DIQGE]""))
53 ..Q
54ERR .I $G(DIERR) S $P(DIQGQERR,U)=$P($G(DIQGQERR),U)+DIERR,$P(DIQGQERR,U,2)=$P($G(DIQGQERR),U,2)+$P(DIERR,U,2) K DIERR S DIQGQE=DIQGQE+1 Q
55 .S:DIQGXPRS DIQGPRSE=DIQGI'=DIQGE
56 .I DIQGXAF,DIQGXPRA D Q
57 ..G:DIQGXPRF XPRF1
58 ..I DIQGXPRI,DIQGXXI S @DIQGXTA@(DIQGXDDN,DIQGXDA,DIQGFEN,"I")=DIQGI
59 ..I DIQGXPRE,DIQGXXE,DIQGPRSE S @DIQGXTA@(DIQGXDDN,DIQGXDA,DIQGFEN,"E")=DIQGE
60 ..Q
61XPRF1 ..I DIQGXPRI,DIQGXXI S @DIQGXTA@(DIQGFEN,"I")=DIQGI
62 ..I DIQGXPRE,DIQGXXE,DIQGPRSE S @DIQGXTA@(DIQGFEN,"E")=DIQGE
63 ..Q
64 .I DIQGXAF D Q
65 ..I DIQGXPRF,DIQGXXE S @DIQGXTA@(DIQGFEN)=DIQGE Q
66 ..S:DIQGXXE @DIQGXTA@(DIQGXDDN,DIQGXDA,DIQGFEN)=DIQGE
67 ..Q
68 .Q
69 Q
70 ;
71CREF(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:"")
72OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
73OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
74DA(DA) N X,Y S X="",Y=$G(DA)_"," F S X=$O(DA(X)) Q:X="" S Y=Y_DA(X)_","
75 Q Y
76IEN(IEN,DA) S DA=$P(IEN,",") N I F I=2:1 Q:$P(IEN,",",I)="" S DA(I-1)=$P(IEN,",",I)
77 Q
78Q(%Z) S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
79DD(X) Q:'$D(^DD(X)) "" Q "^DD("_X_","
80202 D BLD^DIALOG(202,.X)
81OUT Q
Note: See TracBrowser for help on using the repository browser.