source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORXU007.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.5 KB
Line 
1RORXU007 ;HCIOFO/SG - PHARMACY-RELATED REPORT PARAMETERS ; 11/25/05 6:00pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #4533 ZERO^PSS50 (supported)
7 ; #4540 ZERO^PSN50P6 (supported)
8 ; #4543 IEN^PSN50P65 (supported)
9 ;
10 Q
11 ;
12 ;***** PROCESSES THE "DRUGS" REPORT PARAMETER
13 ;
14 ; .RORTSK Task number and task parameters
15 ;
16 ; PARTAG Reference (IEN) to the parent tag
17 ;
18 ; .ROR8LST Reference to a local variable, which contains a
19 ; closed root of an array. IEN's of dispensed drugs
20 ; will be returned into this array.
21 ;
22 ; @ROR8LTST@(DrugIEN,Group#) = ""
23 ;
24 ; If this parameter is undefined or empty, then a
25 ; temporary buffer is allocated by the $$ALLOC^RORTMP
26 ; function and its root is returned via this parameter.
27 ;
28 ; If all drugs are requested (the "ALL" attribute of
29 ; the "DRUGS" tag), then "*" is returned.
30 ;
31 ; [.GRPLST] Reference to a local variable that will contain
32 ; the list of drug groups.
33 ;
34 ; GRPLST(
35 ; "C",Group#) = GroupName
36 ; "N",GroupName) = Group#
37 ;
38 ; Return Values:
39 ; <0 Error code
40 ; >0 IEN of the DRUGS element
41 ;
42DRUGLST(RORTSK,PARTAG,ROR8LST,GRPLST) ;
43 N LTAG,RC,RXALL,RXOPTS,TMP
44 S RXALL=+$$PARAM^RORTSK01("DRUGS","ALL")
45 S (LTAG,RC)=0
46 ;
47 ;=== Validate parameters
48 I RXALL D S ROR8LST="*"
49 . F TMP="INVESTIG","REGMDES" K RORTSK("PARAMS","DRUGS","A",TMP)
50 E D K @ROR8LST
51 . S:$G(ROR8LST)="" ROR8LST=$$ALLOC^RORTMP()
52 . ;--- Aggregate by individual formulations if investigational
53 . ;--- medications are selected (they are not linked to generics)
54 . D:$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
55 . . N GRPNAME,INV,NODE
56 . . I '$$PARAM^RORTSK01("DRUGS","INVESTIG") S INV=0 D Q:'INV
57 . . . S NODE=$NA(RORTSK("PARAMS","DRUGS","G"))
58 . . . S GRPNAME=""
59 . . . F S GRPNAME=$O(@NODE@(GRPNAME)) Q:GRPNAME="" D Q:INV
60 . . . . S:$G(@NODE@(GRPNAME,"A","INVESTIG")) INV=1
61 . . K RORTSK("PARAMS","DRUGS","A","AGGR_GENERIC")
62 . . S RORTSK("PARAMS","DRUGS","A","AGGR_FORMUL")=1
63 . . S RORTSK("PARAMS","DRUGS","A","AGGR_FORCED")=1
64 ;
65 ;=== Process the drug options (if present)
66 M RXOPTS=RORTSK("PARAMS","DRUGS","A")
67 I $D(RXOPTS)>1 D Q:LTAG'>0 LTAG
68 . N ATTR,REGIEN
69 . S ATTR=$S(RXALL:"ALL",1:"")
70 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",ATTR,PARTAG)
71 . Q:LTAG'>0
72 . ;--- Output option attributes
73 . S ATTR="",RC=0
74 . F S ATTR=$O(RXOPTS(ATTR)) Q:ATTR="" D Q:RC<0
75 . . S RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
76 . I RC<0 S LTAG=RC Q
77 . S ATTR=$$OPTXT^RORXU002(.RXOPTS)
78 . D:ATTR'="" ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
79 . ;--- Add registry-specific and/or investigational drugs
80 . Q:RXALL
81 . S REGIEN=+$$PARAM^RORTSK01("REGIEN"),TMP="AR"
82 . S:$G(RXOPTS("INVESTIG")) TMP=TMP_"C"
83 . S:$G(RXOPTS("REGMEDS")) TMP=TMP_"DG"
84 . S RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP)
85 ;
86 ;=== Process the list of drugs (if present)
87 I 'RXALL D:$D(RORTSK("PARAMS","DRUGS","G"))>1
88 . N GRPNAME,GRPTAG,IG,NODE
89 . I LTAG'>0 D Q:LTAG'>0
90 . . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,PARTAG)
91 . ;---
92 . S NODE=$NA(RORTSK("PARAMS","DRUGS","G"))
93 . S GRPNAME="",RC=0
94 . F S GRPNAME=$O(@NODE@(GRPNAME)) Q:GRPNAME="" D Q:RC<0
95 . . S IG=$O(GRPLST("C",""),-1)+1
96 . . S GRPLST("C",IG)=GRPNAME,GRPLST("N",GRPNAME)=IG
97 . . S GRPTAG=$$DRUGLST1(LTAG,GRPNAME,IG)
98 . . I GRPTAG'>0 S RC=GRPTAG Q
99 . . ;--- Individual Formulations
100 . . S RC=$$DRUGLSTF(GRPTAG,GRPNAME,IG) Q:RC<0
101 . . ;--- Generic Names
102 . . S RC=$$DRUGLSTG(GRPTAG,GRPNAME,IG) Q:RC<0
103 . . ;--- Drug Classes
104 . . S RC=$$DRUGLSTC(GRPTAG,GRPNAME,IG) Q:RC<0
105 ;
106 ;===
107 Q $S(RC<0:RC,1:LTAG)
108 ;
109 ;***** PROCESS THE GROUP ATTRIBUTES
110 ;
111 ; PTAG Reference (IEN) to the parent tag
112 ; GRPNAME Group Name
113 ; GRPCODE Group Code (sequential number)
114 ;
115 ; Return Values:
116 ; <0 Error code
117 ; >0 IEN of the GROUP element
118 ;
119DRUGLST1(PTAG,GRPNAME,GRPCODE) ;
120 N GRPOPTS,GRPTAG,RC,TMP
121 ;--- Create the group tag
122 S GRPTAG=$$ADDVAL^RORTSK11(RORTSK,"GROUP",,PTAG)
123 Q:GRPTAG'>0 GRPTAG
124 D ADDATTR^RORTSK11(RORTSK,GRPTAG,"NAME",GRPNAME)
125 ;--- Process the group attributes
126 M GRPOPTS=RORTSK("PARAMS","DRUGS","G",GRPNAME,"A")
127 I $D(GRPOPTS)>1 S RC=0 D Q:RC<0 RC
128 . N ATTR,REGIEN S ATTR=""
129 . F S ATTR=$O(GRPOPTS(ATTR)) Q:ATTR="" D Q:RC<0
130 . . S RC=$$ADDATTR^RORTSK11(RORTSK,GRPTAG,ATTR,"1")
131 . Q:RC<0
132 . S TMP=$$OPTXT^RORXU002(.GRPOPTS)
133 . D:TMP'="" ADDATTR^RORTSK11(RORTSK,GRPTAG,"DESCR",TMP)
134 . ;--- Add registry-specific and/or investigational drugs
135 . S REGIEN=+$$PARAM^RORTSK01("REGIEN"),TMP="AR"
136 . S:$G(GRPOPTS("INVESTIG")) TMP=TMP_"C"
137 . S:$G(GRPOPTS("REGMEDS")) TMP=TMP_"DG"
138 . S RC=$$DRUGLIST^RORUTL16(ROR8LST,REGIEN,TMP,GRPCODE)
139 ;---
140 Q GRPTAG
141 ;
142 ;***** PROCESS DRUG CLASSES
143 ;
144 ; PTAG Reference (IEN) to the parent tag
145 ; GRPNAME Group Name
146 ; GRPCODE Group Code (sequential number)
147 ;
148 ; Return Values:
149 ; <0 Error code
150 ; >0 IEN of the VARXCLS element
151 ;
152DRUGLSTC(PTAG,GRPNAME,GRPCODE) ;
153 N CODE,IEN,LTAG,NODE,RORTMP,SUBS
154 S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"VARXCLS"))
155 Q:$D(@NODE)<10 0
156 S LTAG=$$ADDVAL^RORTSK11(RORTSK,"VARXCLS",,PTAG)
157 Q:LTAG<0 LTAG
158 ;---
159 S RORTMP=$$ALLOC^RORTMP(.SUBS)
160 S IEN=0
161 F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
162 . D IEN^PSN50P65(IEN,,SUBS)
163 . S CODE=$G(@RORTMP@(IEN,.01)) Q:CODE=""
164 . D ADDVAL^RORTSK11(RORTSK,"VARXCL",CODE,LTAG,,IEN)
165 . D RXADDVCL^RORUTL16(ROR8LST,IEN,1,GRPCODE)
166 D FREE^RORTMP(RORTMP)
167 ;---
168 Q LTAG
169 ;
170 ;***** PROCESS INDIVIDUAL FORMULATIONS
171 ;
172 ; PTAG Reference (IEN) to the parent tag
173 ; GRPNAME Group Name
174 ; GRPCODE Group Code (sequential number)
175 ;
176 ; Return Values:
177 ; <0 Error code
178 ; >0 IEN of the FORMULATIONS element
179 ;
180DRUGLSTF(PTAG,GRPNAME,GRPCODE) ;
181 N IEN,LTAG,NAME,NODE,RORTMP,SUBS
182 S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"FORMULATIONS"))
183 Q:$D(@NODE)<10 0
184 S LTAG=$$ADDVAL^RORTSK11(RORTSK,"FORMULATIONS",,PTAG)
185 Q:LTAG<0 LTAG
186 ;---
187 S RORTMP=$$ALLOC^RORTMP(.SUBS)
188 S IEN=0
189 F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
190 . D ZERO^PSS50(IEN,,,,,SUBS)
191 . S NAME=$G(@RORTMP@(IEN,.01)) Q:NAME=""
192 . D ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
193 . S @ROR8LST@(IEN,GRPCODE)=""
194 D FREE^RORTMP(RORTMP)
195 ;---
196 Q LTAG
197 ;
198 ;***** PROCESS GENERIC NAMES
199 ;
200 ; PTAG Reference (IEN) to the parent tag
201 ; GRPNAME Group Name
202 ; GRPCODE Group Code (sequential number)
203 ;
204 ; Return Values:
205 ; <0 Error code
206 ; >0 IEN of the GENERIC element
207 ;
208DRUGLSTG(PTAG,GRPNAME,GRPCODE) ;
209 N IEN,LTAG,NAME,NODE,RORTMP,SUBS
210 S NODE=$NA(RORTSK("PARAMS","DRUGS","G",GRPNAME,"GENERIC"))
211 Q:$D(@NODE)<10 0
212 S LTAG=$$ADDVAL^RORTSK11(RORTSK,"GENERIC",,PTAG)
213 Q:LTAG<0 LTAG
214 ;---
215 S RORTMP=$$ALLOC^RORTMP(.SUBS)
216 S IEN=0
217 F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
218 . D ZERO^PSN50P6(IEN,,,,SUBS)
219 . S NAME=$G(@RORTMP@(IEN,.01)) Q:NAME=""
220 . D ADDVAL^RORTSK11(RORTSK,"DRUG",NAME,LTAG,,IEN)
221 . D RXADDGEN^RORUTL16(ROR8LST,IEN,1,GRPCODE)
222 D FREE^RORTMP(RORTMP)
223 ;---
224 Q LTAG
225 ;
226 ;***** FUNCTION FOR THE PHARMACY SEARCH API
227 ;
228 ; .RORDST Reference to the search descriptor
229 ; DRUGIEN IEN of an individual formulation (dispensed drug)
230 ; ROR8LST Closed root of the drug list generated by the
231 ; $$DRUGLST^RORXU007 function or "*" for all drugs.
232 ;
233 ; Return Values:
234 ; 0 Ok
235 ; 1 Skip the record
236 ;
237RXGRPCHK(RORDST,DRUGIEN,ROR8LST) ;
238 Q:ROR8LST="*" 0
239 Q:$D(@ROR8LST@(DRUGIEN))<10 1
240 N GRP S GRP=""
241 F S GRP=$O(@ROR8LST@(DRUGIEN,GRP)) Q:GRP="" D
242 . K RORDST("RORXGRP",GRP)
243 Q 0
Note: See TracBrowser for help on using the repository browser.