source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX011.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1RORX011 ;HCIOFO/SG - PATIENT MEDICATION HISTORY ; 6/22/06 10:56am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 Q
5 ;
6 ;***** OUTPUTS THE REPORT HEADER
7 ;
8 ; PARTAG Reference (IEN) to the parent tag
9 ;
10 ; Return Values:
11 ; <0 Error code
12 ; >0 IEN of the HEADER element
13 ;
14HEADER(PARTAG) ;
15 ;;PATIENTS(#,NAME,LAST4,DOB,AGE,DOD)
16 ;;PTRXL(DATE,ORDER,TYPE,NAME,GENERIC,DAYSPLY,FILLTYPE)
17 ;
18 N HEADER,NOTES,RC
19 S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
20 Q:HEADER<0 HEADER
21 S NOTES=$$ADDVAL^RORTSK11(RORTSK,"NOTES",,HEADER)
22 D ADDVAL^RORTSK11(RORTSK,"AGE",$$DT^XLFDT,NOTES)
23 S RC=$$TBLDEF^RORXU002("HEADER^RORX011",HEADER)
24 Q $S(RC<0:RC,1:HEADER)
25 ;
26 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
27 ;
28 ; PARTAG Reference (IEN) to the parent tag
29 ;
30 ; [.STDT] Start and end dates of the report
31 ; [.ENDT] are returned via these parameters
32 ;
33 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
34 ; returned via this parameter
35 ;
36 ; Return Values:
37 ; <0 Error code
38 ; >0 IEN of the PARAMETERS element
39 ;
40PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
41 N PARAMS,TMP
42 S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
43 Q:PARAMS<0 PARAMS
44 ;--- Process the drug list and options
45 S TMP=$$DRUGLST^RORXU007(.RORTSK,PARAMS,.RORXL,.RORXGRP)
46 Q:TMP<0 TMP
47 ;---
48 Q PARAMS
49 ;
50 ;***** PROCESS THE PATIENT'S DATA
51 ;
52 ; PTLIST Reference (IEN) to the parent tag
53 ; PATIEN Patient IEN in the file #2 (DFN)
54 ;
55 ; Return Values:
56 ; <0 Error code
57 ; 0 Ok
58 ; >0 Number of non-fatal errors
59 ;
60PATIENT(PTLIST,PATIEN) ;
61 N BUF,FLT,FLTL,FQL,ITEM,NODE,PTAG,QSB,RC,TABLE,VA,VADM,VAERR
62 S (ECNT,RC)=0
63 ;--- Patient data
64 S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLIST,,PATIEN)
65 Q:PTAG<0 PTAG
66 D VADEM^RORUTL05(PATIEN,1)
67 D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
68 D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
69 D ADDVAL^RORTSK11(RORTSK,"DOB",$$DATE^RORXU002(VADM(3)\1),PTAG,1)
70 D ADDVAL^RORTSK11(RORTSK,"AGE",VADM(4),PTAG,3)
71 D ADDVAL^RORTSK11(RORTSK,"DOD",$$DATE^RORXU002(VADM(6)\1),PTAG,1)
72 ;--- List of drugs
73 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PTRXL",,PTAG)
74 Q:TABLE<0 TABLE
75 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PTRXL")
76 ;---
77 S NODE=RORXDST,FLTL=$L(NODE)-1,FLT=$E(NODE,1,FLTL)
78 S QSB=$QL(NODE),FQL=QSB+5
79 F S NODE=$Q(@NODE) Q:$E(NODE,1,FLTL)'=FLT D:$QL(NODE)=FQL
80 . ; NODE: @RORXDST@(DATE,DRUGNAME,DRUGIEN,RXNUM,RXCNT)
81 . S BUF=@NODE
82 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
83 . D ADDVAL^RORTSK11(RORTSK,"DATE",$QS(NODE,QSB+1)\1,ITEM,1)
84 . D ADDVAL^RORTSK11(RORTSK,"ORDER",$QS(NODE,QSB+4),ITEM,1)
85 . S TMP=$P(BUF,U)
86 . S TMP=$S(TMP="O":"ORIGINAL",TMP="P":"PARTIAL",TMP="R":"REFILL",1:"")
87 . D ADDVAL^RORTSK11(RORTSK,"TYPE",TMP,ITEM,1)
88 . D ADDVAL^RORTSK11(RORTSK,"NAME",$QS(NODE,QSB+2),ITEM,1)
89 . D ADDVAL^RORTSK11(RORTSK,"GENERIC",$P(BUF,U,4),ITEM,1)
90 . D ADDVAL^RORTSK11(RORTSK,"DAYSPLY",$P(BUF,U,5),ITEM,1)
91 . S TMP=$P(BUF,U,2)
92 . S TMP=$S(TMP="I":"INPATIENT",TMP="M":"MAIL",TMP="W":"WINDOW",1:"")
93 . D ADDVAL^RORTSK11(RORTSK,"FILLTYPE",TMP,ITEM,1)
94 ;---
95 Q $S(RC<0:RC,1:ECNT)
96 ;
97 ;***** PROCESSES THE LIST OF PATIENTS
98 ;
99 ; REPORT Reference (IEN) to the parent tag
100 ;
101 ; Return Values:
102 ; <0 Error code
103 ; 0 Ok
104 ; >0 Number of non-fatal errors
105 ;
106PROCESS(REPORT,FLAGS) ;
107 N CNT,ECNT,IEN798,PTIEN,PTLIST,PTNODE,RC,RORPTN,RORXDST,RXFLAGS,TMP
108 S (CNT,ECNT,RC)=0
109 ;
110 ;--- Count patients in the list
111 I RORALL D S:RORPTN<0 RORPTN=0
112 . S PTNODE=$NA(^RORDATA(798,"ARP",RORREG_"#"))
113 . S RORPTN=$$REGSIZE^RORUTL02(+RORREG)
114 E S (PTIEN,RORPTN)=0 D Q:RORPTN'>0 0
115 . S PTNODE=$NA(RORTSK("PARAMS","PATIENTS","C"))
116 . F S PTIEN=$O(@PTNODE@(PTIEN)) Q:PTIEN'>0 S RORPTN=RORPTN+1
117 ;---
118 S PTLIST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
119 Q:PTLIST<0 PTLIST
120 ;
121 ;--- Prepare parameters for the pharmacy search API
122 S RORXDST=$NA(^TMP("RORX011",$J))
123 S RORXDST("RORCB")="$$RXSCB^RORX011"
124 S RXFLAGS="E"
125 S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") RXFLAGS=RXFLAGS_"IV"
126 S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") RXFLAGS=RXFLAGS_"O"
127 ;
128 ;--- Browse through the list of patients
129 S (CNT,PTIEN)=0
130 F S PTIEN=$O(@PTNODE@(PTIEN)) Q:PTIEN'>0 D Q:RC<0
131 . S RC=$$LOOP^RORTSK01(CNT/RORPTN) Q:RC<0
132 . S CNT=CNT+1,IEN798=$$PRRIEN^RORUTL01(PTIEN,RORREG) Q:IEN798'>0
133 . ;--- Check if the patient should be skipped
134 . I RORALL Q:$$SKIP^RORXU005(IEN798,FLAGS,RORSDT,ROREDT)
135 . ;--- Search the pharmacy data
136 . K @RORXDST
137 . S TMP=$$RXSEARCH^RORUTL14(PTIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
138 . I TMP<0 S ECNT=ECNT+1 Q
139 . I RORALL Q:TMP'>0
140 . ;--- Append the patient's data to the report
141 . S TMP=$$PATIENT(PTLIST,PTIEN)
142 . I TMP S ECNT=ECNT+$S(TMP>0:TMP,1:1) Q
143 ;
144 ;--- Cleanup
145 K @RORXDST
146 Q $S(RC<0:RC,1:ECNT)
147 ;
148 ;***** COMPILES THE "PATIENT DRUG HISTORY" REPORT
149 ; REPORT CODE: 011
150 ;
151 ; .RORTSK Task number and task parameters
152 ;
153 ; The ^TMP("RORX011",$J) global node is used by this function.
154 ;
155 ; Return Values:
156 ; <0 Error code
157 ; 0 Ok
158 ;
159RXHIST(RORTSK) ;
160 N RORALL ; Consider all registry patients
161 N ROREDT ; End date
162 N ROREDT1 ; End date + 1
163 N RORREG ; Registry IEN
164 N RORSDT ; Start date
165 N RORXGRP ; List of drug groups
166 N RORXL ; Closed root of the medication list
167 ;
168 N ECNT,FLAGS,RC,REPORT,TMP
169 S RORXL="",(ECNT,RC)=0
170 K ^TMP("RORX011",$J)
171 ;
172 ;--- Root node of the report
173 S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
174 Q:REPORT<0 REPORT
175 ;
176 D
177 . ;--- Get and prepare the report parameters
178 . S RORREG=+$$PARAM^RORTSK01("REGIEN")
179 . S RORALL=$$PARAM^RORTSK01("PATIENTS","ALL")
180 . S RC=$$PARAMS(REPORT,.RORSDT,.ROREDT,.FLAGS) Q:RC<0
181 . S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
182 . ;
183 . ;--- Report header
184 . S RC=$$HEADER(REPORT) Q:RC<0
185 . ;
186 . ;--- Process the data and generate the report
187 . S RC=$$PROCESS(REPORT,FLAGS) S:RC>0 ECNT=ECNT+RC
188 ;
189 ;--- Cleanup
190 K ^TMP("RORX011",$J)
191 D FREE^RORTMP(RORXL)
192 Q $S(RC<0:RC,ECNT>0:-43,1:0)
193 ;
194 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
195RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
196 N DRUGIEN,DRUGNAME,FILLTYPE,IEN,IRP,OFD,RPSUB,RXBUF,RXCNT,RXNUM,TMP
197 S DRUGIEN=+DRUG,DRUGNAME=$P(DRUG,U,2)
198 Q:(DRUGIEN'>0)!(DRUGNAME="") 1
199 ;--- Check the drug groups
200 S TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
201 Q:TMP TMP
202 ;--- Process the order
203 S:ROR8DST("RORXGEN")>0 $P(RXBUF,U,4)=$P(ROR8DST("RORXGEN"),U,2)
204 S $P(RXBUF,U,5)=$P($G(^TMP("PS",$J,0)),U,7) ; Days Supply
205 S TMP=$G(^TMP("PS",$J,"RXN",0))
206 S FILLTYPE=$S(ORDFLG["I":"I",1:$P(TMP,U,3))
207 S RXNUM=$P(TMP,U) S:RXNUM="" RXNUM=" "
208 S RXCNT=0
209 ;--- Original prescription
210 I ORDFLG["I" D ;--- Inpatient
211 . S OFD=$P($G(^TMP("PS",$J,0)),U,5) ; Start Date
212 . S $P(RXBUF,U,1,2)="I"_U_FILLTYPE,RXCNT=RXCNT+1
213 . S @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
214 E D ;--- Outpatient
215 . S OFD=+$P($G(^TMP("PS",$J,"RXN",0)),U,6) ; Original Fill Date
216 . Q:(OFD<ROR8DST("RORSDT"))!(OFD'<ROR8DST("ROREDT"))
217 . S $P(RXBUF,U,1,2)="O"_U_FILLTYPE,RXCNT=RXCNT+1
218 . S @ROR8DST@(OFD,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
219 ;--- Refills and partials
220 F RPSUB="REF","PAR" D
221 . S $P(RXBUF,U)=$E(RPSUB,1)
222 . S IRP=0
223 . F S IRP=$O(^TMP("PS",$J,RPSUB,IRP)) Q:IRP'>0 D
224 . . S TMP=$G(^TMP("PS",$J,RPSUB,IRP,0))
225 . . S $P(RXBUF,U,2)=$S(ORDFLG["I":"I",1:$P(TMP,U,5))
226 . . S $P(RXBUF,U,5)=$P(TMP,U,2) ; Days Supply
227 . . I TMP>0 S RXCNT=RXCNT+1 D
228 . . . S @ROR8DST@(+TMP,DRUGNAME,DRUGIEN,RXNUM,RXCNT)=RXBUF
229 Q 0
Note: See TracBrowser for help on using the repository browser.