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

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1DDR3 ;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 ;
7FILEC(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 ;
26FDASET(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 ;
37VALC(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
52SET(X) ;
53 S N=N+1
54 S DDRDATA(N)=X
55 Q
56HELP ;
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
63ERROR ;
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 ;
Note: See TracBrowser for help on using the repository browser.