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

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1DDR0 ;SF/DCM-FileMan Delphi Components' RPCs ;4/28/98 10:52
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6FINDC(DDRDATA,DDR) ; -- broker callback to get list data
7 N DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDRVAL,DDRMAX,DDRXREF,DDRSCRN,DDRID,DDRROOT,DDRERR,DDRRSLT,DDROPT,DDROUT
8 ; -- parse array to parameters
9 D PARSE(.DDR)
10 S DDROUT=""
11 D FIND^DIC(DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDRVAL,DDRMAX,DDRXREF,DDRSCRN,DDRID,DDROUT,"DDRERR")
12 I $G(DDRFLAGS)["P" D
13 . Q:'$D(^TMP("DILIST",$J))
14 . N COUNT S COUNT=^TMP("DILIST",$J,0) Q:'COUNT D 1
15 . I XWBAPVER>1 S ^(.3)="[MAP]",^TMP("DILIST",$J,.4)=^TMP("DILIST",$J,0,"MAP")
16 . K ^TMP("DILIST",$J,0) S ^(.5)="[BEGIN_diDATA]",^(COUNT+1)="[END_diDATA]"
17 . Q
18 I $G(DDRFLAGS)'["P" D
19 . Q:'$D(^TMP("DILIST",$J))
20 . N COUNT S COUNT=^TMP("DILIST",$J,0) Q:'COUNT
21 . D 1,UNPACKED
22 . Q
23 D 3,4
24 Q
251 Q:'$P(COUNT,U,3)
26 S ^TMP("DILIST",$J,.1)="[Misc]",^(.2)="MORE"
27 Q
283 I $D(DIERR) D ERROR
29 Q
304 S DDRDATA=$NA(^TMP("DILIST",$J))
31 Q
32PARSE(DDR) ; -- array parsing
33 S DDRFILE=$G(DDR("FILE"))
34 S DDRIENS=$G(DDR("IENS"))
35 S DDRFLDS=$G(DDR("FIELDS"))
36 S DDRFLAGS=$G(DDR("FLAGS"))
37 S DDRMAX=$G(DDR("MAX"),"*")
38 S DDRVAL=$G(DDR("VALUE"))
39 S DDRXREF=$G(DDR("XREF"))
40 S DDRSCRN=$G(DDR("SCREEN"))
41 S DDRID=$G(DDR("ID"))
42 S DDRROOT=$G(DDR("ROOT"))
43 S DDROPT=$G(DDR("OPTIONS"))
44 Q
45ERROR ;
46 N I S I=1
47 D Z("[BEGIN_diERRORS]")
48 N A S A=0 F S A=$O(DDRERR("DIERR",A)) Q:'A D
49 . N HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS
50 . S HD=DDRERR("DIERR",A)
51 . I $D(DDRERR("DIERR",A,"PARAM",0)) D
52 . . S (B,D)=0 F C=1:1 S B=$O(DDRERR("DIERR",A,"PARAM",B)) Q:B="" D
53 . . . I B="FILE" S FILE=DDRERR("DIERR",A,"PARAM","FILE")
54 . . . I B="FIELD" S FIELD=DDRERR("DIERR",A,"PARAM","FIELD")
55 . . . I B="IENS" S IENS=DDRERR("DIERR",A,"PARAM","IENS")
56 . . . S D=D+1,PARAM(D)=B_U_DDRERR("DIERR",A,"PARAM",B)
57 . S C=0 F S C=$O(DDRERR("DIERR",A,"TEXT",C)) Q:'C S TEXT(C)=DDRERR("DIERR",A,"TEXT",C),TXTCNT=C
58 . S HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(D) D Z(HD)
59 . S B=0 F S B=$O(PARAM(B)) Q:'B S %=PARAM(B) D Z(%)
60 . S B=0 F S B=$O(TEXT(B)) Q:'B S %=TEXT(B) D Z(%)
61 . Q
62 D Z("[END_diERRORS]")
63 Q
64Z(%) ;
65 S ^TMP("DILIST",$J,"ZERR",I)=%,I=I+1
66 Q
67UNPACKED ;
68 K ^TMP("DILIST",$J,0)
69 S ^TMP("DILIST",$J,.5)="[BEGIN_diDATA]" K ^TMP("DILIST",$J,1)
70 S ^TMP("DILIST",$J,2,.1)="BEGIN_IENs",^(COUNT+1)="END_IENs"
71 I DDRFLDS]"",$D(^TMP("DILIST",$J,"ID")) D
72 . N Z,FLD,FLDCNT S Z=0,FLD="",FLDCNT=0
73 . F S Z=$O(^TMP("DILIST",$J,"ID",1,Z)) Q:'Z S FLD=FLD_Z_";",FLDCNT=FLDCNT+1
74 . Q:'FLDCNT
75 . S ^TMP("DILIST",$J,"ID",0)="BEGIN_IDVALUES",^(.1)=FLD_U_FLDCNT,^(COUNT+1)="END_IDVALUES"
76 E D
77 . N Z S Z=0 F S Z=$O(^TMP("DILIST",$J,"ID",Z)) Q:'Z K ^TMP("DILIST",$J,"ID",Z)
78 I $G(DDROPT)["WID",$D(^TMP("DILIST",$J,"ID","WRITE")) D
79 . N Z,N,I,IEN,WIDCNT S (N,I)=0
80 . M Z=^TMP("DILIST",$J,"ID","WRITE") K ^TMP("DILIST",$J,"ID","WRITE")
81 . S ^TMP("DILIST",$J,"ID","WID",0)="BEGIN_WIDVALUES",N=N+1
82 . F S I=$O(Z(I)) Q:'I S IEN=$G(^TMP("DILIST",$J,2,I)) D
83 . . N J S (J,WIDCNT)=0 F S J=$O(Z(I,J)) Q:'J S WIDCNT=WIDCNT+1
84 . . S ^TMP("DILIST",$J,"ID","WID",N)="WID"_U_IEN_U_WIDCNT,N=N+1
85 . . N J S J=0 F J=1:1:WIDCNT S ^TMP("DILIST",$J,"ID","WID",N)=Z(I,J),N=N+1
86 . S ^TMP("DILIST",$J,"ID","WID",N)="END_WIDVALUES"
87 I $G(DDROPT)'["WID" K ^TMP("DILIST",$J,"ID","WRITE")
88 S ^TMP("DILIST",$J,"IDZ")="[END_diDATA]"
89 Q
Note: See TracBrowser for help on using the repository browser.