source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX010.m@ 1535

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1RORX010 ;HCIOFO/SG - LAB TESTS BY RANGE REPORT ; 12/8/05 10:39am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10061 DEM^VADPT (supported)
7 ;
8 Q
9 ;
10 ;***** OUTPUTS THE REPORT HEADER
11 ;
12 ; PARTAG Reference (IEN) to the parent tag
13 ;
14 ; Return Values:
15 ; <0 Error code
16 ; 0 Ok
17 ;
18HEADER(PARTAG) ;
19 ;;PATIENTS(#,NAME,LAST4,DOD,PTLRL(GROUP,DATE,NAME,RESULT))
20 ;
21 N COLUMNS,HEADER,LT,NAME,TMP
22 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
23 Q:HEADER<0 HEADER
24 S RC=$$TBLDEF^RORXU002("HEADER^RORX010",HEADER)
25 Q $S(RC<0:RC,1:HEADER)
26 ;
27 ;***** COMPILES THE LAB TESTS BY RANGE REPORT
28 ; REPORT CODE: 010
29 ;
30 ; .RORTSK Task number and task parameters
31 ;
32 ; The ^TMP("RORX010",$J) global node is used by this function.
33 ;
34 ; Return Values:
35 ; <0 Error code
36 ; 0 Ok
37 ;
38LRGRANGE(RORTSK) ;
39 N RORDST ; Callback descriptor
40 N ROREDT ; End date
41 N ROREDT1 ; End date + 1 day
42 N RORLTL ; Closed root of the list of lab tests to search for
43 N RORREG ; Registry IEN
44 N RORSDT ; Start date
45 ;
46 N BODY,CNT,ECNT,IEN,IENS,LRGLST,RC,REPORT,RORPTN,SFLAGS,TMP
47 ;--- Root node of the report
48 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
49 Q:REPORT<0 REPORT
50 ;
51 ;--- Get and prepare the report parameters
52 S RORREG=+$$PARAM^RORTSK01("REGIEN")
53 S RC=$$PARAMS(REPORT,.SFLAGS,.LRGLST) Q:RC<0 RC
54 ;
55 ;--- Initialize constants and variables
56 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
57 S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1),ECNT=0
58 K ^TMP("RORX010",$J)
59 S RORLTL=$$ALLOC^RORTMP()
60 ;
61 ;--- Prepare the search parameters
62 S RORDST=$NA(^TMP("RORX010",$J))
63 S RORDST("RORCB")="$$LTCB^RORX010"
64 S RC=$$LOADTSTS^RORUTL10(RORLTL,+RORREG,LRGLST)
65 ;
66 ;--- Report header and list of patients
67 S RC=$$HEADER(REPORT) G:RC<0 ERROR
68 S BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
69 I BODY<0 S RC=+BODY G ERROR
70 D ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
71 ;
72 ;--- Browse through the registry records
73 S (CNT,IEN,RC)=0
74 F S IEN=$O(^RORDATA(798,"AC",RORREG,IEN)) Q:IEN'>0 D Q:RC<0
75 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
76 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
77 . S IENS=IEN_",",CNT=CNT+1
78 . ;--- Check if the patient should be skipped
79 . Q:$$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
80 . ;--- Process the registry record
81 . I $$PATIENT(IENS,BODY)<0 S ECNT=ECNT+1 Q
82 ;
83ERROR ;--- Cleanup
84 D FREE^RORTMP(RORLTL)
85 K ^TMP("RORX010",$J)
86 Q $S(RC<0:RC,ECNT>0:-43,1:0)
87 ;
88 ;***** CALLBACK FUNCTION FOR LAB DATA SEARCH
89LTCB(RORDST,INVDT,RESULT) ;
90 N GRP,NODE,RC,VAL
91 S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
92 S GRP=+$P($G(RESULT(2)),U,3)
93 ;--- Check the result range if necessary
94 I $D(@NODE@(GRP))>1 S RC=1 D Q:RC RC
95 . S VAL=$$CLRNMVAL^RORUTL18($P($G(RESULT(1)),U,3))
96 . ;--- Skip a non-numeric result
97 . Q:'$$NUMERIC^RORUTL05(VAL)
98 . ;--- Check the range
99 . I $G(@NODE@(GRP,"L"))'="" Q:VAL<@NODE@(GRP,"L")
100 . I $G(@NODE@(GRP,"H"))'="" Q:VAL>@NODE@(GRP,"H")
101 . S RC=0
102 ;--- Store the result
103 K RORDST("GRP",GRP)
104 S RORDST("RORPTR")=$G(RORDST("RORPTR"))+1
105 M @RORDST@(RORDST("RORPTR"))=RESULT
106 Q 0
107 ;
108 ;***** OUTPUTS THE REPORT PARAMETERS
109 ;
110 ; PARTAG Reference (IEN) to the parent tag
111 ;
112 ; .FLAGS Flags for the $$SKIP^RORXU005 are
113 ; returned via this parameter
114 ;
115 ; .LRGLST List of lab group codes for the $$LOADTSTS^RORUTL10
116 ;
117 ; Return Values:
118 ; <0 Error code
119 ; 0 Ok
120 ;
121PARAMS(PARTAG,FLAGS,LRGLST) ;
122 N PARAMS,TMP
123 S (FLAGS,LRGLST)=""
124 S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.RORSDT,.ROREDT,.FLAGS)
125 Q:PARAMS<0 PARAMS
126 ;--- Lab test ranges
127 I $D(RORTSK("PARAMS","LRGRANGES","C"))>1 D Q:RC<0 RC
128 . N GRC,ELEMENT,NODE,LRGELMTS,RANGE
129 . S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
130 . S LRGELMTS=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARAMS)
131 . S (GRC,RC)=0
132 . F S GRC=$O(@NODE@(GRC)) Q:GRC'>0 D Q:RC<0
133 . . S RANGE=0,TMP=$$RANGE(GRC)
134 . . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",TMP,LRGELMTS)
135 . . I ELEMENT<0 S RC=ELEMENT Q
136 . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",GRC)
137 . . S LRGLST=LRGLST_$S(LRGLST'="":","_GRC,1:GRC)
138 . . ;--- Process the range values
139 . . S TMP=$G(@NODE@(GRC,"L"))
140 . . I TMP'="" D S RANGE=1
141 . . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP)
142 . . S TMP=$G(@NODE@(GRC,"H"))
143 . . I TMP'="" D S RANGE=1
144 . . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP)
145 . . D:RANGE ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
146 ;--- Success
147 Q PARAMS
148 ;
149 ;***** ADDS THE PATIENT DATA TO THE REPORT
150 ;
151 ; IENS IENS of the patient's record in the registry
152 ; PARTAG Reference (IEN) to the parent tag
153 ;
154 ; Return Values:
155 ; <0 Error code
156 ; 0 Ok
157 ;
158PATIENT(IENS,PARTAG) ;
159 N DFN,I,LABTESTS,LT,NAME,RC,RORBUF,RORMSG,TMP,VA,VADM
160 ;--- Get the data from the ROR REGISTRY RECORD file
161 D GETS^DIQ(798,IENS,".01","I","RORBUF","RORMSG")
162 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
163 S DFN=$G(RORBUF(798,IENS,.01,"I"))
164 ;--- Search for the lab results
165 K @RORDST,RORDST("RORPTR")
166 M RORDST("GRP")=RORTSK("PARAMS","LRGRANGES","C")
167 S RC=$$LTSEARCH^RORUTL10(DFN,RORLTL,.RORDST,,RORSDT,ROREDT1)
168 Q:RC'>0 RC
169 ;--- Results from all groups should be present
170 Q:$D(RORDST("GRP"))>1 0
171 ;--- Load the demographic data
172 D VADEM^RORUTL05(DFN,1)
173 ;--- The <PATIENT> tag
174 S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
175 Q:PTAG<0 PTAG
176 ;--- Patient Name
177 D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
178 ;--- Last 4 digits of the SSN
179 D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
180 ;--- Date of death
181 S TMP=$$DATE^RORXU002($P(VADM(6),U)\1)
182 D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
183 ;--- Lab results
184 S LABTESTS=$$ADDVAL^RORTSK11(RORTSK,"PTLRL",,PTAG)
185 S I=""
186 F S I=$O(@RORDST@(I)) Q:I="" D
187 . S LT=$$ADDVAL^RORTSK11(RORTSK,"LT",,LABTESTS)
188 . D ADDVAL^RORTSK11(RORTSK,"GROUP",$P(@RORDST@(I,2),U,4),LT,1)
189 . D ADDVAL^RORTSK11(RORTSK,"DATE",$P(@RORDST@(I,1),U,2),LT,1)
190 . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(@RORDST@(I,2),U,2),LT,1)
191 . D ADDVAL^RORTSK11(RORTSK,"RESULT",$P(@RORDST@(I,1),U,3),LT,3)
192 ;---
193 Q $S(RC<0:RC,1:0)
194 ;
195 ;***** PROCESSES THE RESULT RANGE OPTIONS
196 ;
197 ; GRC Code of a Lab Group
198 ;
199 ; Return Values:
200 ; Description of the Lab results to be included in the report.
201 ;
202RANGE(GRC) ;
203 N RANGE,TMP
204 S RANGE=""
205 ;--- Range
206 D:$D(RORTSK("PARAMS","LRGRANGES","C",GRC))>1
207 . ;--- Low
208 . S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC,"L"))
209 . S:TMP'="" RANGE=RANGE_" not less than "_TMP
210 . ;--- High
211 . S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC,"H"))
212 . I TMP'="" D:RANGE'="" S RANGE=RANGE_" not greater than "_TMP
213 . . S RANGE=RANGE_" and"
214 ;--- Description
215 S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC))
216 S:TMP="" TMP="Unknown ("_GRC_")"
217 Q TMP_" - "_$S(RANGE'="":"numeric results"_RANGE,1:"all results")
Note: See TracBrowser for help on using the repository browser.