source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP021.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1RORRP021 ;HCIOFO/SG - RPC: PATIENT DATA ; 8/19/05 10:28am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** LOADS THE PATIENT DATA
7 ; RPC: [ROR PATIENT GET DATA]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; PTIEN IEN of the patient (DFN)
13 ;
14 ; [FLAGS] Flags that control the execution (can be combined):
15 ; A Load the patient's address
16 ; E Load the ethnicity information
17 ; L Load values of patient's active local fields
18 ; R Load the race information
19 ; S Load the selection rules
20 ;
21 ; The "L" and "S" flags require the REGIEN parameter.
22 ; Otherwise, they are ignored.
23 ;
24 ; [REGIEN] Registry IEN.
25 ; If value of this parameter is greater than 0
26 ; then the "PRD" segment with the basic patient's
27 ; registry data will be returned. If the patient
28 ; is not in the registry then an empty "PRD" segment
29 ; will be returned anyway.
30 ;
31 ; Return Values:
32 ;
33 ; A negative value of the first "^"-piece of the RESULTS(0)
34 ; indicates an error (see the RPCSTK^RORERR procedure for more
35 ; details).
36 ;
37 ; Otherwise, zero is returned in the RESULTS(0) and the subsequent
38 ; nodes of the array contain the patient's data.
39 ;
40 ; RESULTS(0) 0
41 ;
42 ; RESULTS(i) Demographic Information
43 ; ^01: "DEM"
44 ; ^02: ""
45 ; ... See the $$LOAD2^RORRP020 (RORDEM)
46 ;
47 ; RESULTS(i) Patient's Address
48 ; ^01: "ADR"
49 ; ^02: ""
50 ; ... See the $$LOAD2^RORRP020 (RORADR)
51 ;
52 ; RESULTS(i) Race Information
53 ; ^01: "RCE"
54 ; ^02: Race IEN
55 ; ^03: Race HL7 Value
56 ; ^04: Race
57 ; ^05: Collection Method HL7 Value
58 ; ^06: Collection Method
59 ;
60 ; Race HL7 Values
61 ; 1002-5 American Indian or Alaska Native
62 ; 2028-9 Asian
63 ; 2054-5 Black or African American
64 ; 0000-0 Declined to Answer
65 ; 2076-8 Native Hawaiian or Pacific Islander
66 ; 9999-4 Unknown by Patient
67 ; 2106-3 White
68 ;
69 ; Collection Method HL7 Values
70 ; OBS Observer
71 ; PRX Proxy
72 ; SLF Self Identification
73 ; UNK Unknown
74 ;
75 ; RESULTS(i) Ethnicity Information
76 ; ^01: "ETN"
77 ; ^02: Ethnicity IEN
78 ; ^03: Ethnicity HL7 Value
79 ; ^04: Ethnicity
80 ; ^05: Collection Method HL7 value
81 ; ^06: Collection Method
82 ;
83 ; Ethnicity HL7 Values
84 ; 0000-0 Declined to Answer
85 ; 2135-2 Hispanic or Latino
86 ; 2186-5 Not Hispanic or Latino
87 ; 9999-4 Unknown by Patient
88 ;
89 ; RESULTS(i) Patient's Registry Data
90 ; ^01: "PRD"
91 ; ^02: ""
92 ; ... See the $$LOAD798^RORRP020
93 ;
94 ; RESULTS(i) Local field data
95 ; ^O1: "LFV"
96 ; ^02: IEN in the LOCAL FIELD multiple
97 ; of the ROR REGISTRY RECORD file
98 ; ^03: Field Definition IEN
99 ; (in the ROR LOCAL FIELD file)
100 ; ^04: Field Name
101 ; ^05: Date (FileMan)
102 ; ^06: Comment
103 ;
104 ; RESULTS(i) Selection Rule
105 ; ^01: "PSR"
106 ; ^02: IEN in the SELECTION RULE multiple
107 ; of the ROR REGISTRY RECORD file
108 ; ^03: Rule Definition IEN
109 ; (in the ROR SELECTION RULE file)
110 ; ^04: Name of the Rule
111 ; ^05: Date (FileMan)
112 ; ^06: Location IEN (Institution IEN)
113 ; ^07: Location Name (Institution Name)
114 ; ^08: Short Description
115 ;
116GETPTDAT(RESULTS,PTIEN,FLAGS,REGIEN) ;
117 N BUF,BUF1,DOD,IEN,RC,RESPTR,RORERRDL,VADM
118 D CLEAR^RORERR("GETPTDAT^RORRP021",1)
119 K RESULTS S (RESULTS(0),RESPTR)=0
120 ;=== Check the parameters
121 S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
122 . ;--- Patient IEN
123 . I $G(PTIEN)'>0 D Q
124 . . S RC=$$ERROR^RORERR(-88,,,,"PTIEN",$G(PTIEN))
125 . S PTIEN=+PTIEN
126 . ;--- Flags
127 . S FLAGS=$$UP^XLFSTR($G(FLAGS))
128 ;=== Load the data from the PATIENT file
129 S RC=$$LOAD2^RORRP020(PTIEN,.BUF,.BUF1,.VADM)
130 I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
131 S DOD=$P(BUF,U,5)
132 ;
133 ;=== Demographic information and address
134 S RESPTR=RESPTR+1,RESULTS(RESPTR)="DEM^^"_BUF
135 S:FLAGS["A" RESPTR=RESPTR+1,RESULTS(RESPTR)="ADR^^"_BUF1
136 ;
137 ;=== Race information
138 I FLAGS["R" D:$G(VADM(12))>0
139 . N I,METHOD,RACE
140 . S I=""
141 . F S I=$O(VADM(12,I)) Q:I="" D
142 . . S RACE=$G(VADM(12,I)) Q:RACE'>0
143 . . S METHOD=$G(VADM(12,I,1))
144 . . S BUF="RCE"_U_(+RACE)
145 . . ;---
146 . . S $P(BUF,U,3)=$$PTR2CODE^DGUTL4(+RACE,1,2)
147 . . S $P(BUF,U,4)=$P(RACE,U,2)
148 . . S $P(BUF,U,5)=$$PTR2CODE^DGUTL4(+METHOD,3,2)
149 . . S $P(BUF,U,6)=$P(METHOD,U,2)
150 . . ;---
151 . . S RESPTR=RESPTR+1,RESULTS(RESPTR)=BUF
152 ;
153 ;=== Ethnicity information
154 I FLAGS["E" D:$G(VADM(11))>0
155 . N ETHN,I,METHOD
156 . S I=""
157 . F S I=$O(VADM(11,I)) Q:I="" D
158 . . S ETHN=$G(VADM(11,I)) Q:ETHN'>0
159 . . S METHOD=$G(VADM(11,I,1))
160 . . S BUF="ETN"_U_(+ETHN)
161 . . ;---
162 . . S $P(BUF,U,3)=$$PTR2CODE^DGUTL4(+ETHN,2,2)
163 . . S $P(BUF,U,4)=$P(ETHN,U,2)
164 . . S $P(BUF,U,5)=$$PTR2CODE^DGUTL4(+METHOD,3,2)
165 . . S $P(BUF,U,6)=$P(METHOD,U,2)
166 . . ;---
167 . . S RESPTR=RESPTR+1,RESULTS(RESPTR)=BUF
168 ;
169 ;=== Patient's registry data
170 I $G(REGIEN)>0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
171 . S RESPTR=RESPTR+1
172 . ;--- Get the IEN of the registry record
173 . S IEN=$$PRRIEN^RORUTL01(PTIEN,REGIEN)
174 . I IEN'>0 S RESULTS(RESPTR)="PRD" Q
175 . ;--- Load the data from the patient's registry record
176 . S RC=$$LOAD798^RORRP020(IEN,.BUF,DOD) Q:RC<0
177 . S RESULTS(RESPTR)="PRD^^"_BUF
178 . ;--- Local field values
179 . I FLAGS["L" D Q:RC<0
180 . . S RC=$$LFV(IEN,.RESULTS,.RESPTR)
181 . ;--- Selection rules
182 . I FLAGS["S" D Q:RC<0
183 . . S RC=$$PSR(IEN,.RESULTS,.RESPTR)
184 ;===
185 Q
186 ;
187 ;***** GET THE LOCAL FIELD VALUES
188LFV(IEN798,RESULTS,RESPTR) ;
189 N I,IEN,IENS,RORBUF,SCR,RORMSG
190 S DT=$$DT^XLFDT
191 ;--- Load the data
192 S SCR="I $$LFACTIVE^RORDD01(+$G(^(0)))"
193 S IENS=","_IEN798_",",I="@;.01I;.01E;.02I;1"
194 D LIST^DIC(798.02,IENS,I,"P",,,,"B",SCR,,"RORBUF","RORMSG")
195 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.02,IENS)
196 ;--- Add the data to the output array
197 S I=0
198 F S I=$O(RORBUF("DILIST",I)) Q:I'>0 D
199 . S RESPTR=RESPTR+1
200 . S RESULTS(RESPTR)="LFV^"_RORBUF("DILIST",I,0)
201 ;--- Success
202 Q 0
203 ;
204 ;***** GET THE SELECTION RULES
205PSR(IEN798,RESULTS,RESPTR) ;
206 N BUF,I,IEN,IENS,RORBUF,RORMSG,TMP
207 ;--- Load the data
208 S IENS=","_IEN798_",",TMP="@;.01I;.01E;1I;2I;2E"
209 D LIST^DIC(798.01,IENS,TMP,"P",,,,"AD",,,"RORBUF","RORMSG")
210 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
211 ;--- Add the data to the output array
212 S I=0
213 F S I=$O(RORBUF("DILIST",I)) Q:I'>0 D
214 . S BUF=RORBUF("DILIST",I,0),IEN=+$P(BUF,U,2) Q:IEN'>0
215 . S TMP=$$GET1^DIQ(798.2,IEN_",",4,,,"RORMSG")
216 . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.2,IEN_",")
217 . S $P(BUF,U,7)=$S(TMP'="":TMP,1:$P(BUF,U,3))
218 . S RESPTR=RESPTR+1,RESULTS(RESPTR)="PSR^"_BUF
219 ;--- Success
220 Q 0
Note: See TracBrowser for help on using the repository browser.