Return to DIQGQ.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIQGQ	;SFISC/DCL-DATA RETRIEVAL;01:11 PM  8 Mar 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EN(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR)	;
    5: DDENTRY	N DIQGQE S DIQGQE=0
    6: 	I $G(U)'="^" N U S U="^"
    7: 	;K DIERR,^TMP("DIERR",$J)
    8: 	;N DIERR
    9: 	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"
   10: 	N DIQGFE,DIQGFEN S DIQGFE=DIQGPARM["R"
   11: 	N DIQGFET S DIQGFET=DIQGPARM["T"
   12: 	I '$D(DIQGR) N X S X(1)="FILE" G 202
   13: 	N DIQGI1 S DIQGI1=+DIQGIPAR=0
   14: 	I DIQGI1,'DIQGR N X S X(1)="FILE" G 202
   15: 	D:$G(DA)["," IEN(DA,.DA)
   16: 	I DIQGI1,'DIQGDD,$$N9^DIQGU(DIQGR,.DA) D BLD^DIALOG(602) G OUT
   17: 	I '$D(DA) N X S X(1)="RECORD" G 202
   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)) D BLD^DIALOG(601) G OUT
   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
   29: 	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  ;
   30: 	.I DIQGXDC,$P(^DD(+DIQGXDC,.01,0),"^",2)'["W" S:DR="**" DIQGXDN=DIQGXDN_"*" Q:$L(DIQGXDN,"*")'=2
   31: 	.I DIQGXDN'?.N,$L(DIQGXDN,"*")=2,$P(DIQGXDN,"*")]"",$D(@DIQGXDD@("B",$P(DIQGXDN,"*"))) S DIQGXDN=$O(^($P(DIQGXDN,"*"),""))_"*"
   32: 	.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
   33: 	..N DIQGMDA,DIQGMGR
   34: 	..D  F  S DIQGMDA=$O(@DIQGMGR@(DIQGMDA)) Q:DIQGMDA'>0  D EN($S('DIQGDD:DIQGMDD,1:$$OREF(DIQGMGR)),.DIQGMDA,"**",DIQGPARM,.DIQGTA,"",$S('DIQGDD:"",1:1))
   35: 	...N I F I=1:1 Q:'$D(DA(I))  S DIQGMDA(I+1)=DA(I)
   36: 	...S DIQGMDA(1)=DA,DIQGMGR=$S('DIQGDD:$$ROOT^DIQGU(DIQGMDD,.DIQGMDA,1),1:DIQGR_DA_","_$$Q($P($P(@DIQGXDD@(+DIQGXDN,0),"^",4),";"))_")"),DIQGMDA=0
   37: 	...Q
   38: 	.I DIQGXDN="*"!(DIQGXDN="**") S DIQGXDN=0,DIQGXDF=":999999999" Q
   39: 	.S DIQGXDA=$$DA(.DA),DIQGFEN=$S((DIQGFE&(DIQGXDN))!(DIQGFET):$P(@DIQGXDD@(DIQGXDN,0),"^"),1:DIQGXDN) S:DIQGFET DIQGFEN=DIQGXDN_" "_DIQGFEN
   40: 	.I DIQGDD N DIQGXDDN S DIQGXDDN="DD"
   41: 	.I DIQGXPRI D  Q:DIQGI="$WP$"  G:$G(DIERR) ERR
   42: 	..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")
   43: 	..S DIQGXXI='DIQGXPRN!(DIQGXPRN&(DIQGI]""))
   44: 	..Q
   45: 	.I DIQGXPRE!'DIQGXPRA D  Q:DIQGE="$WP$"
   46: 	..S DIQGE=$$GET^DIQG(DIQGR,.DA,DIQGXDN,DIQGCP,$S('DIQGXPRF:$$OREF(DIQGXTA)_$$Q(DIQGXDDN)_","_$$Q(DIQGXDA)_","_$$Q(DIQGFEN)_")",1:$$OREF(DIQGXTA)_$$Q(DIQGFEN)_")"),"","1A")
   47: 	..S DIQGXXE='DIQGXPRN!(DIQGXPRN&(DIQGE]""))
   48: 	..Q
   49: ERR	.I $G(DIERR) S DIQGQERR=DIERR K DIERR S DIQGQE=DIQGQE+1 Q
   50: 	.S:DIQGXPRS DIQGPRSE=DIQGI'=DIQGE
   51: 	.I DIQGXAF,DIQGXPRA D  Q
   52: 	..G:DIQGXPRF XPRF1
   53: 	..I DIQGXPRI,DIQGXXI S @DIQGXTA@(DIQGXDDN,DIQGXDA,DIQGFEN,"I")=DIQGI
   54: 	..I DIQGXPRE,DIQGXXE,DIQGPRSE S @DIQGXTA@(DIQGXDDN,DIQGXDA,DIQGFEN,"E")=DIQGE
   55: 	..Q
   56: XPRF1	..I DIQGXPRI,DIQGXXI S @DIQGXTA@(DIQGFEN,"I")=DIQGI
   57: 	..I DIQGXPRE,DIQGXXE,DIQGPRSE S @DIQGXTA@(DIQGFEN,"E")=DIQGE
   58: 	..Q
   59: 	.I DIQGXAF D  Q
   60: 	..I DIQGXPRF,DIQGXXE S @DIQGXTA@(DIQGFEN)=DIQGE Q
   61: 	..S:DIQGXXE @DIQGXTA@(DIQGXDDN,DIQGXDA,DIQGFEN)=DIQGE
   62: 	..Q
   63: 	.Q
   64: 	Q
   65: 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:"")
   66: OREF(X)	N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
   67: OR2(%)	Q:%=")"!(%=",") "" Q:$L(%)=1 %  S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
   68: DA(DA)	N X,Y S X="",Y=$G(DA)_"," F  S X=$O(DA(X)) Q:X=""  S Y=Y_DA(X)_","
   69: 	Q Y
   70: IEN(IEN,DA)	S DA=$P(IEN,",") N I F I=2:1 Q:$P(IEN,",",I)=""  S DA(I-1)=$P(IEN,",",I)
   71: 	Q
   72: Q(%Z)	S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
   73: DD(X)	Q:'$D(^DD(X)) "" Q "^DD("_X_","
   74: 202	D BLD^DIALOG(202,.X)
   75: OUT	Q