122 lines
4.3 KiB
Mathematica
122 lines
4.3 KiB
Mathematica
DDR2 ;ALB/MJK-FileMan Delphi Components' RPCs ;4/20/98 11:38
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
Q
|
|
;
|
|
FIND1C(DDRDATA,DDR) ; DDR FIND1 rpc callback
|
|
N DDRFILE,DDRIENS,DDRFLAGS,DDRVAL,DDRXREF,DDRSCRN,DDRERR,A,IEN,N
|
|
D PARSE(.DDR) S DDRVAL=$G(DDR("VALUE"))
|
|
S A=$$FIND1^DIC(DDRFILE,DDRIENS,DDRFLAGS,DDRVAL,DDRXREF,DDRSCRN,"DDRERR")
|
|
S A=$S($G(DIERR):"",1:A)
|
|
S N=0 D SET(A)
|
|
I $G(DIERR) D ERROR Q
|
|
I $G(DDROPT)["R" S IEN=$S($G(DDRIENS)]"":A_DDRIENS,1:A_",") D RECALL^DILFD(DDRFILE,IEN,DUZ)
|
|
Q
|
|
;
|
|
GETSC(DDRDATA,DDR) ; DDR GETS ENTRY DATA rpc callback
|
|
N DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDROPT,DDRRSLT,DDRERR
|
|
N DDRXREF,DDRSCRN,N
|
|
D PARSE(.DDR)
|
|
D GETS^DIQ(DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,"DDRRSLT","DDRERR")
|
|
S N=0
|
|
I '$D(DDROPT) D 1,2 Q
|
|
I $G(DDROPT)["U" D 11,21
|
|
I $G(DDROPT)["?" D HLP
|
|
Q
|
|
1 I $D(DDRRSLT) D
|
|
. N DDRFIELD,X,J
|
|
. D SET("[Data]")
|
|
. S 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.
|
|
. . S 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
|
|
. . . D SET(X_"[WORD PROCESSING]")
|
|
. . . S J=0 F S J=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J)) Q:'J D
|
|
. . . . D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J))
|
|
. . . D SET("$$END$$")
|
|
. . E D
|
|
. . . D SET(X_$G(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I"))_"^"_$G(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")))
|
|
Q
|
|
11 N HD,I,E,B,J,K
|
|
D SET("[BEGIN_diDATA]")
|
|
S HD=DDRFILE_U_$E(DDRIENS,1,$L(DDRIENS)-1)
|
|
S I=DDRFLAGS["I",E=DDRFLAGS["E",B=(I&E)
|
|
S 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
|
|
. . S (K,J)=0 F S K=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,K)) Q:'K S J=J+1
|
|
. . D SET(HD_U_DDRFIELD_U_"W"_U_J)
|
|
. . S J=0 F S J=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J)) Q:'J D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J))
|
|
. . Q
|
|
. S FLG=$S(B:"B",I:"I",1:"E")
|
|
. D SET(HD_U_DDRFIELD_U_FLG)
|
|
. I B D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")),SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I")) Q
|
|
. I E D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")) Q
|
|
. I I D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I")) Q
|
|
D SET("[END_diDATA]")
|
|
Q
|
|
2 IF $D(DDRERR) D SET("[ERROR]")
|
|
Q
|
|
21 I $D(DIERR) D ERROR
|
|
Q
|
|
SET(X) ;
|
|
S N=N+1
|
|
S DDRDATA(N)=X
|
|
Q
|
|
HLP ;
|
|
N FLD,FLG,Z,%
|
|
S FLD=0,FLG="?"
|
|
D SET("[BEGIN_diHELP]")
|
|
F Z=1:1 S FLD=+$P(DDRFLDS,";",Z) Q:'FLD D HELP(DDRFILE,DDRIENS,FLD,FLG)
|
|
D SET("[END_diHELP]")
|
|
Q
|
|
;
|
|
GETHLPC(DDRDATA,DDR) ; DDR GET DD HELP rpc callback
|
|
N DDRFILE,DDRFIELD,DDRFLGS,N
|
|
S DDRFILE=$G(DDR("FILE"))
|
|
S DDRFIELD=$G(DDR("FIELD"))
|
|
S DDRFLGS=$G(DDR("FLAGS"))
|
|
S N=0
|
|
D SET("[BEGIN_diHELP]")
|
|
D HELP(DDRFILE,"",DDRFIELD,DDRFLGS)
|
|
D SET("[END_diHELP]")
|
|
Q
|
|
;
|
|
HELP(FILE,IENS,FIELD,FLGS) ;
|
|
N DDRHLP,HD,A
|
|
D HELP^DIE(FILE,IENS,FIELD,FLGS,"DDRHLP")
|
|
Q:'$D(DDRHLP("DIHELP"))
|
|
S HD=FILE_U_FIELD_U_"?"_U_DDRHLP("DIHELP") D SET(HD)
|
|
S A=0 F S A=$O(DDRHLP("DIHELP",A)) Q:'A D SET(DDRHLP("DIHELP",A))
|
|
Q
|
|
ERROR ;
|
|
D SET("[BEGIN_diERRORS]")
|
|
N A S A=0 F S A=$O(DDRERR("DIERR",A)) Q:'A D
|
|
. N HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS
|
|
. S HD=DDRERR("DIERR",A)
|
|
. I $D(DDRERR("DIERR",A,"PARAM",0)) D
|
|
. . S (B,D)=0 F C=1:1 S B=$O(DDRERR("DIERR",A,"PARAM",B)) Q:B="" D
|
|
. . . I B="FILE" S FILE=DDRERR("DIERR",A,"PARAM","FILE")
|
|
. . . I B="FIELD" S FIELD=DDRERR("DIERR",A,"PARAM","FIELD")
|
|
. . . I B="IENS" S IENS=DDRERR("DIERR",A,"PARAM","IENS")
|
|
. . . S D=D+1,PARAM(D)=B_U_DDRERR("DIERR",A,"PARAM",B)
|
|
. S C=0 F S C=$O(DDRERR("DIERR",A,"TEXT",C)) Q:'C S TEXT(C)=DDRERR("DIERR",A,"TEXT",C),TXTCNT=C
|
|
. S HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(D) D SET(HD)
|
|
. S B=0 F S B=$O(PARAM(B)) Q:'B S %=PARAM(B) D SET(%)
|
|
. S B=0 F S B=$O(TEXT(B)) Q:'B S %=TEXT(B) D SET(%)
|
|
. Q
|
|
D SET("[END_diERRORS]")
|
|
Q
|
|
PARSE(DDR) ;
|
|
S DDRFILE=$G(DDR("FILE"))
|
|
S DDRIENS=$G(DDR("IENS"))
|
|
S DDRFLDS=$G(DDR("FIELDS"))
|
|
S DDRFLAGS=$G(DDR("FLAGS"))
|
|
S DDRXREF=$G(DDR("XREF"))
|
|
S DDRSCRN=$G(DDR("SCREEN"))
|
|
S:$D(DDR("OPTIONS")) DDROPT=DDR("OPTIONS")
|
|
Q
|