| [613] | 1 | RORHL031 ;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 | ;
|
|---|
| 28 | RXE(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 | ;
|
|---|
| 174 | RXE2(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 | ;
|
|---|
| 215 | RXE5(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
|
|---|
