source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP019.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1RORRP019 ;HCIOFO/SG - RPC: LIST OF PATIENTS ; 5/26/06 12:03pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 Q
5 ;
6 ;***** RETURNS THE LIST OF PATIENTS (EITHER FROM #798 OR #2)
7 ; RPC: [ROR LIST PATIENTS]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; REGIEN Registry IEN
13 ;
14 ; [DATE] If the value of this parameter is greater than 0
15 ; and the 'C' flag is defined, then patients who
16 ; were confrmed in the registry before this date,
17 ; will be skipped.
18 ;
19 ; [PART] The search pattern (partial match restriction).
20 ; If this parameter is a number preceded by the '`',
21 ; then a list containing only the patient with this
22 ; IEN is compiled.
23 ;
24 ; [FLAGS] Flags that control the execution (can be combined):
25 ; 2 Search in the PATIENT file. By default, the
26 ; ROR REGISTRY RECORD and ROR PATIENT files are
27 ; queried. This flag overrides the 'C' and 'P'
28 ; flags.
29 ; B Backwards. Traverses the index in the opposite
30 ; direction of normal traversal.
31 ; C Include confirmed patients
32 ; O Add values of the optional fields
33 ; P Include pending patients
34 ;
35 ; [NUMBER] Maximum number of entries to return. A value of "*"
36 ; or no value in this parameter designates all entries.
37 ;
38 ; [FROM] The index entry(s) from which to begin the list.
39 ; You should use the pieces of the @RESULTS@(0) node
40 ; (starting from the second one) to continue the
41 ; listing in the subsequent procedure calls.
42 ;
43 ; NOTE: The FROM value itself is not included in
44 ; the resulting list.
45 ;
46 ; The ^TMP("DILIST",$J) global node is used by the procedure.
47 ;
48 ; See description of the LIST^DIC for more details about the
49 ; PART, NUMBER and FROM parameters.
50 ;
51 ; Return Values:
52 ;
53 ; A negative value of the first "^"-piece of the RESULTS(0)
54 ; indicates an error (see the RPCSTK^RORERR procedure for more
55 ; details).
56 ;
57 ; Otherwise, number of patients and the value of the FROM
58 ; parameter for the next procedure call are returned in the
59 ; @RESULTS@(0) and the subsequent nodes of the global array
60 ; contain the patients.
61 ;
62 ; @RESULTS@(0) Result Descriptor
63 ; ^01: Number of patients
64 ; ^02: Values that comprise the FROM
65 ; ^nn: parameter for the subsequent call
66 ;
67 ; @RESULTS@(i) Patient
68 ; ... See the $$LOAD2^RORRP020 (RORDEM)
69 ;
70 ; @RESULTS@(i+1) Optional fields (these nodes are created only
71 ; if the FLAGS parameter contains the 'O' flag)
72 ; ^01: "O" (letter O)
73 ; ... See the $$LOAD798^RORRP020
74 ;
75PTLIST(RESULTS,REGIEN,DATE,PART,FLAGS,NUMBER,FROM) ;
76 N BUF,I,RC,RORERRDL,RORMSG,TMP
77 D CLEAR^RORERR("PTLIST^RORRP019",1)
78 K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
79 ;
80 ;=== Check the parameters
81 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
82 . ;--- Registry IEN
83 . I $G(REGIEN)'>0 D Q
84 . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
85 . S REGIEN=+REGIEN
86 . ;--- Flags and date
87 . S FLAGS=$$UP^XLFSTR($G(FLAGS)),DATE=+$G(DATE)
88 . S TMP=$TR(FLAGS,"CP")
89 . ;- The '2' flag overrides all flags related to the CCR files.
90 . I FLAGS["2" S FLAGS=TMP
91 . ;- By default, all registry patients are included
92 . ;- (except those who are marked for deletion).
93 . E I TMP=FLAGS S FLAGS=FLAGS_"CP"
94 . ;- If the date is provided, then make sure that confirmed
95 . ;- registry patients are included in the search (the 'C' flag).
96 . E S:DATE>0 FLAGS=FLAGS_"C"
97 . ;--- Others
98 . S PART=$G(PART),FROM=$G(FROM)
99 . S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
100 ;
101 ;=== Setup the starting point
102 F I=1:1 S TMP=$P(FROM,U,I) Q:TMP="" S FROM(I)=TMP
103 S FROM=$G(FROM(1))
104 ;
105 ;=== Query the file
106 S RC=0 D
107 . ;--- Decode coded SSN of a registry patient
108 . I PART?1"#"1.11N.1"P" D
109 . . S PART=$$XOR^RORUTL03($P(PART,"#",2))
110 . . S TMP=$S(PART["P":10,1:9)
111 . . S:$L(PART)<TMP PART=$TR($J(PART,TMP)," ","0")
112 . . S FLAGS=$TR(FLAGS,"2CP")_"CP"
113 . ;--- Load a single patient with the provided IEN
114 . I PART?1"`"1.N D Q
115 . . I FLAGS'["2" Q:$$PRRIEN^RORUTL01($P(PART,"`",2),REGIEN)'>0
116 . . D FIND^DIC(2,,"@","P",PART,"*","#",,,,"RORMSG")
117 . . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,2)
118 . ;--- List of patients from PATIENT file (#2)
119 . I FLAGS["2" D Q
120 . . S RC=$$LST2(REGIEN,PART,FLAGS,NUMBER,.FROM)
121 . ;--- List of registry patients
122 . S RC=$$LST798(REGIEN,DATE,PART,FLAGS,NUMBER,.FROM)
123 ;
124 ;=== Check for the error(s)
125 I RC<0 D D RPCSTK^RORERR(.RESULTS,RC) Q
126 . K ^TMP("DILIST",$J)
127 ;
128 ;=== Post-processing
129 S RC=$$POSTPROC^RORRP020(RESULTS,REGIEN,FLAGS)
130 I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
131 ;
132 ;=== Success
133 S TMP=$G(^TMP("DILIST",$J,0)),BUF=+$P(TMP,U)
134 K ^TMP("DILIST",$J,0)
135 I $P(TMP,U,3) S I=0 D
136 . F S I=$O(FROM(I)) Q:I'>0 S TMP=FROM(I) S:TMP'="" BUF=BUF_U_TMP
137 S @RESULTS@(0)=BUF
138 Q
139 ;
140 ;***** QUERIES THE 'PATIENT' FILE (#2)
141 ;
142 ; RORREG Registry IEN
143 ;
144 ; PART The partial match restriction
145 ;
146 ; FLAGS Flags that control the execution
147 ;
148 ; NUMBER Maximum number of entries to return
149 ;
150 ; .FROM Reference to a local variable that contains the
151 ; starting point for the LIST^DIC. The new point is
152 ; returned in this variable as well.
153 ;
154 ; Return Values:
155 ; <0 Error code
156 ; 0 Ok
157 ;
158LST2(RORREG,PART,FLAGS,NUMBER,FROM) ;
159 N RC,RORMSG,SCR,TMP,XREF
160 ;--- Select the cross-reference
161 S XREF=$S(PART?4N:"BS",PART?1U4N:"BS5",PART?9N.1"P":"SSN",1:"B")
162 ;--- Compile the screen logic (be careful with naked references)
163 S SCR="I '$$SKIPEMPL^RORUTL02(+Y,.RORREG)"
164 ;--- Get the list of patients
165 S TMP="P"_$S(FLAGS["B":"B",1:"")_$S(XREF="B":"M",1:"")
166 D LIST^DIC(2,,"@",TMP,NUMBER,.FROM,PART,XREF,SCR,,,"RORMSG")
167 S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,2)
168 ;---
169 Q $S($G(RC)<0:RC,1:0)
170 ;
171 ;***** QUERIES THE CCR FILES (#798 OR #798.4)
172 ;
173 ; REGIEN Registry IEN
174 ;
175 ; RORDT Ignore patients who were confirmed in the registry
176 ; before the provided date (if the FLAGS parameter
177 ; contains the "C" flag)
178 ;
179 ; PART The partial match restriction
180 ;
181 ; FLAGS Flags that control the execution
182 ;
183 ; NUMBER Maximum number of entries to return
184 ;
185 ; .FROM Reference to a local variable that contains the
186 ; starting point for the LIST^DIC. The new point is
187 ; returned in this variable as well.
188 ;
189 ; Return Values:
190 ; <0 Error code
191 ; 0 Ok
192 ;
193LST798(REGIEN,RORDT,PART,FLAGS,NUMBER,FROM) ;
194 N APART,RC,RORMSG,RORPS,SCR,TMP,XREF
195 S RC=0
196 ;--- Analyze the parameters
197 S:FLAGS["C" RORPS(0)="" ; Confirmed
198 S:FLAGS["P" RORPS(4)="" ; Pending
199 S XREF=$S(PART?4N:"BS",PART?1U4N:"BS5",PART?9N.1"P":"SSN",1:"")
200 ;--- Select the appropriate CCR file and perform the query
201 I XREF'="" D
202 . S SCR="S D=$O(^RORDATA(798,""KEY"",+Y,"_REGIEN_",0)) "
203 . S SCR=SCR_"I D>0 S D=$G(^RORDATA(798,D,0)) "
204 . S SCR=SCR_"I $D(RORPS(+$P(D,U,5))) "
205 . ;--- If the confirmation threshold is provided, add the
206 . ; screen code and check if there is at least one record
207 . ;--- that conforms the confirmation date criterion
208 . I RORDT>0 D Q:'$D(SCR)
209 . . I FLAGS["B" D Q
210 . . . S SCR=SCR_"I $P(D,U,4)'>RORDT "
211 . . . K:$O(^RORDATA(798,"ARCP",REGIEN_"#",""))>RORDT SCR
212 . . ;---
213 . . S SCR=SCR_"I $P(D,U,4)'<RORDT "
214 . . K:$O(^RORDATA(798,"ARCP",REGIEN_"#",""),-1)<RORDT SCR
215 . ;--- Query the ROR PATIENT file
216 . S TMP="P"_$S(FLAGS["B":"B",1:"")
217 . D LIST^DIC(798.4,,"@",TMP,NUMBER,.FROM,PART,XREF,SCR,,,"RORMSG")
218 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.4)
219 E D
220 . S APART(1)=REGIEN_"#"
221 . S FROM(1)=$S(FLAGS["B":"~",1:" ")
222 . S SCR="S D=+$P($G(^(0)),U,5) I $D(RORPS(D)) "
223 . ;---
224 . I RORDT>0 S XREF="ARCP",APART(3)=PART D:$G(FROM(2))=""
225 . . S FROM(2)=$$FMADD^XLFDT(RORDT,,,,$S(FLAGS["B":1,1:-1))
226 . E S XREF="ARP",APART(2)=PART
227 . ;--- Query the ROR REGISTRY RECORD file
228 . S TMP="P"_$S(FLAGS["B":"B",1:"")
229 . D LIST^DIC(798,,"@;.01I",TMP,NUMBER,.FROM,.APART,XREF,SCR,,,"RORMSG")
230 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798)
231 ;---
232 Q $S($G(RC)<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.