source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP020.m@ 785

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RORRP020 ;HCIOFO/SG - RPC: PATIENT DATA UTILITIES ; 5/11/06 2:55pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10035 Fields and x-refs of the PATIENT file (supported)
7 ;
8 Q
9 ;
10 ;***** LOADS THE DATA FROM THE 'PATIENT' FILE (#2)
11 ;
12 ; DFN Patient IEN
13 ;
14 ; .RORDEM Reference to a local variable where the demographic
15 ; information is returned to:
16 ;
17 ; ^01: Patient IEN (DFN)
18 ; ^02: Patient Name
19 ; ^03: Date of Birth (FileMan)
20 ; ^04: SSN
21 ; ^05: Date of Death (FileMan)
22 ; ^06: Sex (F/M)
23 ;
24 ; [.RORADR] Reference to a local variable where the patient's
25 ; address is returned to:
26 ;
27 ; ^01: Address (1)
28 ; ^02: Address (2)
29 ; ^03: Address (3)
30 ; ^04: City
31 ; ^05: State (IEN)
32 ; ^06: State (Name)
33 ; ^07: ZIP
34 ; ^08: ZIP+4
35 ; ^09: County (IEN)
36 ; ^10: County (Name)
37 ; ^11: Home Phone
38 ;
39 ; [.VADM] Reference to a local array that is populated by
40 ; the 4^VADM API inside this function
41 ;
42 ; Return Values:
43 ; <0 Error code
44 ; 0 Ok
45 ;
46LOAD2(DFN,RORDEM,RORADR,VADM) ;
47 N I,VA,VAHOW,VAPA,VAROOT D 4^VADPT
48 ;--- Demographic information
49 S RORDEM=DFN ; DFN
50 S $P(RORDEM,U,2)=$G(VADM(1)) ; Name
51 S $P(RORDEM,U,3)=$P($G(VADM(3)),U) ; DOB
52 S $P(RORDEM,U,4)=$P($G(VADM(2)),U) ; SSN
53 S $P(RORDEM,U,5)=$P($G(VADM(6)),U) ; DOD
54 S $P(RORDEM,U,6)=$P($G(VADM(5)),U) ; Sex
55 ;--- Patient's address
56 S RORADR=$G(VAPA(1)) ; Address (1)
57 S $P(RORADR,U,2)=$G(VAPA(2)) ; Address (2)
58 S $P(RORADR,U,3)=$G(VAPA(3)) ; Address (3)
59 S $P(RORADR,U,4)=$G(VAPA(4)) ; City
60 S $P(RORADR,U,5)=$P($G(VAPA(5)),U,1) ; State IEN
61 S $P(RORADR,U,6)=$P($G(VAPA(5)),U,2) ; State Name
62 S $P(RORADR,U,7)=$P($G(VAPA(6)),U,1) ; ZIP
63 S $P(RORADR,U,8)=$P($G(VAPA(6)),U,2) ; ZIP+4
64 S $P(RORADR,U,9)=$P($G(VAPA(7)),U,1) ; County IEN
65 S $P(RORADR,U,10)=$P($G(VAPA(7)),U,2) ; County Name
66 S $P(RORADR,U,11)=$G(VAPA(8)) ; Home Phone Number
67 Q 0
68 ;
69 ;***** LOADS THE REGISTRY DATA FOR THE PATIENT
70 ;
71 ; IEN IEN of the registry record (file #798)
72 ;
73 ; .ROR8DST Reference to a local variable where the results
74 ; are returned to:
75 ;
76 ; ^01: Date Entered (FileMan)
77 ; ^02: Status Code (Field 3, File #798)
78 ; ^03: Active (0/1)
79 ; ^04: Do not Send (0/1)
80 ; ^05: Data Acknowledged Until (FileMan)
81 ; ^06: Data Extracted Until (FileMan)
82 ; ^07: Date Selected (FileMan)
83 ; ^08: Date Confirmed (FileMan)
84 ; ^09: Location Selected (Institution Name)
85 ; ^10: Description of the Earliest Selection Rule
86 ; ^11: reserved
87 ; ^12: reserved
88 ; ^13: Action Flags (see the description below)
89 ;
90 ; The Action Flags field indicates the actions that
91 ; can be performed on the patient's record in the
92 ; registry:
93 ;
94 ; C CDC form can be edited/printed
95 ; D The record can be deleted
96 ; E The record can be edited
97 ; O Read-only mode
98 ;
99 ; DOD Date of Death (for deceased patients)
100 ;
101 ; Return Values:
102 ; <0 Error code
103 ; 0 Ok
104 ;
105LOAD798(IEN,ROR8DST,DOD) ;
106 N FLAGS,IENS,RC,RORBUF,RORMSG,TMP
107 S ROR8DST=""
108 ;
109 ;--- Check if the patient is in the registry
110 I (IEN'>0)!($D(^RORDATA(798,+IEN))<10) D Q 0
111 . S $P(ROR8DST,U,13)=""
112 ;
113 ;--- Load values from the registry record
114 S IENS=(+IEN)_","
115 D GETS^DIQ(798,IENS,"1;2;3;8;9.1;9.2;11","I","RORBUF","RORMSG")
116 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
117 ;
118 ;--- Registry data
119 S ROR8DST=$G(RORBUF(798,IENS,1,"I")) ; DATE ENTERED
120 S $P(ROR8DST,U,2)=+$G(RORBUF(798,IENS,3,"I")) ; STATUS
121 S $P(ROR8DST,U,3)=+$G(RORBUF(798,IENS,8,"I")) ; ACTIVE
122 S $P(ROR8DST,U,4)=+$G(RORBUF(798,IENS,11,"I")) ; DON'T SEND
123 S $P(ROR8DST,U,5)=$G(RORBUF(798,IENS,9.1,"I")) ; ACKNOWLEDGED UNTIL
124 S $P(ROR8DST,U,6)=$G(RORBUF(798,IENS,9.2,"I")) ; EXTRACTED UNTIL
125 S $P(ROR8DST,U,8)=$G(RORBUF(798,IENS,2,"I")) ; DATE CONFIRMED
126 ;
127 ;--- Earliest selection rule
128 S IENS=","_IENS,TMP="@;.01I;1I;2E" K RORBUF
129 D LIST^DIC(798.01,IENS,TMP,"PU",1,,,"AD",,,"RORBUF","RORMSG")
130 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
131 I $G(RORBUF("DILIST",0))>0 S RC=0 D Q:RC<0 RC
132 . S TMP=$G(RORBUF("DILIST",1,0))
133 . S $P(ROR8DST,U,7)=$P(TMP,U,3) ; DATE
134 . S $P(ROR8DST,U,9)=$P(TMP,U,4) ; LOCATION
135 . S IENS=+$P(TMP,U,2)_","
136 . S TMP=$$GET1^DIQ(798.2,IENS,4,,,"RORMSG")
137 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.2,IENS)
138 . S $P(ROR8DST,U,10)=TMP ; SELECTION RULE
139 ;
140 ;--- Action flags
141 ; The actions and modes are enabled/disabled according to the
142 ; following table:
143 ;-----------------------------------------------------;
144 ; Actions ; Status of the patient ;
145 ; and ;--------------------------------------;
146 ; Modes ;Not Added;Pending;Active;Inactive;Dead;
147 ;--------------+---------+-------+------+--------+----;
148 ; (C)DC ; D ; D ; ; ; ;
149 ; (D)elete ; D ; ; ; ; ;
150 ; (E)dit ; D ; ; ; ; ;
151 ; Read (O)nly ; ; ; ; ; ;
152 ;-----------------------------------------------------;
153 ; D the action is disabled if at least one of the marked
154 ; conditions is true;
155 ;
156 ; E the action is enabled if at least one of the marked
157 ; conditions is true.
158 ;---
159 D
160 . I $P(ROR8DST,U,2)=4 S FLAGS="DE" Q ; Pending
161 . S FLAGS="CDE"
162 S $P(ROR8DST,U,13)=FLAGS
163 Q 0
164 ;
165 ;***** PERFORMS THE POST-PROCESSING OF THE LISTS
166 ;
167 ; RESULTS Closed root of the array that contains the
168 ; results of the query
169 ;
170 ; REGIEN Registry IEN
171 ;
172 ; FLAGS Flags that control the execution
173 ;
174 ; Return Values:
175 ; <0 Error code
176 ; 0 Ok
177 ;
178POSTPROC(RESULTS,REGIEN,FLAGS) ;
179 N BUF,DOD,FNP,FO,IEN,IR,PATIEN,RC,TMP
180 S FNP=($TR(FLAGS,"P")'=FLAGS),FO=(FLAGS["O")
181 ;--- Process the resulting records
182 S (IR,RC)=0
183 F S IR=$O(@RESULTS@(IR)) Q:IR'>0 D Q:RC<0
184 . S BUF=$G(@RESULTS@(IR,0)),PATIEN=+$P(BUF,U,2)
185 . I PATIEN'>0 S PATIEN=+BUF Q:PATIEN'>0
186 . ;--- Load the required fields from the PATIENT file
187 . Q:$$LOAD2(PATIEN,.BUF)<0
188 . S DOD=$P(BUF,U,5)
189 . S @RESULTS@(IR,0)=BUF
190 . ;--- Add optional registry fields if necessary
191 . I FO D Q:RC<0
192 . . ;--- Get the IEN of the registry record
193 . . S IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN)
194 . . ;--- Try to load the data from the ROR REGISTRY RECORD file
195 . . S RC=$$LOAD798(IEN,.BUF,DOD)
196 . . S:RC'<0 @RESULTS@(IR,1)="O^"_BUF
197 ;---
198 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.