source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX003A.m@ 759

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1RORX003A ;HCIOFO/SG - GENERAL UTILIZATION AND DEMOGRAPHICS ; 11/14/06 8:50am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10061 2^VADPT (supported)
7 ;
8 Q
9 ;
10 ;***** INCREMENTS SUMMARY COUNTER
11INCSUM(SUMMARY,VAL) ;
12 S:$G(VAL)="" VAL="NO DATA"
13 S RORSUM(SUMMARY,VAL)=$G(RORSUM(SUMMARY,VAL))+1
14 Q
15 ;
16 ;***** ADDS THE PATIENT DATA TO THE REPORT
17 ;
18 ; IENS IENS of the patient's record in the registry
19 ; PARTAG Reference (IEN) to the parent tag
20 ;
21 ; Return Values:
22 ; <0 Error code
23 ; 0 Ok
24 ; >0 Skip the patient
25 ;
26PATIENT(IENS,PARTAG) ;
27 N DFN,IEN,NAME,RC,RORBUF,RORMSG,TMP,UTIL,VA,VADM,VAERR,VAHOW,VAPTYP,VAROOT
28 S RC=0
29 ;
30 ;--- Get the data from the ROR REGISTRY RECORD file
31 I $G(RORFL798)'="" D Q:RC<0 RC
32 . D GETS^DIQ(798,IENS,RORFL798,"I","RORBUF","RORMSG")
33 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798,IENS)
34 S DFN=$G(RORBUF(798,IENS,.01,"I"))
35 ;
36 ;--- Skip a patient without utilization
37 S UTIL=$$UTIL^RORXU003(RORSDT,ROREDT,DFN,.RORUTIL)
38 Q:'UTIL 1
39 ;
40 ;--- Get the data from the ROR HIV STUDY file
41 I $G(RORFLICR)'="" D Q:RC<0 RC
42 . D GETS^DIQ(799.4,IENS,RORFLICR,"I","RORBUF","RORMSG")
43 . I $G(DIERR),'$D(RORMSG("DIERR","E",601)) D Q
44 . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
45 ;
46 ;--- Load the demographic data
47 D 2^VADPT
48 ;
49 ;--- The <PATIENT> tag
50 S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
51 Q:PTAG<0 PTAG S RORSUM=$G(RORSUM)+1
52 ;--- Patient Name
53 D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
54 ;--- SSN or LAST4
55 I $$OPTCOL^RORXU006("SSN") D
56 . D ADDVAL^RORTSK11(RORTSK,"SSN",$P(VADM(2),U),PTAG,2)
57 E D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
58 ;
59 ;--- Date of Birth
60 D:$$OPTCOL^RORXU006("DOB")
61 . S TMP=$$DATE^RORXU002(VADM(3)\1)
62 . D ADDVAL^RORTSK11(RORTSK,"DOB",TMP,PTAG,1)
63 . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
64 . D INCSUM("DOB",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
65 ;
66 ;--- Age
67 D:$$OPTCOL^RORXU006("AGE")
68 . S TMP=+$G(VADM(6)) ; Date of Death
69 . S TMP=$S(TMP'>0:RORAGEDT,TMP<RORAGEDT:TMP,1:RORAGEDT)
70 . S TMP=$$FMDIFF^XLFDT(TMP,+VADM(3))\365
71 . D ADDVAL^RORTSK11(RORTSK,"AGE",$S(TMP>0:TMP,1:""),PTAG,1)
72 . Q:TMP'>0
73 . S RORSUM("AGE")=$G(RORSUM("AGE"))+1
74 . S RORSUM("AGE","Average")=$G(RORSUM("AGE","Average"))+TMP
75 . D INCSUM("AGE",TMP-(TMP#10))
76 ;
77 ;--- Sex
78 D:$$OPTCOL^RORXU006("SEX")
79 . S TMP=$P(VADM(5),U,2)
80 . D ADDVAL^RORTSK11(RORTSK,"SEX",TMP,PTAG,1)
81 . D INCSUM("SEX",TMP)
82 ;
83 ;--- Race
84 D:$$OPTCOL^RORXU006("RACE")
85 . N I,SUMVAL,TABLE
86 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"RACES",,PTAG)
87 . I $G(VADM(12))>0 S I="" D
88 . . F S I=$O(VADM(12,I)) Q:I="" D
89 . . . S SUMVAL=$P(VADM(12,I),U,2)
90 . . . D ADDVAL^RORTSK11(RORTSK,"RACE",SUMVAL,TABLE)
91 . . S:VADM(12)>1 SUMVAL="MULTIPLE VALUES"
92 . E D ADDVAL^RORTSK11(RORTSK,"RACE",,TABLE)
93 . D INCSUM("RACE",$G(SUMVAL))
94 ;
95 ;--- Ethnicity
96 D:$$OPTCOL^RORXU006("RACE")
97 . N I,SUMVAL,TABLE
98 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ETHNS",,PTAG)
99 . I $G(VADM(11))>0 S I="" D
100 . . F S I=$O(VADM(11,I)) Q:I="" D
101 . . . S SUMVAL=$P(VADM(11,I),U,2)
102 . . . D ADDVAL^RORTSK11(RORTSK,"ETHN",SUMVAL,TABLE)
103 . . S:VADM(11)>1 SUMVAL="MULTIPLE VALUES"
104 . E D ADDVAL^RORTSK11(RORTSK,"ETHN",,TABLE)
105 . D INCSUM("ETHN",$G(SUMVAL))
106 ;
107 ;--- Risk factors
108 D:$$OPTCOL^RORXU006("RISK")
109 . N I,RISKS
110 . S RISKS=$$RISKS^RORXU005(+IENS) S:RISKS<0 RISKS=""
111 . D ADDVAL^RORTSK11(RORTSK,"RISK",RISKS,PTAG)
112 . S RISKS=$TR(RISKS," ")
113 . F I=1:1 S TMP=$P(RISKS,",",I) Q:TMP'>0 D
114 . . S RORRISK(TMP)=$G(RORRISK(TMP))+1
115 ;
116 ;--- Date Selected
117 D:$$OPTCOL^RORXU006("SELDT")
118 . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,3.2,"I"))\1)
119 . D ADDVAL^RORTSK11(RORTSK,"SELDT",TMP,PTAG,1)
120 . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
121 . D INCSUM("SELDT",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
122 ;
123 ;--- Date Confirmed
124 D:$$OPTCOL^RORXU006("CONFDT")
125 . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,2,"I"))\1)
126 . D ADDVAL^RORTSK11(RORTSK,"CONFDT",TMP,PTAG,1)
127 . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
128 . D INCSUM("CONFDT",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
129 ;
130 ;--- Utilization
131 D:$$OPTCOL^RORXU006("UTIL")
132 . S TMP=$$UTLCODES($P(UTIL,U,2,999))
133 . D ADDVAL^RORTSK11(RORTSK,"UTIL",TMP,PTAG)
134 ;
135 ;--- Date of Death
136 D:$$OPTCOL^RORXU006("DOD")
137 . S TMP=$$DATE^RORXU002(VADM(6)\1)
138 . D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
139 . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
140 . D INCSUM("DOD",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
141 Q 0
142 ;
143 ;***** GENERATES THE REPORT SUMMARY
144 ;
145 ; PARTAG Reference (IEN) to the parent tag
146 ;
147 ; PATIENTS Reference (IEN) to the PATIENTS tag
148 ;
149 ; Return Values:
150 ; <0 Error code
151 ; 0 Ok
152 ;
153SUMMARY(PARTAG,PATIENTS) ;
154 N AGE,I,RC,RORBUF,SI,SUMMARY,TABLE,TAG,TMP
155 S SUMMARY=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PARTAG)
156 Q:SUMMARY<0 SUMMARY
157 ;
158 ;--- Risk factors
159 D:$D(RORRISK)>1
160 . K RORBUF D BLD^DIALOG(7980000.016,.RORRISK,,"RORBUF")
161 . D ADDTEXT^RORTSK11(RORTSK,"RISK_FACTORS",.RORBUF,SUMMARY)
162 ;
163 ;--- Simple summaries
164 F SI="RACE","ETHN","SEX" D:$D(RORSUM(SI))>1
165 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
166 . S I=""
167 . F S I=$O(RORSUM(SI,I)) Q:I="" D
168 . . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
169 . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
170 ;
171 ;--- Date summaries
172 F SI="DOB","DOD","CONFDT","SELDT" D:$D(RORSUM(SI))>1
173 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
174 . D:$G(RORSUM(SI,0))>0
175 . . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,"Before "_RORDTE0,TABLE)
176 . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,0))
177 . S I=0
178 . F S I=$O(RORSUM(SI,I)) Q:I="" D
179 . . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
180 . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
181 ;
182 ;--- Age summary
183 I $G(RORSUM("AGE"))>0 D
184 . ;--- Average age
185 . S TMP=$G(RORSUM("AGE","Average"))/RORSUM("AGE")
186 . S RORSUM("AGE","Average")=$J(TMP,0,2)
187 . ;--- Median age
188 . S TMP=$$XREFNODE^RORTSK10(RORTSK,PATIENTS,"AGE")
189 . S:TMP'="" TMP=$$XREFMDNV^RORXU004(TMP,RORSUM("AGE"))
190 . S RORSUM("AGE","Median")=$S(TMP'="":$J(TMP,0,2),1:"")
191 . ;--- Output the table
192 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"AGE_SUMMARY",,SUMMARY)
193 . S I=""
194 . F S I=$O(RORSUM("AGE",I)) Q:I="" D
195 . . S TAG=$$ADDVAL^RORTSK11(RORTSK,"AGE",$S(+I=I:I_"+",1:I),TABLE)
196 . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM("AGE",I))
197 ;
198 ;--- Utilization codes
199 D:$D(RORUCNT)>1
200 . K RORBUF D BLD^DIALOG(7980000.017,.RORUCNT,,"RORBUF")
201 . D ADDTEXT^RORTSK11(RORTSK,"UTIL_CODES",.RORBUF,SUMMARY)
202 ;---
203 Q 0
204 ;
205 ;***** PROCESSES UTILIZATION CODES
206UTLCODES(UCSRC) ;
207 N I,UCLST S UCLST=""
208 F I=1:1 S UC=$P(UCSRC,U,I) Q:UC="" D
209 . S UCLST=UCLST_", "_UC,RORUCNT(UC)=$G(RORUCNT(UC))+1
210 Q $P(UCLST,", ",2,999)
Note: See TracBrowser for help on using the repository browser.