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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL031 6552 printed Sep 15, 2024@21:06:01 Page 2
RORHL031 ;HOIFO/BH,SG - HL7 PHARMACY: UTILITIES ; 3/13/06 9:23am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #1878 EN^PSOORDER
+6 ; #4533 ARWS^PSS50 (supported)
+7 ; #4545 DATA^PSN50P68 (supported)
+8 ; #4820 RX^PSO52API (supported)
+9 ;
+10 QUIT
+11 ;
+12 ;***** OUTPATIENT PHARMACY RXE SEGMENT BUILDER
+13 ;
+14 ; RORIEN IEN in the PRESCRIPTION file (#52)
+15 ;
+16 ; .RORRXE Array with info (from OEL^PSOORRL)
+17 ;
+18 ; PTIEN Patient IEN (DFN)
+19 ;
+20 ; The ^TMP("PSOR",$J) global node is used by this function.
+21 ;
+22 ; Return Values:
+23 ; <0 Error Code
+24 ; 0 Ok
+25 ; >0 Non-fatal error(s)
+26 ;
RXE(RORIEN,RORRXE,PTIEN) ;
+1 NEW BUF,CS,ERRCNT,IDGN,II,INDF,J,L,RC,RORCLIN,RORCMOP,RORISIG,RORLST,RORMREF,RORMSG,RORPRICE,RORSEG,RORSTAT,RORSTOP,RORTEST,RORTMP,RORTS,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 if $PIECE($GET(RORRXE(0)),U)=""
QUIT 0
+6 ;
+7 KILL ^TMP("PSOR",$JOB)
+8 DO EN^PSOORDER(,RORIEN)
+9 ;
+10 SET BUF=$GET(^TMP("PSOR",$JOB,RORIEN,0))
+11 ; # of refills
SET RORMREF=$PIECE(BUF,U,8)
+12 ; unit price of drugs
SET RORPRICE=$PIECE(BUF,U,10)
+13 ;
+14 SET BUF=$GET(^TMP("PSOR",$JOB,RORIEN,1))
+15 ; patient status (internal)
SET RORSTAT=$PIECE($PIECE(BUF,U,5),";",1)
+16 ; patient status
SET RORSTDE=$PIECE($PIECE(BUF,U,5),";",2)
+17 ; clinic
SET RORCLIN=+$PIECE(BUF,U,4)
+18 ;
+19 SET (J,RORISIG)=""
SET L=245
+20 FOR
SET J=$ORDER(^TMP("PSOR",$JOB,RORIEN,"SIG1",J))
if J=""
QUIT
Begin DoDot:1
+21 SET BUF=$GET(^TMP("PSOR",$JOB,RORIEN,"SIG1",J,0))
+22 SET RORISIG=RORISIG_" "_$EXTRACT(BUF,1,L)
+23 SET L=L-$LENGTH(BUF)-1
if L<-1
SET RORISIG=RORISIG_"..."
End DoDot:1
if L'>0
QUIT
+24 SET RORISIG=$$TRIM^XLFSTR(RORISIG)
+25 ;
+26 ;--- Get Stop Code
+27 SET RORSTOP=$$STOPCODE^RORUTL18(+RORCLIN)
+28 if RORSTOP'>0
SET RORSTOP=""
+29 ;
+30 SET RORTMP=$$ALLOC^RORTMP(.RORTS)
+31 DO RX^PSO52API(PTIEN,RORTS,RORIEN,,"C,R")
+32 ;--- Get last dispensed dates
+33 SET II=0
KILL RORLST
+34 FOR
SET II=$ORDER(@RORTMP@(PTIEN,RORIEN,"RF",II))
if II'>0
QUIT
Begin DoDot:1
+35 SET RORLST(II,10.1)=+$GET(@RORTMP@(PTIEN,RORIEN,"RF",II,10.1))
End DoDot:1
+36 ;--- Load the CMOP list
+37 SET II=0
KILL RORCMOP
+38 FOR
SET II=$ORDER(@RORTMP@(PTIEN,RORIEN,"C",II))
if II'>0
QUIT
Begin DoDot:1
+39 if +$GET(@RORTMP@(PTIEN,RORIEN,"C",II,3))=3
QUIT
+40 SET TMP=$GET(@RORTMP@(PTIEN,RORIEN,"C",II,2))
+41 if TMP'=""
SET RORCMOP("A2",TMP,II)=""
End DoDot:1
+42 ;--- Free the buffer
+43 DO FREE^RORTMP(RORTMP)
+44 ;
+45 FOR RORINDEX="REF","PAR"
Begin DoDot:1
+46 SET II=""
+47 FOR
SET II=$ORDER(RORRXE(RORINDEX,II))
if II=""
QUIT
Begin DoDot:2
+48 SET RORTEST=$GET(RORRXE(RORINDEX,II,0))
if RORTEST=""
QUIT
+49 ;
+50 ;--- Initialize the segment
+51 KILL RORSEG
SET RORSEG(0)="RXE"
+52 ;
+53 ;--- RXE-1 - Quantity/Timing
+54 SET RORSEG(1)=""""""
+55 ;
+56 ;--- RXE-2 - Give Code
+57 ; File #50 IEN
SET IDGN=+$PIECE($GET(RORRXE("DD",1,0)),U,3)
+58 IF IDGN'>0
SET IDGN=+$PIECE($GET(RORRXE("DD",1,0)),U)
if IDGN'>0
QUIT
+59 SET TMP=$$RXE2(IDGN,CS,.BUF,.INDF)
+60 IF TMP
SET ERRCNT=ERRCNT+1
if TMP<0
QUIT
+61 if BUF=""
QUIT
+62 SET RORSEG(2)=BUF
+63 ;
+64 ;--- RXE-3 - Give Amount (Min)
+65 SET RORSEG(3)=""""""
+66 ;
+67 ;--- RXE-4 - Max # of re-fills
+68 SET RORSEG(4)=RORMREF
+69 ;
+70 ;--- RXE-5 - Give Units
+71 SET TMP=$$RXE5(+$GET(INDF),CS,.BUF)
+72 if TMP
SET ERRCNT=ERRCNT+1
+73 if BUF'=""
SET RORSEG(5)=BUF
+74 ;
+75 ;--- RXE-6 - Release Date/Time
+76 SET TMP=$PIECE($GET(RORRXE(RORINDEX,II,0)),U,4)
+77 SET RORSEG(6)=$$FM2HL^RORHL7(TMP)
+78 ;
+79 ;--- RXE-7 - SIG1
+80 SET RORSEG(7)=CS_$$ESCAPE^RORHL7(RORISIG)
+81 ;
+82 ;--- RXE-10 - Dispense amount
+83 SET RORSEG(10)=$PIECE($GET(RORRXE(RORINDEX,II,0)),U,3)
+84 ;
+85 ;--- RXE-15 - Refill Indicator
+86 SET RORSEG(15)=$SELECT(RORINDEX="REF":1,RORINDEX="PAR":2)
+87 ;
+88 ;--- RXE-17 - Refill #
+89 SET RORSEG(17)=II
+90 ;
+91 ;--- RXE-18 - Fill Date/Time
+92 SET TMP=$PIECE($GET(RORRXE(RORINDEX,II,0)),U)
+93 SET RORSEG(18)=$$FM2HL^RORHL7(TMP)
+94 ;
+95 ;--- RXE-19 - Total Daily Dose
+96 SET RORSEG(19)=$PIECE($GET(RORRXE(RORINDEX,II,0)),U,2)
+97 ;
+98 ;--- RXE-20 - CMOP
+99 SET RORSEG(20)=$SELECT($DATA(RORCMOP("A2",II)):"Y",1:"N")
+100 ;
+101 ;--- RXE-21 - Clinic Stop
+102 SET RORSEG(21)=RORSTOP
+103 ;
+104 ;--- RXE-22 - Dispense Date
+105 IF 'II
Begin DoDot:3
+106 SET TMP=$PIECE($GET(RORRXE(0)),U,5)
+107 SET RORSEG(22)=$$FM2HL^RORHL7(TMP)
End DoDot:3
+108 IF '$TEST
if $DATA(RORLST(II))
Begin DoDot:3
+109 SET TMP=+$GET(RORLST(II,10.1))
+110 SET RORSEG(22)=$$FM2HL^RORHL7(TMP)
End DoDot:3
+111 ;
+112 ;--- RXE-23 - Unit Cost
+113 SET RORSEG(23)=RORPRICE
+114 ;
+115 ;--- RXE-27 - Patient Status
+116 SET RORSEG(27)=RORSTAT_CS_RORSTDE
+117 ;
+118 ;--- RXE-30 Mail/Window
+119 SET TMP=$PIECE($GET(RORRXE(RORINDEX,II,0)),U,5)
+120 SET RORSEG(30)=$SELECT(TMP="M":"AD",TMP="W":"TR",1:"")
+121 ;
+122 ;--- Store the segment
+123 DO ADDSEG^RORHL7(.RORSEG)
End DoDot:2
if RC<0
QUIT
End DoDot:1
+124 ;
+125 KILL ^TMP("PSOR",$JOB)
+126 QUIT ERRCNT
+127 ;
+128 ;***** CONSTRUCTS THE RXE-2 FIELD (GIVE CODE)
+129 ;
+130 ; IEN50 IEN in the DRUG file (#50)
+131 ;
+132 ; [CS] Component Separator (defaults to "^")
+133 ;
+134 ; .RXE2 Reference to a local variable where the value
+135 ; of the RXE-2 field is returned
+136 ;
+137 ; [.PSNDF] VA PRODUCT
+138 ; ^01: IEN
+139 ; ^02: NAME (.01)
+140 ;
+141 ; Return Values:
+142 ; <0 Error Code
+143 ; 0 Ok
+144 ; >0 Non-fatal error(s)
+145 ;
RXE2(IEN50,CS,RXE2,PSNDF) ;
+1 NEW ERRCNT,IDGN,NODE,RC,RORMSG,TMP,TMP1
+2 SET (ERRCNT,RC)=0
SET RXE2=""
+3 ;
+4 if $GET(CS)=""
SET CS="^"
+5 SET IDGN=+$GET(IEN50)
+6 ;
+7 SET NODE=$$ALLOC^RORTMP(.TMP)
+8 DO ARWS^PSS50(IDGN,,TMP)
+9 ;
+10 ; NDC
SET $PIECE(RXE2,CS,1)=$GET(@NODE@(IDGN,31))
+11 ;--- VA Product Name
+12 SET PSNDF=$GET(@NODE@(IDGN,22))
SET TMP1=$PIECE(PSNDF,U,2)
+13 SET $PIECE(RXE2,CS,2)=$$ESCAPE^RORHL7($EXTRACT(TMP1,1,64))
+14 SET $PIECE(RXE2,CS,3)="PSNDF"
+15 ;
+16 SET TMP=""
+17 ; VA Drug Code
SET $PIECE(TMP,"-",1)=$PIECE($GET(@NODE@(IDGN,20)),U)
+18 ; VA Drug Class
SET $PIECE(TMP,"-",2)=$GET(@NODE@(IDGN,2))
+19 if TMP'="-"
SET $PIECE(RXE2,CS,4)=TMP
+20 ;--- Drug Name
+21 SET $PIECE(RXE2,CS,5)=$$ESCAPE^RORHL7($GET(@NODE@(IDGN,.01)))
+22 SET $PIECE(RXE2,CS,6)="99PSD"
+23 ;
+24 DO FREE^RORTMP(NODE)
+25 if ($PIECE(RXE2,CS,1,2)="^")&($PIECE(RXE2,CS,4,5)="^")
SET RXE2=""
+26 QUIT ERRCNT
+27 ;
+28 ;***** CONSTRUCTS THE RXE-5 FIELD (GIVE UNITS)
+29 ;
+30 ; IEN50P68 IEN in the VA PRODUCT file (#50.68)
+31 ;
+32 ; [CS] Component Separator (defaults to "^")
+33 ;
+34 ; .RXE5 Reference to a local variable where the value
+35 ; of the RXE-5 field is returned
+36 ;
+37 ; Return Values:
+38 ; <0 Error Code
+39 ; 0 Ok
+40 ;
RXE5(IEN50P68,CS,RXE5) ;
+1 NEW INDF,NODE,TMP
+2 if $GET(CS)=""
SET CS="^"
+3 SET RXE5=""
SET INDF=+$GET(IEN50P68)
+4 if INDF'>0
QUIT 0
+5 ;--- Get the units
+6 SET NODE=$$ALLOC^RORTMP(.TMP)
+7 DO DATA^PSN50P68(INDF,,TMP)
+8 SET TMP=$GET(@NODE@(INDF,3))
+9 DO FREE^RORTMP(NODE)
+10 if TMP'>0
QUIT 0
+11 ;--- Format the field
+12 SET $PIECE(RXE5,CS,4)=$PIECE(TMP,U)
+13 SET $PIECE(RXE5,CS,5)=$$ESCAPE^RORHL7($PIECE(TMP,U,2))
+14 SET $PIECE(RXE5,CS,6)="99PSU"
+15 ;--- Success
+16 QUIT 0
