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

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1DDR2 ;ALB/MJK-FileMan Delphi Components' RPCs ;4/20/98 11:38
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 ;
7FIND1C(DDRDATA,DDR) ; DDR FIND1 rpc callback
8 N DDRFILE,DDRIENS,DDRFLAGS,DDRVAL,DDRXREF,DDRSCRN,DDRERR,A,IEN,N
9 D PARSE(.DDR) S DDRVAL=$G(DDR("VALUE"))
10 S A=$$FIND1^DIC(DDRFILE,DDRIENS,DDRFLAGS,DDRVAL,DDRXREF,DDRSCRN,"DDRERR")
11 S A=$S($G(DIERR):"",1:A)
12 S N=0 D SET(A)
13 I $G(DIERR) D ERROR Q
14 I $G(DDROPT)["R" S IEN=$S($G(DDRIENS)]"":A_DDRIENS,1:A_",") D RECALL^DILFD(DDRFILE,IEN,DUZ)
15 Q
16 ;
17GETSC(DDRDATA,DDR) ; DDR GETS ENTRY DATA rpc callback
18 N DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,DDROPT,DDRRSLT,DDRERR
19 N DDRXREF,DDRSCRN,N
20 D PARSE(.DDR)
21 D GETS^DIQ(DDRFILE,DDRIENS,DDRFLDS,DDRFLAGS,"DDRRSLT","DDRERR")
22 S N=0
23 I '$D(DDROPT) D 1,2 Q
24 I $G(DDROPT)["U" D 11,21
25 I $G(DDROPT)["?" D HLP
26 Q
271 I $D(DDRRSLT) D
28 . N DDRFIELD,X,J
29 . D SET("[Data]")
30 . S DDRFIELD=0 F S DDRFIELD=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD)) Q:'DDRFIELD D
31 . . ;Do not remove stripping of ',' from IENS in line below if this code should work with T11 (21.1T1) of FM components.
32 . . S X=DDRFILE_"^"_$E(DDRIENS,1,$L(DDRIENS)-1)_"^"_DDRFIELD_"^"
33 . . ; -- below call to $$GET1 is too slow...working w/FM team for speed
34 . . ;IF $$GET1^DID(DDRFILE,DDRFIELD,"","TYPE")="WORD-PROCESSING" D
35 . . ;IF $P($G(^DD(DDRFILE,DDRFIELD,0)),U,4)[";0" D <<Replaced by more generic check below.
36 . . I $P($G(^DD(+$P($G(^DD(DDRFILE,DDRFIELD,0)),U,2),.01,0)),U,2)["W" D
37 . . . D SET(X_"[WORD PROCESSING]")
38 . . . S J=0 F S J=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J)) Q:'J D
39 . . . . D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J))
40 . . . D SET("$$END$$")
41 . . E D
42 . . . D SET(X_$G(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I"))_"^"_$G(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")))
43 Q
4411 N HD,I,E,B,J,K
45 D SET("[BEGIN_diDATA]")
46 S HD=DDRFILE_U_$E(DDRIENS,1,$L(DDRIENS)-1)
47 S I=DDRFLAGS["I",E=DDRFLAGS["E",B=(I&E)
48 S DDRFIELD=0 F S DDRFIELD=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD)) Q:'DDRFIELD D
49 . I $P($G(^DD(+$P($G(^DD(DDRFILE,DDRFIELD,0)),U,2),.01,0)),U,2)["W" D Q
50 . . S (K,J)=0 F S K=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,K)) Q:'K S J=J+1
51 . . D SET(HD_U_DDRFIELD_U_"W"_U_J)
52 . . S J=0 F S J=$O(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J)) Q:'J D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,J))
53 . . Q
54 . S FLG=$S(B:"B",I:"I",1:"E")
55 . D SET(HD_U_DDRFIELD_U_FLG)
56 . I B D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")),SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I")) Q
57 . I E D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"E")) Q
58 . I I D SET(DDRRSLT(DDRFILE,DDRIENS,DDRFIELD,"I")) Q
59 D SET("[END_diDATA]")
60 Q
612 IF $D(DDRERR) D SET("[ERROR]")
62 Q
6321 I $D(DIERR) D ERROR
64 Q
65SET(X) ;
66 S N=N+1
67 S DDRDATA(N)=X
68 Q
69HLP ;
70 N FLD,FLG,Z,%
71 S FLD=0,FLG="?"
72 D SET("[BEGIN_diHELP]")
73 F Z=1:1 S FLD=+$P(DDRFLDS,";",Z) Q:'FLD D HELP(DDRFILE,DDRIENS,FLD,FLG)
74 D SET("[END_diHELP]")
75 Q
76 ;
77GETHLPC(DDRDATA,DDR) ; DDR GET DD HELP rpc callback
78 N DDRFILE,DDRFIELD,DDRFLGS,N
79 S DDRFILE=$G(DDR("FILE"))
80 S DDRFIELD=$G(DDR("FIELD"))
81 S DDRFLGS=$G(DDR("FLAGS"))
82 S N=0
83 D SET("[BEGIN_diHELP]")
84 D HELP(DDRFILE,"",DDRFIELD,DDRFLGS)
85 D SET("[END_diHELP]")
86 Q
87 ;
88HELP(FILE,IENS,FIELD,FLGS) ;
89 N DDRHLP,HD,A
90 D HELP^DIE(FILE,IENS,FIELD,FLGS,"DDRHLP")
91 Q:'$D(DDRHLP("DIHELP"))
92 S HD=FILE_U_FIELD_U_"?"_U_DDRHLP("DIHELP") D SET(HD)
93 S A=0 F S A=$O(DDRHLP("DIHELP",A)) Q:'A D SET(DDRHLP("DIHELP",A))
94 Q
95ERROR ;
96 D SET("[BEGIN_diERRORS]")
97 N A S A=0 F S A=$O(DDRERR("DIERR",A)) Q:'A D
98 . N HD,PARAM,B,C,TEXT,TXTCNT,D,FILE,FIELD,IENS
99 . S HD=DDRERR("DIERR",A)
100 . I $D(DDRERR("DIERR",A,"PARAM",0)) D
101 . . S (B,D)=0 F C=1:1 S B=$O(DDRERR("DIERR",A,"PARAM",B)) Q:B="" D
102 . . . I B="FILE" S FILE=DDRERR("DIERR",A,"PARAM","FILE")
103 . . . I B="FIELD" S FIELD=DDRERR("DIERR",A,"PARAM","FIELD")
104 . . . I B="IENS" S IENS=DDRERR("DIERR",A,"PARAM","IENS")
105 . . . S D=D+1,PARAM(D)=B_U_DDRERR("DIERR",A,"PARAM",B)
106 . S C=0 F S C=$O(DDRERR("DIERR",A,"TEXT",C)) Q:'C S TEXT(C)=DDRERR("DIERR",A,"TEXT",C),TXTCNT=C
107 . S HD=HD_U_TXTCNT_U_$G(FILE)_U_$G(IENS)_U_$G(FIELD)_U_$G(D) D SET(HD)
108 . S B=0 F S B=$O(PARAM(B)) Q:'B S %=PARAM(B) D SET(%)
109 . S B=0 F S B=$O(TEXT(B)) Q:'B S %=TEXT(B) D SET(%)
110 . Q
111 D SET("[END_diERRORS]")
112 Q
113PARSE(DDR) ;
114 S DDRFILE=$G(DDR("FILE"))
115 S DDRIENS=$G(DDR("IENS"))
116 S DDRFLDS=$G(DDR("FIELDS"))
117 S DDRFLAGS=$G(DDR("FLAGS"))
118 S DDRXREF=$G(DDR("XREF"))
119 S DDRSCRN=$G(DDR("SCREEN"))
120 S:$D(DDR("OPTIONS")) DDROPT=DDR("OPTIONS")
121 Q
Note: See TracBrowser for help on using the repository browser.