232 lines
6.2 KiB
Mathematica
232 lines
6.2 KiB
Mathematica
RORHL031 ;HOIFO/BH,SG - HL7 PHARMACY: UTILITIES ; 3/13/06 9:23am
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #1878 EN^PSOORDER
|
|
; #4533 ARWS^PSS50 (supported)
|
|
; #4545 DATA^PSN50P68 (supported)
|
|
; #4820 RX^PSO52API (supported)
|
|
;
|
|
Q
|
|
;
|
|
;***** OUTPATIENT PHARMACY RXE SEGMENT BUILDER
|
|
;
|
|
; RORIEN IEN in the PRESCRIPTION file (#52)
|
|
;
|
|
; .RORRXE Array with info (from OEL^PSOORRL)
|
|
;
|
|
; PTIEN Patient IEN (DFN)
|
|
;
|
|
; The ^TMP("PSOR",$J) global node is used by this function.
|
|
;
|
|
; Return Values:
|
|
; <0 Error Code
|
|
; 0 Ok
|
|
; >0 Non-fatal error(s)
|
|
;
|
|
RXE(RORIEN,RORRXE,PTIEN) ;
|
|
N BUF,CS,ERRCNT,IDGN,II,INDF,J,L,RC,RORCLIN,RORCMOP,RORISIG,RORLST,RORMREF,RORMSG,RORPRICE,RORSEG,RORSTAT,RORSTOP,RORTEST,RORTMP,RORTS,TMP
|
|
S (ERRCNT,RC)=0
|
|
D ECH^RORHL7(.CS)
|
|
;
|
|
Q:$P($G(RORRXE(0)),U)="" 0
|
|
;
|
|
K ^TMP("PSOR",$J)
|
|
D EN^PSOORDER(,RORIEN)
|
|
;
|
|
S BUF=$G(^TMP("PSOR",$J,RORIEN,0))
|
|
S RORMREF=$P(BUF,U,8) ; # of refills
|
|
S RORPRICE=$P(BUF,U,10) ; unit price of drugs
|
|
;
|
|
S BUF=$G(^TMP("PSOR",$J,RORIEN,1))
|
|
S RORSTAT=$P($P(BUF,U,5),";",1) ; patient status (internal)
|
|
S RORSTDE=$P($P(BUF,U,5),";",2) ; patient status
|
|
S RORCLIN=+$P(BUF,U,4) ; clinic
|
|
;
|
|
S (J,RORISIG)="",L=245
|
|
F S J=$O(^TMP("PSOR",$J,RORIEN,"SIG1",J)) Q:J="" D Q:L'>0
|
|
. S BUF=$G(^TMP("PSOR",$J,RORIEN,"SIG1",J,0))
|
|
. S RORISIG=RORISIG_" "_$E(BUF,1,L)
|
|
. S L=L-$L(BUF)-1 S:L<-1 RORISIG=RORISIG_"..."
|
|
S RORISIG=$$TRIM^XLFSTR(RORISIG)
|
|
;
|
|
;--- Get Stop Code
|
|
S RORSTOP=$$STOPCODE^RORUTL18(+RORCLIN)
|
|
S:RORSTOP'>0 RORSTOP=""
|
|
;
|
|
S RORTMP=$$ALLOC^RORTMP(.RORTS)
|
|
D RX^PSO52API(PTIEN,RORTS,RORIEN,,"C,R")
|
|
;--- Get last dispensed dates
|
|
S II=0 K RORLST
|
|
F S II=$O(@RORTMP@(PTIEN,RORIEN,"RF",II)) Q:II'>0 D
|
|
. S RORLST(II,10.1)=+$G(@RORTMP@(PTIEN,RORIEN,"RF",II,10.1))
|
|
;--- Load the CMOP list
|
|
S II=0 K RORCMOP
|
|
F S II=$O(@RORTMP@(PTIEN,RORIEN,"C",II)) Q:II'>0 D
|
|
. Q:+$G(@RORTMP@(PTIEN,RORIEN,"C",II,3))=3
|
|
. S TMP=$G(@RORTMP@(PTIEN,RORIEN,"C",II,2))
|
|
. S:TMP'="" RORCMOP("A2",TMP,II)=""
|
|
;--- Free the buffer
|
|
D FREE^RORTMP(RORTMP)
|
|
;
|
|
F RORINDEX="REF","PAR" D
|
|
. S II=""
|
|
. F S II=$O(RORRXE(RORINDEX,II)) Q:II="" D Q:RC<0
|
|
. . S RORTEST=$G(RORRXE(RORINDEX,II,0)) Q:RORTEST=""
|
|
. . ;
|
|
. . ;--- Initialize the segment
|
|
. . K RORSEG S RORSEG(0)="RXE"
|
|
. . ;
|
|
. . ;--- RXE-1 - Quantity/Timing
|
|
. . S RORSEG(1)=""""""
|
|
. . ;
|
|
. . ;--- RXE-2 - Give Code
|
|
. . S IDGN=+$P($G(RORRXE("DD",1,0)),U,3) ; File #50 IEN
|
|
. . I IDGN'>0 S IDGN=+$P($G(RORRXE("DD",1,0)),U) Q:IDGN'>0
|
|
. . S TMP=$$RXE2(IDGN,CS,.BUF,.INDF)
|
|
. . I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
|
|
. . Q:BUF=""
|
|
. . S RORSEG(2)=BUF
|
|
. . ;
|
|
. . ;--- RXE-3 - Give Amount (Min)
|
|
. . S RORSEG(3)=""""""
|
|
. . ;
|
|
. . ;--- RXE-4 - Max # of re-fills
|
|
. . S RORSEG(4)=RORMREF
|
|
. . ;
|
|
. . ;--- RXE-5 - Give Units
|
|
. . S TMP=$$RXE5(+$G(INDF),CS,.BUF)
|
|
. . S:TMP ERRCNT=ERRCNT+1
|
|
. . S:BUF'="" RORSEG(5)=BUF
|
|
. . ;
|
|
. . ;--- RXE-6 - Release Date/Time
|
|
. . S TMP=$P($G(RORRXE(RORINDEX,II,0)),U,4)
|
|
. . S RORSEG(6)=$$FM2HL^RORHL7(TMP)
|
|
. . ;
|
|
. . ;--- RXE-7 - SIG1
|
|
. . S RORSEG(7)=CS_$$ESCAPE^RORHL7(RORISIG)
|
|
. . ;
|
|
. . ;--- RXE-10 - Dispense amount
|
|
. . S RORSEG(10)=$P($G(RORRXE(RORINDEX,II,0)),U,3)
|
|
. . ;
|
|
. . ;--- RXE-15 - Refill Indicator
|
|
. . S RORSEG(15)=$S(RORINDEX="REF":1,RORINDEX="PAR":2)
|
|
. . ;
|
|
. . ;--- RXE-17 - Refill #
|
|
. . S RORSEG(17)=II
|
|
. . ;
|
|
. . ;--- RXE-18 - Fill Date/Time
|
|
. . S TMP=$P($G(RORRXE(RORINDEX,II,0)),U)
|
|
. . S RORSEG(18)=$$FM2HL^RORHL7(TMP)
|
|
. . ;
|
|
. . ;--- RXE-19 - Total Daily Dose
|
|
. . S RORSEG(19)=$P($G(RORRXE(RORINDEX,II,0)),U,2)
|
|
. . ;
|
|
. . ;--- RXE-20 - CMOP
|
|
. . S RORSEG(20)=$S($D(RORCMOP("A2",II)):"Y",1:"N")
|
|
. . ;
|
|
. . ;--- RXE-21 - Clinic Stop
|
|
. . S RORSEG(21)=RORSTOP
|
|
. . ;
|
|
. . ;--- RXE-22 - Dispense Date
|
|
. . I 'II D
|
|
. . . S TMP=$P($G(RORRXE(0)),U,5)
|
|
. . . S RORSEG(22)=$$FM2HL^RORHL7(TMP)
|
|
. . E D:$D(RORLST(II))
|
|
. . . S TMP=+$G(RORLST(II,10.1))
|
|
. . . S RORSEG(22)=$$FM2HL^RORHL7(TMP)
|
|
. . ;
|
|
. . ;--- RXE-23 - Unit Cost
|
|
. . S RORSEG(23)=RORPRICE
|
|
. . ;
|
|
. . ;--- RXE-27 - Patient Status
|
|
. . S RORSEG(27)=RORSTAT_CS_RORSTDE
|
|
. . ;
|
|
. . ;--- RXE-30 Mail/Window
|
|
. . S TMP=$P($G(RORRXE(RORINDEX,II,0)),U,5)
|
|
. . S RORSEG(30)=$S(TMP="M":"AD",TMP="W":"TR",1:"")
|
|
. . ;
|
|
. . ;--- Store the segment
|
|
. . D ADDSEG^RORHL7(.RORSEG)
|
|
;
|
|
K ^TMP("PSOR",$J)
|
|
Q ERRCNT
|
|
;
|
|
;***** CONSTRUCTS THE RXE-2 FIELD (GIVE CODE)
|
|
;
|
|
; IEN50 IEN in the DRUG file (#50)
|
|
;
|
|
; [CS] Component Separator (defaults to "^")
|
|
;
|
|
; .RXE2 Reference to a local variable where the value
|
|
; of the RXE-2 field is returned
|
|
;
|
|
; [.PSNDF] VA PRODUCT
|
|
; ^01: IEN
|
|
; ^02: NAME (.01)
|
|
;
|
|
; Return Values:
|
|
; <0 Error Code
|
|
; 0 Ok
|
|
; >0 Non-fatal error(s)
|
|
;
|
|
RXE2(IEN50,CS,RXE2,PSNDF) ;
|
|
N ERRCNT,IDGN,NODE,RC,RORMSG,TMP,TMP1
|
|
S (ERRCNT,RC)=0,RXE2=""
|
|
;
|
|
S:$G(CS)="" CS="^"
|
|
S IDGN=+$G(IEN50)
|
|
;
|
|
S NODE=$$ALLOC^RORTMP(.TMP)
|
|
D ARWS^PSS50(IDGN,,TMP)
|
|
;
|
|
S $P(RXE2,CS,1)=$G(@NODE@(IDGN,31)) ; NDC
|
|
;--- VA Product Name
|
|
S PSNDF=$G(@NODE@(IDGN,22)),TMP1=$P(PSNDF,U,2)
|
|
S $P(RXE2,CS,2)=$$ESCAPE^RORHL7($E(TMP1,1,64))
|
|
S $P(RXE2,CS,3)="PSNDF"
|
|
;
|
|
S TMP=""
|
|
S $P(TMP,"-",1)=$P($G(@NODE@(IDGN,20)),U) ; VA Drug Code
|
|
S $P(TMP,"-",2)=$G(@NODE@(IDGN,2)) ; VA Drug Class
|
|
S:TMP'="-" $P(RXE2,CS,4)=TMP
|
|
;--- Drug Name
|
|
S $P(RXE2,CS,5)=$$ESCAPE^RORHL7($G(@NODE@(IDGN,.01)))
|
|
S $P(RXE2,CS,6)="99PSD"
|
|
;
|
|
D FREE^RORTMP(NODE)
|
|
S:($P(RXE2,CS,1,2)="^")&($P(RXE2,CS,4,5)="^") RXE2=""
|
|
Q ERRCNT
|
|
;
|
|
;***** CONSTRUCTS THE RXE-5 FIELD (GIVE UNITS)
|
|
;
|
|
; IEN50P68 IEN in the VA PRODUCT file (#50.68)
|
|
;
|
|
; [CS] Component Separator (defaults to "^")
|
|
;
|
|
; .RXE5 Reference to a local variable where the value
|
|
; of the RXE-5 field is returned
|
|
;
|
|
; Return Values:
|
|
; <0 Error Code
|
|
; 0 Ok
|
|
;
|
|
RXE5(IEN50P68,CS,RXE5) ;
|
|
N INDF,NODE,TMP
|
|
S:$G(CS)="" CS="^"
|
|
S RXE5="",INDF=+$G(IEN50P68)
|
|
Q:INDF'>0 0
|
|
;--- Get the units
|
|
S NODE=$$ALLOC^RORTMP(.TMP)
|
|
D DATA^PSN50P68(INDF,,TMP)
|
|
S TMP=$G(@NODE@(INDF,3))
|
|
D FREE^RORTMP(NODE)
|
|
Q:TMP'>0 0
|
|
;--- Format the field
|
|
S $P(RXE5,CS,4)=$P(TMP,U)
|
|
S $P(RXE5,CS,5)=$$ESCAPE^RORHL7($P(TMP,U,2))
|
|
S $P(RXE5,CS,6)="99PSU"
|
|
;--- Success
|
|
Q 0
|