source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDR.m@ 802

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1DDR ;ALB/MJK,SF/DCM-FileMan Delphi Components' RPCs ;4/28/98 10:38
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6LISTC(DDRDATA,DDR) ; -- broker callback to get list data
7 N DDRFILE,DDRIENS,DDRFLDS,DDRMAX,DDRFROM,DDRPART,DDRXREF,DDRSCRN,DDRID,DDRVAL,DDRERR,DDRRSLT,DDRFLD,DDRFLAGS,DDROPT,DDROUT
8 ; -- parse array to parameters
9 D PARSE(.DDR)
10 S DDRPART=$TR(DDRPART,$C(13)_$C(10),"")
11 ; -- get specific field criteria
12 IF $G(DDR("DDFILE")),$G(DDR("DDFIELD")),$D(^DD(DDR("DDFILE"),DDR("DDFIELD"),12.1)) D
13 . N DIC X ^(12.1) S:$D(DIC("S")) DDRSCRN=DIC("S")
14 I 'XWBAPVER D V0 Q
15 I XWBAPVER>0 D V1 Q
16 Q
17 ;
18DIC D LIST^DIC(DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDRMAX,.DDRFROM,DDRPART,DDRXREF,DDRSCRN,DDRID,DDROUT,"DDRERR")
19 Q
20 ;
21V0 S DDROUT="DDRRSLT",DDRFLAGS=$G(DDRFLAGS)_"P",DDRFLDS=$G(DDRFLDS)_";@"
22 D DIC
23 N Y,I,N S N=0
24 I $G(DDRFROM)]"" D SET("[Misc]"),SET("MORE"_U_DDRFROM_U_DDRFROM("IEN"))
25 I $D(DDRRSLT("DILIST")) D
26 . D SET("[Data]")
27 . S I=0 F S I=$O(DDRRSLT("DILIST",I)) Q:'I D SET(DDRRSLT("DILIST",I,0))
28 IF $D(DDRERR) D SET("[Errors]")
29 S X=$$STYPE^XWBTCPC("ARRAY")
30 Q
31 ;
32V1 S DDROUT=""
33 I XWBAPVER=1,DDRFLAGS["P" S DDRFLAGS=DDRFLAGS_"S" ;only P flag is sent from client for V1 of FMCD
34 D DIC
35 I $G(DDRFLAGS)["P" D Q
36 . I $D(^TMP("DILIST",$J)) D
37 . . N END S END=+^TMP("DILIST",$J,0)
38 . . I XWBAPVER>1 S ^(.3)="[MAP]",^TMP("DILIST",$J,.4)=^TMP("DILIST",$J,0,"MAP")
39 . . K ^TMP("DILIST",$J,0) S ^(.5)="[BEGIN_diDATA]",^(END+1)="[END_diDATA]"
40 . D 11,31
41 . S DDRDATA=$NA(^TMP("DILIST",$J))
42 . Q
43 I $G(DDRFLAGS)'["P" D 11,UNPACKED,31 S DDRDATA=$NA(^TMP("DILIST",$J)) Q
44 Q
4511 I $G(DDRFROM)]"" S ^TMP("DILIST",$J,.1)="[Misc]",^(.2)="MORE"_U_DDRFROM_U_DDRFROM("IEN")_$S(XWBAPVER>1:U_$P($G(^TMP("DILIST",$J,0)),U,4),1:"")
46 Q
4731 I $D(DIERR) D ERROR
48 Q
49SET(X) ;
50 S N=N+1
51 S DDRDATA(N)=X
52 Q
53PARSE(DDR) ; -- array parsing
54 S DDRFILE=$G(DDR("FILE"))
55 S DDRIENS=$G(DDR("IENS"))
56 S DDRFLDS=$G(DDR("FIELDS"))
57 S DDRFLAGS=$G(DDR("FLAGS"))
58 S DDRMAX=$G(DDR("MAX"),"*")
59 M DDRFROM=DDR("FROM")
60 S DDRPART=$G(DDR("PART"))
61 S DDRXREF=$G(DDR("XREF"))
62 S DDRSCRN=$G(DDR("SCREEN"))
63 S DDRID=$G(DDR("ID"))
64 S DDROPT=$G(DDR("OPTIONS"))
65 Q
66ERROR ;
67 N I S I=1
68 D Z("[BEGIN_diERRORS]")
69 N A S A=0 F S A=$O(DDRERR("DIERR",A)) Q:'A D
70 . N HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS
71 . S HD=DDRERR("DIERR",A)
72 . I $D(DDRERR("DIERR",A,"PARAM",0)) D
73 . . S (B,D)=0 F C=1:1 S B=$O(DDRERR("DIERR",A,"PARAM",B)) Q:B="" D
74 . . . I B="FILE" S FILE=DDRERR("DIERR",A,"PARAM","FILE")
75 . . . I B="FIELD" S FIELD=DDRERR("DIERR",A,"PARAM","FIELD")
76 . . . I B="IENS" S IENS=DDRERR("DIERR",A,"PARAM","IENS")
77 . . . S D=D+1,PARAM(D)=B_U_DDRERR("DIERR",A,"PARAM",B)
78 . S C=0 F S C=$O(DDRERR("DIERR",A,"TEXT",C)) Q:'C S TEXT(C)=DDRERR("DIERR",A,"TEXT",C),TXTCNT=C
79 . S HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(D) D Z(HD)
80 . S B=0 F S B=$O(PARAM(B)) Q:'B S %=PARAM(B) D Z(%)
81 . S B=0 F S B=$O(TEXT(B)) Q:'B S %=TEXT(B) D Z(%)
82 . Q
83 D Z("[END_diERRORS]")
84 Q
85Z(%) ;
86 S ^TMP("DILIST",$J,"ZERR",I)=%,I=I+1 Q
87 ;
88UNPACKED ;
89 Q:'$D(^TMP("DILIST",$J))
90 N COUNT,IXCNT
91 S COUNT=+^TMP("DILIST",$J,0) Q:'COUNT
92 I XWBAPVER>1 S ^TMP("DILIST",$J,.3)="[MAP]",^TMP("DILIST",$J,.4)=^TMP("DILIST",$J,0,"MAP")
93 K ^TMP("DILIST",$J,0)
94 S ^TMP("DILIST",$J,.5)="[BEGIN_diDATA]"
95 I XWBAPVER=1 D IX1
96 D IENS,FLDS,WID,END
97 Q
98IX1 I DDROPT["IX",$D(^TMP("DILIST",$J,1)) D
99 . S ^TMP("DILIST",$J,1,COUNT+1)="END_IXVALUES" D S ^(.1)="BEGIN_IXVALUES",^(.2)=IXCNT
100 . . N Z S Z=0,IXCNT=0 I $G(^TMP("DILIST",$J,1,1))]"" S IXCNT=1 Q
101 . . F S Z=$O(^TMP("DILIST",$J,1,1,Z)) Q:'Z S IXCNT=IXCNT+1
102 I DDROPT'["IX" K ^TMP("DILIST",$J,1)
103 Q
104IENS I $D(^TMP("DILIST",$J,2)) D
105 . S ^TMP("DILIST",$J,2,.1)="BEGIN_IENs",^(COUNT+1)="END_IENs"
106 Q
107FLDS I DDRFLDS]"",$D(^TMP("DILIST",$J,"ID")) D
108 . N Z,FLD,FLDCNT S FLD="",(Z,FLDCNT,I)=0
109 . ;I XWBAPVER>1,DDRFLDS["IX" D
110 . ;. F S I=$O(^TMP("DILIST",$J,"ID",1,0,I)) Q:'I S IXCNT=IXCNT+1
111 . ;. S ^TMP("DILIST",$J,"ID",0,0)="IXCNT="_IXCNT Q
112 . F S Z=$O(^TMP("DILIST",$J,"ID",1,Z)) Q:'Z S FLD=FLD_Z_";",FLDCNT=FLDCNT+1
113 . Q:'FLDCNT
114 . S ^TMP("DILIST",$J,"ID",0)="BEGIN_IDVALUES"
115 . I XWBAPVER=1 S ^TMP("DILIST",$J,"ID",.1)=FLD_U_FLDCNT
116 . S ^TMP("DILIST",$J,"ID",COUNT+1)="END_IDVALUES"
117 E D
118 . N Z S Z=0 F S Z=$O(^TMP("DILIST",$J,"ID",Z)) Q:'Z K ^TMP("DILIST",$J,"ID",Z)
119 Q
120WID I (DDROPT["WID")!(DDRFLDS["WID"),$D(^TMP("DILIST",$J,"ID","WRITE")) D
121 . N Z,N,I,IEN,WIDCNT S (N,I)=0
122 . M Z=^TMP("DILIST",$J,"ID","WRITE") K ^TMP("DILIST",$J,"ID","WRITE")
123 . S ^TMP("DILIST",$J,"ID","WID",0)="BEGIN_WIDVALUES",N=N+1
124 . F S I=$O(Z(I)) Q:'I S IEN=$G(^TMP("DILIST",$J,2,I)) D
125 . . N J S (J,WIDCNT)=0 F S J=$O(Z(I,J)) Q:'J S WIDCNT=WIDCNT+1
126 . . S ^TMP("DILIST",$J,"ID","WID",N)="WID"_U_IEN_U_WIDCNT,N=N+1
127 . . N J S J=0 F J=1:1:WIDCNT S ^TMP("DILIST",$J,"ID","WID",N)=Z(I,J),N=N+1
128 . S ^TMP("DILIST",$J,"ID","WID",N)="END_WIDVALUES"
129 I (DDROPT'["WID")&(DDRFLDS'["WID") K ^TMP("DILIST",$J,"ID","WRITE")
130 Q
131END S ^TMP("DILIST",$J,"IDZ")="[END_diDATA]"
132 Q
Note: See TracBrowser for help on using the repository browser.