source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL031.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: 6.2 KB
Line 
1RORHL031 ;HOIFO/BH,SG - HL7 PHARMACY: UTILITIES ; 3/13/06 9:23am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #1878 EN^PSOORDER
7 ; #4533 ARWS^PSS50 (supported)
8 ; #4545 DATA^PSN50P68 (supported)
9 ; #4820 RX^PSO52API (supported)
10 ;
11 Q
12 ;
13 ;***** OUTPATIENT PHARMACY RXE SEGMENT BUILDER
14 ;
15 ; RORIEN IEN in the PRESCRIPTION file (#52)
16 ;
17 ; .RORRXE Array with info (from OEL^PSOORRL)
18 ;
19 ; PTIEN Patient IEN (DFN)
20 ;
21 ; The ^TMP("PSOR",$J) global node is used by this function.
22 ;
23 ; Return Values:
24 ; <0 Error Code
25 ; 0 Ok
26 ; >0 Non-fatal error(s)
27 ;
28RXE(RORIEN,RORRXE,PTIEN) ;
29 N BUF,CS,ERRCNT,IDGN,II,INDF,J,L,RC,RORCLIN,RORCMOP,RORISIG,RORLST,RORMREF,RORMSG,RORPRICE,RORSEG,RORSTAT,RORSTOP,RORTEST,RORTMP,RORTS,TMP
30 S (ERRCNT,RC)=0
31 D ECH^RORHL7(.CS)
32 ;
33 Q:$P($G(RORRXE(0)),U)="" 0
34 ;
35 K ^TMP("PSOR",$J)
36 D EN^PSOORDER(,RORIEN)
37 ;
38 S BUF=$G(^TMP("PSOR",$J,RORIEN,0))
39 S RORMREF=$P(BUF,U,8) ; # of refills
40 S RORPRICE=$P(BUF,U,10) ; unit price of drugs
41 ;
42 S BUF=$G(^TMP("PSOR",$J,RORIEN,1))
43 S RORSTAT=$P($P(BUF,U,5),";",1) ; patient status (internal)
44 S RORSTDE=$P($P(BUF,U,5),";",2) ; patient status
45 S RORCLIN=+$P(BUF,U,4) ; clinic
46 ;
47 S (J,RORISIG)="",L=245
48 F S J=$O(^TMP("PSOR",$J,RORIEN,"SIG1",J)) Q:J="" D Q:L'>0
49 . S BUF=$G(^TMP("PSOR",$J,RORIEN,"SIG1",J,0))
50 . S RORISIG=RORISIG_" "_$E(BUF,1,L)
51 . S L=L-$L(BUF)-1 S:L<-1 RORISIG=RORISIG_"..."
52 S RORISIG=$$TRIM^XLFSTR(RORISIG)
53 ;
54 ;--- Get Stop Code
55 S RORSTOP=$$STOPCODE^RORUTL18(+RORCLIN)
56 S:RORSTOP'>0 RORSTOP=""
57 ;
58 S RORTMP=$$ALLOC^RORTMP(.RORTS)
59 D RX^PSO52API(PTIEN,RORTS,RORIEN,,"C,R")
60 ;--- Get last dispensed dates
61 S II=0 K RORLST
62 F S II=$O(@RORTMP@(PTIEN,RORIEN,"RF",II)) Q:II'>0 D
63 . S RORLST(II,10.1)=+$G(@RORTMP@(PTIEN,RORIEN,"RF",II,10.1))
64 ;--- Load the CMOP list
65 S II=0 K RORCMOP
66 F S II=$O(@RORTMP@(PTIEN,RORIEN,"C",II)) Q:II'>0 D
67 . Q:+$G(@RORTMP@(PTIEN,RORIEN,"C",II,3))=3
68 . S TMP=$G(@RORTMP@(PTIEN,RORIEN,"C",II,2))
69 . S:TMP'="" RORCMOP("A2",TMP,II)=""
70 ;--- Free the buffer
71 D FREE^RORTMP(RORTMP)
72 ;
73 F RORINDEX="REF","PAR" D
74 . S II=""
75 . F S II=$O(RORRXE(RORINDEX,II)) Q:II="" D Q:RC<0
76 . . S RORTEST=$G(RORRXE(RORINDEX,II,0)) Q:RORTEST=""
77 . . ;
78 . . ;--- Initialize the segment
79 . . K RORSEG S RORSEG(0)="RXE"
80 . . ;
81 . . ;--- RXE-1 - Quantity/Timing
82 . . S RORSEG(1)=""""""
83 . . ;
84 . . ;--- RXE-2 - Give Code
85 . . S IDGN=+$P($G(RORRXE("DD",1,0)),U,3) ; File #50 IEN
86 . . I IDGN'>0 S IDGN=+$P($G(RORRXE("DD",1,0)),U) Q:IDGN'>0
87 . . S TMP=$$RXE2(IDGN,CS,.BUF,.INDF)
88 . . I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
89 . . Q:BUF=""
90 . . S RORSEG(2)=BUF
91 . . ;
92 . . ;--- RXE-3 - Give Amount (Min)
93 . . S RORSEG(3)=""""""
94 . . ;
95 . . ;--- RXE-4 - Max # of re-fills
96 . . S RORSEG(4)=RORMREF
97 . . ;
98 . . ;--- RXE-5 - Give Units
99 . . S TMP=$$RXE5(+$G(INDF),CS,.BUF)
100 . . S:TMP ERRCNT=ERRCNT+1
101 . . S:BUF'="" RORSEG(5)=BUF
102 . . ;
103 . . ;--- RXE-6 - Release Date/Time
104 . . S TMP=$P($G(RORRXE(RORINDEX,II,0)),U,4)
105 . . S RORSEG(6)=$$FM2HL^RORHL7(TMP)
106 . . ;
107 . . ;--- RXE-7 - SIG1
108 . . S RORSEG(7)=CS_$$ESCAPE^RORHL7(RORISIG)
109 . . ;
110 . . ;--- RXE-10 - Dispense amount
111 . . S RORSEG(10)=$P($G(RORRXE(RORINDEX,II,0)),U,3)
112 . . ;
113 . . ;--- RXE-15 - Refill Indicator
114 . . S RORSEG(15)=$S(RORINDEX="REF":1,RORINDEX="PAR":2)
115 . . ;
116 . . ;--- RXE-17 - Refill #
117 . . S RORSEG(17)=II
118 . . ;
119 . . ;--- RXE-18 - Fill Date/Time
120 . . S TMP=$P($G(RORRXE(RORINDEX,II,0)),U)
121 . . S RORSEG(18)=$$FM2HL^RORHL7(TMP)
122 . . ;
123 . . ;--- RXE-19 - Total Daily Dose
124 . . S RORSEG(19)=$P($G(RORRXE(RORINDEX,II,0)),U,2)
125 . . ;
126 . . ;--- RXE-20 - CMOP
127 . . S RORSEG(20)=$S($D(RORCMOP("A2",II)):"Y",1:"N")
128 . . ;
129 . . ;--- RXE-21 - Clinic Stop
130 . . S RORSEG(21)=RORSTOP
131 . . ;
132 . . ;--- RXE-22 - Dispense Date
133 . . I 'II D
134 . . . S TMP=$P($G(RORRXE(0)),U,5)
135 . . . S RORSEG(22)=$$FM2HL^RORHL7(TMP)
136 . . E D:$D(RORLST(II))
137 . . . S TMP=+$G(RORLST(II,10.1))
138 . . . S RORSEG(22)=$$FM2HL^RORHL7(TMP)
139 . . ;
140 . . ;--- RXE-23 - Unit Cost
141 . . S RORSEG(23)=RORPRICE
142 . . ;
143 . . ;--- RXE-27 - Patient Status
144 . . S RORSEG(27)=RORSTAT_CS_RORSTDE
145 . . ;
146 . . ;--- RXE-30 Mail/Window
147 . . S TMP=$P($G(RORRXE(RORINDEX,II,0)),U,5)
148 . . S RORSEG(30)=$S(TMP="M":"AD",TMP="W":"TR",1:"")
149 . . ;
150 . . ;--- Store the segment
151 . . D ADDSEG^RORHL7(.RORSEG)
152 ;
153 K ^TMP("PSOR",$J)
154 Q ERRCNT
155 ;
156 ;***** CONSTRUCTS THE RXE-2 FIELD (GIVE CODE)
157 ;
158 ; IEN50 IEN in the DRUG file (#50)
159 ;
160 ; [CS] Component Separator (defaults to "^")
161 ;
162 ; .RXE2 Reference to a local variable where the value
163 ; of the RXE-2 field is returned
164 ;
165 ; [.PSNDF] VA PRODUCT
166 ; ^01: IEN
167 ; ^02: NAME (.01)
168 ;
169 ; Return Values:
170 ; <0 Error Code
171 ; 0 Ok
172 ; >0 Non-fatal error(s)
173 ;
174RXE2(IEN50,CS,RXE2,PSNDF) ;
175 N ERRCNT,IDGN,NODE,RC,RORMSG,TMP,TMP1
176 S (ERRCNT,RC)=0,RXE2=""
177 ;
178 S:$G(CS)="" CS="^"
179 S IDGN=+$G(IEN50)
180 ;
181 S NODE=$$ALLOC^RORTMP(.TMP)
182 D ARWS^PSS50(IDGN,,TMP)
183 ;
184 S $P(RXE2,CS,1)=$G(@NODE@(IDGN,31)) ; NDC
185 ;--- VA Product Name
186 S PSNDF=$G(@NODE@(IDGN,22)),TMP1=$P(PSNDF,U,2)
187 S $P(RXE2,CS,2)=$$ESCAPE^RORHL7($E(TMP1,1,64))
188 S $P(RXE2,CS,3)="PSNDF"
189 ;
190 S TMP=""
191 S $P(TMP,"-",1)=$P($G(@NODE@(IDGN,20)),U) ; VA Drug Code
192 S $P(TMP,"-",2)=$G(@NODE@(IDGN,2)) ; VA Drug Class
193 S:TMP'="-" $P(RXE2,CS,4)=TMP
194 ;--- Drug Name
195 S $P(RXE2,CS,5)=$$ESCAPE^RORHL7($G(@NODE@(IDGN,.01)))
196 S $P(RXE2,CS,6)="99PSD"
197 ;
198 D FREE^RORTMP(NODE)
199 S:($P(RXE2,CS,1,2)="^")&($P(RXE2,CS,4,5)="^") RXE2=""
200 Q ERRCNT
201 ;
202 ;***** CONSTRUCTS THE RXE-5 FIELD (GIVE UNITS)
203 ;
204 ; IEN50P68 IEN in the VA PRODUCT file (#50.68)
205 ;
206 ; [CS] Component Separator (defaults to "^")
207 ;
208 ; .RXE5 Reference to a local variable where the value
209 ; of the RXE-5 field is returned
210 ;
211 ; Return Values:
212 ; <0 Error Code
213 ; 0 Ok
214 ;
215RXE5(IEN50P68,CS,RXE5) ;
216 N INDF,NODE,TMP
217 S:$G(CS)="" CS="^"
218 S RXE5="",INDF=+$G(IEN50P68)
219 Q:INDF'>0 0
220 ;--- Get the units
221 S NODE=$$ALLOC^RORTMP(.TMP)
222 D DATA^PSN50P68(INDF,,TMP)
223 S TMP=$G(@NODE@(INDF,3))
224 D FREE^RORTMP(NODE)
225 Q:TMP'>0 0
226 ;--- Format the field
227 S $P(RXE5,CS,4)=$P(TMP,U)
228 S $P(RXE5,CS,5)=$$ESCAPE^RORHL7($P(TMP,U,2))
229 S $P(RXE5,CS,6)="99PSU"
230 ;--- Success
231 Q 0
Note: See TracBrowser for help on using the repository browser.