DDR0 ;SF/DCM-FileMan Delphi Components' RPCs ;2013-03-22  1:46 PM
 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
 ;;Per VA Directive 6402, this routine should not be modified.
 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
 ;;Licensed under the terms of the Apache License, Version 2.0.
 ;
 
Q
FINDC(DDRDATA,DDR) ; -- broker callback to get list data
 
DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDRVAL,DDRMAX,DDRXREF,DDRSCRN,DDRID,DDRROOT,DDRERR,DDRRSLT,DDROPT,DDROUT
 
; -- parse array to parameters
 
PARSE(.DDR)
 
DDROUT=""
 
FIND^DIC(DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDRVAL,DDRMAX,DDRXREF,DDRSCRN,DDRID,DDROUT,"DDRERR")
 
I $G(DDRFLAGS)["P" D
 
Q:'$D(^TMP("DILIST",$J))
 . 
COUNT COUNT=^TMP("DILIST",$J,0) Q:'COUNT  1
 
XWBAPVER>1 ^(.3)="[MAP]",^TMP("DILIST",$J,.4)=^TMP("DILIST",$J,0,"MAP")
 . 
^TMP("DILIST",$J,0) ^(.5)="[BEGIN_diDATA]",^(COUNT+1)="[END_diDATA]"
 
Q
 I $G
(DDRFLAGS)'["P" D
 
Q:'$D(^TMP("DILIST",$J))
 . 
COUNT COUNT=^TMP("DILIST",$J,0) Q:'COUNT
 
1,UNPACKED
 
Q
 D 
3,4
 
Q
FINDI(DDRDATA,DDR) ; -- improved broker callback to find data,it can handle compound index
 
DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDRVAL,DDRMAX,DDRXREF,DDRSCRN,DDRID,DDRROOT,DDRERR,DDRRSLT,DDROPT,DDROUT
 
; -- parse array to parameters
 
PARSE(.DDR)
 
IF DDRVAL[DO
 
.I,DDRTMP
 
.DDRTMP=DDRVAL
 
.DDRVAL
 
.I=1:1:$L(DDRTMP,UDDRVAL(I)=$P(DDRTMP,U,I)
 
DDROUT=""
 
FIND^DIC(DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,.DDRVAL,DDRMAX,DDRXREF,DDRSCRN,DDRID,DDROUT,"DDRERR")
 
I $G(DDRFLAGS)["P" D
 
Q:'$D(^TMP("DILIST",$J))
 . 
COUNT COUNT=^TMP("DILIST",$J,0) Q:'COUNT  1
 
XWBAPVER>1 ^(.3)="[MAP]",^TMP("DILIST",$J,.4)=^TMP("DILIST",$J,0,"MAP")
 . 
^TMP("DILIST",$J,0) ^(.5)="[BEGIN_diDATA]",^(COUNT+1)="[END_diDATA]"
 
Q
 I $G
(DDRFLAGS)'["P" D
 
Q:'$D(^TMP("DILIST",$J))
 . 
COUNT COUNT=^TMP("DILIST",$J,0) Q:'COUNT
 
1,UNPACKED
 
Q
 D 
3,4
 
Q
Q:'$P(COUNT,U,3)
 
^TMP("DILIST",$J,.1)="[Misc]",^(.2)="MORE"
 
Q
I $D(DIERRERROR
 
Q
DDRDATA=$NA(^TMP("DILIST",$J))
 
Q
PARSE(DDR) ; -- array parsing
 
DDRFILE=$G(DDR("FILE"))
 
DDRIENS=$G(DDR("IENS"))
 
DDRFLDS=$G(DDR("FIELDS"))
 
DDRFLAGS=$G(DDR("FLAGS"))
 
DDRMAX=$G(DDR("MAX"),"*")
 
DDRVAL=$G(DDR("VALUE"))
 
DDRXREF=$G(DDR("XREF"))
 
DDRSCRN=$G(DDR("SCREEN"))
 
DDRID=$G(DDR("ID"))
 
DDRROOT=$G(DDR("ROOT"))
 
DDROPT=$G(DDR("OPTIONS"))
 
Q
ERROR ;
 
I=1
 
Z("[BEGIN_diERRORS]")
 
A=0 F  S A=$O(DDRERR("DIERR",A)) Q:'A  D
 
HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS
 
HD=DDRERR("DIERR",A)
 . 
I $D(DDRERR("DIERR",A,"PARAM",0)) D
 
. . (B,D)=0 C=1:1 B=$O(DDRERR("DIERR",A,"PARAM",B)) Q:B=""  D
 
. . . B="FILE" FILE=DDRERR("DIERR",A,"PARAM","FILE")
 . . . 
B="FIELD" FIELD=DDRERR("DIERR",A,"PARAM","FIELD")
 . . . 
B="IENS" IENS=DDRERR("DIERR",A,"PARAM","IENS")
 . . . 
D=D+1,PARAM(D)=B_U_DDRERR("DIERR",A,"PARAM",B)
 . 
C=0 F  S C=$O(DDRERR("DIERR",A,"TEXT",C)) Q:'C  TEXT(C)=DDRERR("DIERR",A,"TEXT",C),TXTCNT=C
 
HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(DZ(HD)
 . 
B=0 F  S B=$O(PARAM(B)) Q:'B  %=PARAM(BZ(%)
 . 
B=0 F  S B=$O(TEXT(B)) Q:'B  %=TEXT(BZ(%)
 . 
Q
 D 
Z("[END_diERRORS]")
 
Q
Z(%) ;
 
^TMP("DILIST",$J,"ZERR",I)=%,I=I+1
 
Q
UNPACKED ;
 
^TMP("DILIST",$J,0)
 
^TMP("DILIST",$J,.5)="[BEGIN_diDATA]" ^TMP("DILIST",$J,1)
 
^TMP("DILIST",$J,2,.1)="BEGIN_IENs",^(COUNT+1)="END_IENs"
 
DDRFLDS]"",$D(^TMP("DILIST",$J,"ID")) D
 
Z,FLD,FLDCNT Z=0,FLD="",FLDCNT=0
 . 
F  S Z=$O(^TMP("DILIST",$J,"ID",1,Z)) Q:'Z   FLD=FLD_Z_";",FLDCNT=FLDCNT+1
 . 
Q:'FLDCNT
 
^TMP("DILIST",$J,"ID",0)="BEGIN_IDVALUES",^(.1)=FLD_U_FLDCNT,^(COUNT+1)="END_IDVALUES"
 
E  D
 
Z=0 F  S Z=$O(^TMP("DILIST",$J,"ID",Z)) Q:'Z  ^TMP("DILIST",$J,"ID",Z)
 
I $G(DDROPT)["WID",$D(^TMP("DILIST",$J,"ID","WRITE")) D
 
Z,N,I,IEN,WIDCNT (N,I)=0
 . 
Z=^TMP("DILIST",$J,"ID","WRITE"^TMP("DILIST",$J,"ID","WRITE")
 . 
^TMP("DILIST",$J,"ID","WID",0)="BEGIN_WIDVALUES",N=N+1
 . 
F  S I=$O(Z(I)) Q:'I  IEN=$G(^TMP("DILIST",$J,2,I)) D
 
. . (J,WIDCNT)=0 F  S J=$O(Z(I,J)) Q:'J  WIDCNT=WIDCNT+1
 . . 
^TMP("DILIST",$J,"ID","WID",N)="WID"_U_IEN_U_WIDCNT,N=N+1
 . . 
J=0 J=1:1:WIDCNT ^TMP("DILIST",$J,"ID","WID",N)=Z(I,J),N=N+1
 . 
^TMP("DILIST",$J,"ID","WID",N)="END_WIDVALUES"
 
I $G(DDROPT)'["WID" ^TMP("DILIST",$J,"ID","WRITE")
 
^TMP("DILIST",$J,"IDZ")="[END_diDATA]"
 
Q