source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORXU006.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: 7.0 KB
Line 
1RORXU006 ;HCIOFO/SG - REPORT PARAMETERS ; 6/21/06 1:41pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #91 Read access to the file #60 (controlled)
7 ; #2438 The .01 field of file #40.8 (controlled)
8 ; #2947 ATESTS^ORWLRR (controlled)
9 ; #10035 Direct read of DOD field of file #2 (supported)
10 ; #10040 Read access to HOSPITAL LOCATION file (suppotted)
11 ;
12 Q
13 ;
14 ;***** PROCESSES THE LIST OF CLINICS
15 ;
16 ; .RORTSK Task number and task parameters
17 ;
18 ; PARTAG Reference (IEN) to the parent tag
19 ;
20 ; Return Values:
21 ; <0 Error code
22 ; >0 IEN of the CLINICS element
23 ;
24CLINLST(RORTSK,PARTAG) ;
25 N IEN,LTAG,RORMSG,TMP
26 I $D(RORTSK("PARAMS","CLINICS","C"))>1 D
27 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CLINICS",,PARTAG) Q:LTAG'>0
28 . S IEN=0
29 . F S IEN=$O(RORTSK("PARAMS","CLINICS","C",IEN)) Q:IEN'>0 D
30 . . S TMP=$$GET1^DIQ(44,IEN_",",.01,,,"RORMSG")
31 . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,44,IEN_",")
32 . . Q:TMP=""
33 . . D ADDVAL^RORTSK11(RORTSK,"CLINIC",TMP,LTAG,,IEN)
34 E D:$$PARAM^RORTSK01("CLINICS","ALL")
35 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CLINICS","ALL",PARTAG)
36 Q +$G(LTAG)
37 ;
38 ;***** PROCESSES THE LIST OF CPT CODES
39 ;
40 ; .RORTSK Task number and task parameters
41 ;
42 ; PARTAG Reference (IEN) to the parent tag
43 ;
44 ; Return Values:
45 ; <0 Error code
46 ; >0 IEN of the CPTLST element
47 ;
48CPTLST(RORTSK,PARTAG) ;
49 N CPT,IEN,LTAG,TMP
50 I $D(RORTSK("PARAMS","CPTLST","C"))>1 D
51 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CPTLST",,PARTAG) Q:LTAG'>0
52 . S IEN=0
53 . F S IEN=$O(RORTSK("PARAMS","CPTLST","C",IEN)) Q:IEN'>0 D
54 . . S CPT=$P(RORTSK("PARAMS","CPTLST","C",IEN),U) Q:CPT=""
55 . . D ADDVAL^RORTSK11(RORTSK,"CPT",CPT,LTAG,,IEN)
56 E D:$$PARAM^RORTSK01("CPTLST","ALL")
57 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CPTLST","ALL",PARTAG)
58 Q +$G(LTAG)
59 ;
60 ;***** PROCESSES THE LIST OF DIVISIONS
61 ;
62 ; .RORTSK Task number and task parameters
63 ;
64 ; PARTAG Reference (IEN) to the parent tag
65 ;
66 ; Return Values:
67 ; <0 Error code
68 ; >0 IEN of the DIVISIONS element
69 ;
70DIVLST(RORTSK,PARTAG) ;
71 N IEN,LTAG,RORMSG,TMP
72 I $D(RORTSK("PARAMS","DIVISIONS","C"))>1 D
73 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DIVISIONS",,PARTAG) Q:LTAG'>0
74 . S IEN=0
75 . F S IEN=$O(RORTSK("PARAMS","DIVISIONS","C",IEN)) Q:IEN'>0 D
76 . . S TMP=$$GET1^DIQ(40.8,IEN_",",.01,,,"RORMSG")
77 . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,40.8,IEN_",")
78 . . Q:TMP=""
79 . . D ADDVAL^RORTSK11(RORTSK,"DIVISION",TMP,LTAG,,IEN)
80 E D:$$PARAM^RORTSK01("DIVISIONS","ALL")
81 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DIVISIONS","ALL",PARTAG)
82 Q +$G(LTAG)
83 ;
84 ;***** PROCESSES THE LIST OF LAB TESTS
85 ;
86 ; .RORTSK Task number and task parameters
87 ;
88 ; PARTAG Reference (IEN) to the parent tag
89 ;
90 ;
91 ; .ROR8LST Reference to a local variable, which contains a
92 ; closed root of an array. Descriptors of selected
93 ; lab tests will be returned into this array.
94 ;
95 ; @ROR8LTST@(ResultNode,TestIEN)
96 ; ^01: Test IEN (in file #60)
97 ; ^02: Test name
98 ; ^03: 99
99 ; ^04: "Other"
100 ; ^05: Location subscript
101 ; ^06: Result node
102 ;
103 ; If this parameter is undefined or empty, then a
104 ; temporary buffer is allocated by the $$ALLOC^RORTMP
105 ; function and its root is returned via this parameter.
106 ;
107 ; If all drugs are requested (the "ALL" attribute of
108 ; the "DRUGS" tag), then "*" is returned.
109 ;
110 ; [ROR8LRG] Closed root of a node where the lab tests with
111 ; defined range values will be returned. By default
112 ; ($G(ROR8LRG)=""), this list is not compiled.
113 ;
114 ; @ROR8LRG@(TestIEN,
115 ; "H") = Low
116 ; "L") = High
117 ;
118 ; "H", "L", or both will be defined.
119 ;
120 ; If the source list contains lab test panels, all corresponding
121 ; lab tests are added to the @ROR8LST array but only a single tag
122 ; is added to the XML list.
123 ;
124 ; Return Values:
125 ; <0 Error code
126 ; >0 IEN of the LABTESTS element
127 ;
128LTLST(RORTSK,PARTAG,ROR8LST,ROR8LRG) ;
129 N ALL,BUF,I,LTAG,LTIEN,LTOPTS,TMP
130 S ALL=+$$PARAM^RORTSK01("LABTESTS","ALL")
131 S (LTAG,RC)=0
132 ;
133 ;=== Validate parameters
134 I 'ALL D K @ROR8LST
135 . S:$G(ROR8LST)="" ROR8LST=$$ALLOC^RORTMP()
136 E S ROR8LST="*"
137 ;
138 ;=== Process the drug options (if present)
139 M LTOPTS=RORTSK("PARAMS","LABTESTS","A")
140 I $D(LTOPTS)>1 D Q:LTAG'>0 LTAG
141 . N ATTR,REGIEN
142 . S ATTR=$S(ALL:"ALL",1:"")
143 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",ATTR,PARTAG)
144 . Q:LTAG'>0
145 . ;--- Output option attributes
146 . S ATTR="",RC=0
147 . F S ATTR=$O(LTOPTS(ATTR)) Q:ATTR="" D Q:RC<0
148 . . S RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
149 . I RC<0 S LTAG=RC Q
150 . S ATTR=$$OPTXT^RORXU002(.LTOPTS)
151 . D:ATTR'="" ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
152 ;
153 ;=== Process the list of tests (if present)
154 I 'ALL,$D(RORTSK("PARAMS","LABTESTS","C"))>1 D
155 . I LTAG'>0 D Q:LTAG'>0
156 . . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,PARTAG)
157 . S LTIEN=0
158 . F S LTIEN=$O(RORTSK("PARAMS","LABTESTS","C",LTIEN)) Q:LTIEN'>0 D
159 . . D LTLSTI(LTIEN,LTAG)
160 ;
161 Q $S(RC<0:RC,1:LTAG)
162 ;
163 ;***** CREATES THE LAB TEST ITEM(S)
164 ;
165 ; LTIEN IEN of the lab test in the file #60
166 ; [LTAG] IEN of the parent tag
167 ;
168 ; This is an internal entry point. Do NOT call it directly.
169 ;
170LTLSTI(LTIEN,LTAG) ;
171 N BUF,I,IENS,ITEM,LTNAME,LTNODE,PLTCNT,RORBUF,RORMSG,TMP
172 ;--- Load the lab test parameters
173 S IENS=LTIEN_","
174 D GETS^DIQ(60,IENS,".01;5","EI","RORBUF","RORMSG")
175 D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,60,IENS)
176 S LTNAME=$G(RORBUF(60,IENS,.01,"E")) Q:LTNAME=""
177 ;--- Output the tag and update the list of ranges
178 D:$G(LTAG)>0
179 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",LTNAME,LTAG,,LTIEN)
180 . S TMP=$$UP^XLFSTR($G(RORTSK("PARAMS","LABTESTS","C",LTIEN,"L")))
181 . D:TMP'=""
182 . . D ADDATTR^RORTSK11(RORTSK,ITEM,"LOW",TMP)
183 . . S:$G(ROR8LRG)'="" @ROR8LRG@(LTIEN,"L")=TMP
184 . S TMP=$$UP^XLFSTR($G(RORTSK("PARAMS","LABTESTS","C",LTIEN,"H")))
185 . D:TMP'=""
186 . . D ADDATTR^RORTSK11(RORTSK,ITEM,"HIGH",TMP)
187 . . S:$G(ROR8LRG)'="" @ROR8LRG@(LTIEN,"H")=TMP
188 ;--- Process the panel
189 D ATESTS^ORWLRR(.BUF,LTIEN)
190 I $D(BUF)>1 S I="",PLTCNT=0 D Q:PLTCNT>1
191 . F S I=$O(BUF(I)) Q:I="" D
192 . . S TMP=+$P(BUF(I),U),PLTCNT=PLTCNT+1
193 . . D:TMP'=LTIEN LTLSTI(TMP)
194 ;--- Create the reference
195 S LTNODE=$P($G(RORBUF(60,IENS,5,"I")),";",2) Q:LTNODE=""
196 S BUF=LTIEN_U_LTNAME_U_"99^Other"
197 S $P(BUF,U,5)=$P(RORBUF(60,IENS,5,"I"),";") ; Subscript
198 S $P(BUF,U,6)=LTNODE ; Result node
199 S @ROR8LST@(LTNODE,LTIEN)=BUF
200 Q
201 ;
202 ;***** CHECKS IF THE OPTIONAL COLUMN IS SELECTED
203 ;
204 ; NAME Column name
205 ;
206 ; Return Values:
207 ; 0 Skip the field
208 ; >0 Include in report
209 ;
210OPTCOL(NAME) ;
211 Q $S($G(NAME)'="":$D(RORTSK("PARAMS","OPTIONAL_COLUMNS","C",NAME)),1:0)
212 ;
213 ;***** CHECK IF ONLY THE SUMMARY SHOULD BE GENERATED
214SMRYONLY() ;
215 Q:$$PARAM^RORTSK01("MAXUTNUM")'="" 0
216 Q:$$PARAM^RORTSK01("MINRPNUM")'="" 0
217 Q 1
Note: See TracBrowser for help on using the repository browser.