source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL03.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.1 KB
Line 
1RORHL03 ;HOIFO/CRT - HL7 PHARMACY: ORC,RXE ; 5/30/06 8:35am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; Routines RORHL03* use the following IAs:
5 ;
6 ; #93-A Get stop code from the file #44 (controlled)
7 ; #1876 Read access to file #59
8 ; #2400 OCL^PSOORRL and OEL^PSOORRL (controlled)
9 ; #4820 RX^PSO52API (supported)
10 ; #4826 PSS432^PSS55 and PSS436^PSS55 (supported)
11 ; #10060 Read access to file #200 (supported)
12 ; #10090 Read access to file #4 (supported)
13 ;
14 Q
15 ;
16 ;***** PHARMACY DATA SEGMENT BUILDER
17 ;
18 ; RORDFN DFN of Patient Record in File #2
19 ;
20 ; .DXDTS Reference to a local variable where the
21 ; data extraction time frames are stored.
22 ;
23 ; Return Values:
24 ; <0 Error Code
25 ; 0 Ok
26 ; >0 Non-fatal error(s)
27 ;
28 ; The ^TMP("PS",$J) global node is used by this function.
29 ;
30EN1(RORDFN,DXDTS) ;
31 N ENDT,ERRCNT,IDX,RC,STDT
32 S (ERRCNT,RC)=0
33 ;---
34 S IDX=0
35 F S IDX=$O(DXDTS(6,IDX)) Q:IDX'>0 D Q:RC<0
36 . S STDT=$P(DXDTS(6,IDX),U),ENDT=$P(DXDTS(6,IDX),U,2)
37 . S TMP=$$EN2(RORDFN,STDT,ENDT)
38 . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
39 ;---
40 Q $S(RC<0:RC,1:ERRCNT)
41 ;
42 ;***** PHARMACY DATA SEGMENT BUILDER
43 ;
44 ; RORDFN DFN of Patient Record in File #2
45 ;
46 ; RORSTDT Start Date/Time (Fileman)
47 ; RORENDT End Date/Time (Fileman)
48 ;
49 ; Return Values:
50 ; <0 Error Code
51 ; 0 Ok
52 ; >0 Non-fatal error(s)
53 ;
54EN2(RORDFN,RORSTDT,RORENDT) ;
55 N ERRCNT,IEN55,II,RC,ROR55,ROR55SUB,RORII,RORINC,RORINDEX,RORMSG,RORORD,RORRXE,RORTMP,RORXII,TMP
56 S (ERRCNT,RC)=0
57 ;
58 ;--- Load the list of prescriptions
59 K ^TMP("PS",$J)
60 D OCL^PSOORRL(RORDFN,RORSTDT,RORENDT)
61 Q:$D(^TMP("PS",$J))<10 0
62 ;
63 ;--- Select the prescriptions
64 S RORTMP=$$ALLOC^RORTMP()
65 S RORII=0
66 F S RORII=$O(^TMP("PS",$J,RORII)) Q:'RORII D
67 . S RORORD=$P(^TMP("PS",$J,RORII,0),U)
68 . Q:RORORD'>0
69 . S II=$P(RORORD,";"),II=$E(II,$L(II))
70 . Q:'("RUV"[II)
71 . ;---
72 . I "UV"[II D Q:(TMP<RORSTDT)!(TMP'<RORENDT)
73 . . S TMP=$P($G(^TMP("PS",$J,RORII,0)),U,15)
74 . I II="R" D Q:TMP<RORSTDT
75 . . S TMP=$P($G(^TMP("PS",$J,RORII,0)),U,10)
76 . ;---
77 . S @RORTMP@(RORII,0)=^TMP("PS",$J,RORII,0)
78 K ^TMP("PS",$J)
79 ;
80 ;--- Browse through the list and generate the HL7 segments
81 S ROR55=$$ALLOC^RORTMP(.ROR55SUB)
82 S RORII=0
83 F S RORII=$O(@RORTMP@(RORII)) Q:'RORII D Q:RC<0
84 . S RORORD=$P(@RORTMP@(RORII,0),U)
85 . S RORXII=$P(RORORD,";"),RORXII=$E(RORXII,$L(RORXII))
86 . S IEN55=+$P(RORORD,";")
87 . ;
88 . K ^TMP("PS",$J),RORRXE
89 . D OEL^PSOORRL(RORDFN,RORORD)
90 . Q:$D(^TMP("PS",$J))<10
91 . M RORRXE=^TMP("PS",$J)
92 . K ^TMP("PS",$J)
93 . ;
94 . I RORXII="R" D ;--- Outpatient Pharmacy
95 . . D REFILL
96 . . ;--- Check if the original prescription or one of
97 . . ;--- the refills is within date range
98 . . S RORINC=0
99 . . F RORINDEX="REF","PAR" D
100 . . . S II=""
101 . . . F S II=$O(RORRXE(RORINDEX,II)) Q:II="" D
102 . . . . S TMP=$P($G(RORRXE(RORINDEX,II,0)),U)
103 . . . . I TMP'<RORSTDT,TMP<RORENDT S RORINC=1 Q
104 . . . . K RORRXE(RORINDEX,II,0)
105 . . Q:'RORINC
106 . . ;---
107 . . S TMP=$$ORC(IEN55,.RORRXE,RORDFN)
108 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
109 . . S TMP=$$RXE^RORHL031(IEN55,.RORRXE,RORDFN)
110 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
111 . . ;
112 . I RORXII="U" D ;--- Unit Dose Inpatient Pharmacy
113 . . N NODE K @ROR55
114 . . D PSS432^PSS55(RORDFN,IEN55,ROR55SUB)
115 . . S NODE=$NA(@ROR55@(IEN55))
116 . . ;---
117 . . S TMP=$$ORC^RORHL07(NODE,.RORRXE)
118 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
119 . . S TMP=$$RXE^RORHL07(NODE,.RORRXE)
120 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
121 . . ;
122 . I RORXII="V" D ;--- IV Inpatient Pharmacy
123 . . N NODE K @ROR55
124 . . D PSS436^PSS55(RORDFN,IEN55,ROR55SUB)
125 . . S NODE=$NA(@ROR55@(IEN55))
126 . . ;---
127 . . S TMP=$$ORC^RORHL071(NODE,.RORRXE)
128 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
129 . . S TMP=$$RXE^RORHL071(NODE,.RORRXE)
130 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
131 ;
132 D FREE^RORTMP(ROR55),FREE^RORTMP(RORTMP)
133 Q $S(RC<0:RC,1:ERRCNT)
134 ;
135 ;***** OUTPATIENT PHARMACY ORC SEGMENT BUILDER
136 ;
137 ; RORIEN IEN of the record of the PRESCRIPTION file (#52)
138 ;
139 ; .RORORC Array with info (from OEL^PSOORRL)
140 ;
141 ; PTIEN Patient IEN (DFN)
142 ;
143 ; Return Values:
144 ; <0 Error Code
145 ; 0 Ok
146 ; >0 Non-fatal error(s)
147 ;
148ORC(RORIEN,RORORC,PTIEN) ;
149 N BUF,CS,ERRCNT,IEN,IENS59,RC,RORMSG,ROROUT,RORSEG,RORTMP,RORTS,TMP
150 S (ERRCNT,RC)=0
151 D ECH^RORHL7(.CS)
152 ;
153 ;--- Initialize the segment
154 S RORSEG(0)="ORC"
155 ;
156 ;--- ORC-1 - Order Control
157 S RORSEG(1)="NW"
158 ;
159 ;--- ORC-2 - Placer Order #
160 S RORSEG(2)=+RORIEN_CS_"OP"
161 ;
162 ;--- ORC-9 - Release Date/Time
163 S TMP=$P($G(RORORC("RXN",0)),U,7)
164 S RORSEG(9)=$$FM2HL^RORHL7(TMP)
165 ;
166 ;--- ORC-12 - Provider
167 S BUF=+$P($G(RORORC("P",0)),U)
168 I BUF>0 D
169 . S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
170 . I $G(DIERR) D S ERRCNT=ERRCNT+1
171 . . D DBS^RORERR("RORMSG",-99,,,200,+BUF_",")
172 . S RORSEG(12)=BUF
173 ;
174 ;--- ORC-15 - Order Date/Time
175 S TMP=$$FMTHL7^XLFDT($P($G(RORORC(0)),U,5))
176 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No order date","OEL^PSOORRL")
177 S RORSEG(15)=TMP
178 ;
179 ;--- ORC-16 - Control Code Reason
180 S RORSEG(16)=CS_CS_CS_CS_"NEW"
181 ;
182 ;--- ORC-17 - Division
183 S RORSEG(17)=$$SITE^RORUTL03(CS)
184 S RORTMP=$$ALLOC^RORTMP(.RORTS)
185 D RX^PSO52API(PTIEN,RORTS,+RORIEN,,"2")
186 S IENS59=+$G(@RORTMP@(PTIEN,+RORIEN,20))_","
187 D FREE^RORTMP(RORTMP)
188 I IENS59>0 D
189 . D GETS^DIQ(59,IENS59,"100","IE","ROROUT","RORMSG")
190 . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
191 . . D DBS^RORERR("RORMSG",-99,,,59,IENS59)
192 . S IEN=+$G(ROROUT(59,IENS59,100,"I"))
193 . Q:IEN'>0
194 . ;---
195 . S BUF=$$GET1^DIQ(4,IEN_",",99,"I",,"RORMSG")
196 . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
197 . . D DBS^RORERR("RORMSG",-99,,,4,IEN_",")
198 . Q:BUF=""
199 . S $P(BUF,CS,2)=$$ESCAPE^RORHL7($G(ROROUT(59,IENS59,100,"E")))
200 . S $P(BUF,CS,3)="99VA4"
201 . S RORSEG(17)=BUF
202 ;
203 ;--- Store the segment
204 D ADDSEG^RORHL7(.RORSEG)
205 Q ERRCNT
206 ;
207 ;***** MAKES ORIGINAL FILL LIKE REFILLS TO REUSE CODE
208REFILL ;
209 S RORRXE("REF",0,0)=""
210 S $P(RORRXE("REF",0,0),U,1)=$P(RORRXE("RXN",0),U,6)
211 S $P(RORRXE("REF",0,0),U,2)=$P(RORRXE(0),U,7)
212 S $P(RORRXE("REF",0,0),U,3)=$P(RORRXE(0),U,8)
213 S $P(RORRXE("REF",0,0),U,4)=$P(RORRXE("RXN",0),U,7)
214 S $P(RORRXE("REF",0,0),U,5)=$P(RORRXE("RXN",0),U,3)
215 Q
Note: See TracBrowser for help on using the repository browser.