Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHL031

RORHL031.m

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