DDR2 ;ALB/MJK-FileMan Delphi Components' RPCs ;24APR2013
 ;;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
 
;
FIND1C(DDRDATA,DDR) ; DDR FIND1 rpc callback
 
DDRFILE,DDRIENS,DDRFLAGS,DDRVAL,DDRXREF,DDRSCRN,DDRERR,A,IEN,N
 
PARSE(.DDRDDRVAL=$G(DDR("VALUE"))
 
A=$$FIND1^DIC(DDRFILE,DDRIENS,DDRFLAGS,DDRVAL,DDRXREF,DDRSCRN,"DDRERR")
 
A=$S($G(DIERR):"",1:A)
 
N=0 SET(A)
 
I $G(DIERRERROR Q
 I $G
(DDROPT)["R" IEN=$S($G(DDRIENS)]"":A_DDRIENS,1:A_","RECALL^DILFD(DDRFILE,IEN,DUZ)
 
Q
 
;
GETSC(DDRDATA,DDR) ; DDR GETS ENTRY DATA rpc callback
 
DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDROPT,DDRRSLT,DDRERR
 
DDRXREF,DDRSCRN,N
 
PARSE(.DDR)
 
GETS^DIQ(DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,"DDRRSLT","DDRERR")
 
N=0
 
'$D(DDROPT1,Q
 I $G
(DDROPT)["U" 11,21
 
I $G(DDROPT)["?" HLP
 
Q
I $D(DDRRSLT),'$G(DIERRSET("[Data]"DDRFILE=0:0 DDRFILE=$O(DDRRSLT(DDRFILE)) Q:'DDRFILE  DDRIENS="" F  S DDRIENS=$O(DDRRSLT(DDRFILE,DDRIENS)) Q:DDRIENS=""  D
 
DDRFIELD,X,J
 
DDRFIELD=0 F  S DDRFIELD=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD)) Q:'DDRFIELD  D
 
. . ;Do not remove stripping of ',' from IENS in line below if this code should work with T11 (21.1T1) of FM components.
 
. . X=DDRFILE_"^"_$E(DDRIENS,1,$L(DDRIENS)-1)_"^"_DDRFIELD_"^"
 
. . ; -- below call to $$GET1 is too slow...working w/FM team for speed
 
. . ;IF $$GET1^DID(DDRFILE,DDRFIELD,"","TYPE")="WORD-PROCESSING" D
 
. . ;IF $P($G(^DD(DDRFILE,DDRFIELD,0)),U,4)[";0" D <<Replaced by more generic check below.
 
. . I $P($G(^DD(+$P($G(^DD(DDRFILE,DDRFIELD,0)),U,2),.01,0)),U,2)["W" D
 
. . . SET(X_"[WORD PROCESSING]")
 . . . 
J=0 F  S J=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J)) Q:'J  D
 
. . . . SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J))
 . . . 
SET("$$END$$")
 . . 
E  D
 
. . . SET(X_$G(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I"))_"^"_$G(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")))
 
Q
11 HD,I,E,B,J,K
 
SET("[BEGIN_diDATA]")
 
HD=DDRFILE_U_$E(DDRIENS,1,$L(DDRIENS)-1)
 
I=DDRFLAGS["I",E=DDRFLAGS["E",B=(I&E)
 
DDRFIELD=0 F  S DDRFIELD=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD)) Q:'DDRFIELD  D
 
I $P($G(^DD(+$P($G(^DD(DDRFILE,DDRFIELD,0)),U,2),.01,0)),U,2)["W" D  Q
 
. . (K,J)=0 F  S K=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,K)) Q:'K  J=J+1
 . . 
SET(HD_U_DDRFIELD_U_"W"_U_J)
 . . 
J=0  F  S J=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J)) Q:'J  SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J))
 . . 
Q
 
FLG=$S(B:"B",I:"I",1:"E")
 . 
SET(HD_U_DDRFIELD_U_FLG)
 . 
SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")),SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I")) Q
 
SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")) Q
 
SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I")) Q
 D 
SET("[END_diDATA]")
 
Q
IF $D(DDRERRSET("[ERROR]")
 
Q
21 I $D(DIERRERROR
 
Q
SET(X) ;
 
N=N+1
 
DDRDATA(N)=X
 
Q
HLP ;
 
FLD,FLG,Z,%
 
FLD=0,FLG="?"
 
SET("[BEGIN_diHELP]")
 
Z=1:1 FLD=+$P(DDRFLDS,";",ZQ:'FLD  HELP(DDRFILE,DDRIENS,FLD,FLG)
 
SET("[END_diHELP]")
 
Q
 
;
GETHLPC(DDRDATA,DDR) ; DDR GET DD HELP rpc callback
 
DDRFILE,DDRFIELD,DDRFLGS,N
 
DDRFILE=$G(DDR("FILE"))
 
DDRFIELD=$G(DDR("FIELD"))
 
DDRFLGS=$G(DDR("FLAGS"))
 
N=0
 
SET("[BEGIN_diHELP]")
 
HELP(DDRFILE,"",DDRFIELD,DDRFLGS)
 
SET("[END_diHELP]")
 
Q
 
;
HELP(FILE,IENS,FIELD,FLGS) ;
 
DDRHLP,HD,A
 
HELP^DIE(FILE,IENS,FIELD,FLGS,"DDRHLP")
 
Q:'$D(DDRHLP("DIHELP"))
 
HD=FILE_U_FIELD_U_"?"_U_DDRHLP("DIHELP"SET(HD)
 
A=0 F  S A=$O(DDRHLP("DIHELP",A)) Q:'A   SET(DDRHLP("DIHELP",A))
 
Q
ERROR ;
 
SET("[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(DSET(HD)
 . 
B=0 F  S B=$O(PARAM(B)) Q:'B  %=PARAM(BSET(%)
 . 
B=0 F  S B=$O(TEXT(B)) Q:'B  %=TEXT(BSET(%)
 . 
Q
 D 
SET("[END_diERRORS]")
 
Q
PARSE(DDR) ;
 
DDRFILE=$G(DDR("FILE"))
 
DDRIENS=$G(DDR("IENS"))
 
DDRFLDS=$G(DDR("FIELDS"))
 
DDRFLAGS=$G(DDR("FLAGS"))
 
DDRXREF=$G(DDR("XREF"))
 
DDRSCRN=$G(DDR("SCREEN"))
 
S:$D(DDR("OPTIONS")) DDROPT=DDR("OPTIONS")
 
Q