VistA-WorldVistAEHR/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL031.m

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