| 1 | DDR3 ;ALB/MJK,SF/DCM-FileMan Delphi Components' RPCs ;2/24/98  10:01
 | 
|---|
| 2 |  ;;22.0;VA FileMan;;Mar 30, 1999
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  Q
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | FILEC(DDRDATA,DDRMODE,DDRROOT,DDRFLAGS,DDRIENS) ;  DDR FILER rpc callback
 | 
|---|
| 8 |  N DDRRTN,DDRFDA,DDRERR,N,I
 | 
|---|
| 9 |  D FDASET(.DDRROOT,.DDRFDA)
 | 
|---|
| 10 |  ; -- set up placeholder DINUM's if any
 | 
|---|
| 11 |  ; -- NOTE:  Can't use until multiple arrays can be passed by broker
 | 
|---|
| 12 |  I $D(DDRROOT("IENs")) M DDRIENS=DDRROOT("IENs")
 | 
|---|
| 13 |  S I="" F  S I=$O(DDRIENS(I)) Q:I=""  S DDRRTN(+I)=+DDRIENS(I)
 | 
|---|
| 14 |  IF DDRMODE="ADD" D
 | 
|---|
| 15 |  . D UPDATE^DIE("","DDRFDA","DDRRTN","DDRERR")
 | 
|---|
| 16 |  ELSE  D
 | 
|---|
| 17 |  . S DDRFLAGS=$S($D(DDRFLAGS):DDRFLAGS,1:"")
 | 
|---|
| 18 |  . D FILE^DIE(DDRFLAGS,"DDRFDA","DDRERR")
 | 
|---|
| 19 |  S N=0
 | 
|---|
| 20 |  D SET("[Data]")
 | 
|---|
| 21 |  ; -- send back info on entry #'s for placeholders
 | 
|---|
| 22 |  S I=0 F  S I=$O(DDRRTN(I)) Q:'I  D SET("+"_I_","_U_DDRRTN(I))
 | 
|---|
| 23 |  IF $D(DDRERR) D ERROR
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 | FDASET(DDRROOT,DDRFDA) ;
 | 
|---|
| 27 |  N DDRFILE,DDRIEN,DDRFIELD,DDRVAL,DDRERR,I
 | 
|---|
| 28 |  S I=0
 | 
|---|
| 29 |  F  S I=$O(DDRROOT(I)) Q:'I  S X=DDRROOT(I) D
 | 
|---|
| 30 |  . S DDRFILE=$P(X,U)
 | 
|---|
| 31 |  . S DDRFIELD=$P(X,U,2)
 | 
|---|
| 32 |  . S DDRIEN=$P(X,U,3)
 | 
|---|
| 33 |  . S DDRVAL=$P(X,U,4,99)
 | 
|---|
| 34 |  . D FDA^DILF(DDRFILE,DDRIEN_$S($E(DDRIEN,$L(DDRIEN))'=",":",",1:""),DDRFIELD,"",DDRVAL,"DDRFDA","DDRERR")
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 | VALC(DDRDATA,DDR) ; DDR VALIDATOR rpc callback
 | 
|---|
| 38 |  N DDRFILE,DDRIENS,DDRFIELD,DDRVAL,DDRRSLT,DDRERR,DDRFLAGS,N
 | 
|---|
| 39 |  S DDRFLAGS="EH"
 | 
|---|
| 40 |  S DDRFILE=$G(DDR("FILE"))
 | 
|---|
| 41 |  S DDRIENS=$G(DDR("IENS"))
 | 
|---|
| 42 |  S DDRFIELD=$G(DDR("FIELD"))
 | 
|---|
| 43 |  S DDRVAL=$G(DDR("VALUE"))
 | 
|---|
| 44 |  D VAL^DIE(DDRFILE,DDRIENS,DDRFIELD,DDRFLAGS,DDRVAL,.DDRRSLT,"","DDRERR")
 | 
|---|
| 45 |  S N=0
 | 
|---|
| 46 |  D SET("[FILLER]")
 | 
|---|
| 47 |  D SET("[Data]")
 | 
|---|
| 48 |  D SET($G(DDRRSLT,U))
 | 
|---|
| 49 |  D SET($G(DDRRSLT(0)))
 | 
|---|
| 50 |  IF $D(DDRERR) D ERROR,HELP
 | 
|---|
| 51 |  Q
 | 
|---|
| 52 | SET(X) ;
 | 
|---|
| 53 |  S N=N+1
 | 
|---|
| 54 |  S DDRDATA(N)=X
 | 
|---|
| 55 |  Q
 | 
|---|
| 56 | HELP ;
 | 
|---|
| 57 |  Q:'$D(DDRERR("DIHELP"))
 | 
|---|
| 58 |  D SET("[BEGIN_diHELP]")
 | 
|---|
| 59 |  S HD=DDRFILE_U_DDRFIELD_U_"?"_U_DDRERR("DIHELP") D SET(HD)
 | 
|---|
| 60 |  N A S A=0 F  S A=$O(DDRERR("DIHELP",A)) Q:'A  D SET(DDRERR("DIHELP",A))
 | 
|---|
| 61 |  D SET("[END_diHELP]")
 | 
|---|
| 62 |  Q
 | 
|---|
| 63 | ERROR ;
 | 
|---|
| 64 |  D SET("[BEGIN_diERRORS]")
 | 
|---|
| 65 |  N A S A=0 F  S A=$O(DDRERR("DIERR",A)) Q:'A  D
 | 
|---|
| 66 |  . N HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS
 | 
|---|
| 67 |  . S HD=DDRERR("DIERR",A)
 | 
|---|
| 68 |  . I $D(DDRERR("DIERR",A,"PARAM",0)) D
 | 
|---|
| 69 |  . . S (B,D)=0 F C=1:1 S B=$O(DDRERR("DIERR",A,"PARAM",B)) Q:B=""  D
 | 
|---|
| 70 |  . . . I B="FILE" S FILE=DDRERR("DIERR",A,"PARAM","FILE")
 | 
|---|
| 71 |  . . . I B="FIELD" S FIELD=DDRERR("DIERR",A,"PARAM","FIELD")
 | 
|---|
| 72 |  . . . I B="IENS" S IENS=DDRERR("DIERR",A,"PARAM","IENS")
 | 
|---|
| 73 |  . . . S D=D+1,PARAM(D)=B_U_DDRERR("DIERR",A,"PARAM",B)
 | 
|---|
| 74 |  . S C=0 F  S C=$O(DDRERR("DIERR",A,"TEXT",C)) Q:'C  S TEXT(C)=DDRERR("DIERR",A,"TEXT",C),TXTCNT=C
 | 
|---|
| 75 |  . S HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(D) D SET(HD)
 | 
|---|
| 76 |  . S B=0 F  S B=$O(PARAM(B)) Q:'B  S %=PARAM(B) D SET(%)
 | 
|---|
| 77 |  . S B=0 F  S B=$O(TEXT(B)) Q:'B  S %=TEXT(B) D SET(%)
 | 
|---|
| 78 |  . Q
 | 
|---|
| 79 |  D SET("[END_diERRORS]")
 | 
|---|
| 80 |  Q
 | 
|---|
| 81 |  ;
 | 
|---|