PSORRX2 ;AITC/BWF - Remote RX driver ;8/30/16 12:00am
;;7.0;OUTPATIENT PHARMACY;**454,479,497,541,643,728**;DEC 1997;Build 5
;
Q
; read response from refill site
READMSG(HLDAT,TYPE,LOCDRUG) ;
H 3 ;*541 - WAIT TO ALLOW THE HOST SITE TO COMPLETE THE PROCESSING OF THE REFILL REQUEST AND SEND OVER THE LABEL INFO
N ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,OREMSG1,OREMSG2,ORSMSG,GBLLOC,LBLOOP,LBTXT,LBLOVF,DIR,ORERR,MSGDONE,MSGCNT,MSGTXT,PSORXMM,PSO59P02
S ORFS="^",ORCS=$E($G(HL("ECH")),1),ORRS=$E($G(HL("ECH")),2),ORES=$E($G(HL("ECH")),3),ORSS=$E($G(HL("ECH")),4)
S TYPE=$G(TYPE,"")
S HLQUIT=0,ORQUIT="",OREMSG1="",OREMSG2="",ORERR=""
F X HLNEXT Q:HLQUIT'>0!(ORQUIT'="") D
.N LOOP
.S LOOP=0 F S LOOP=$O(HLNODE(LOOP)) Q:LOOP="" S HLNODE=HLNODE_HLNODE(LOOP)
.I $E(HLNODE,1,3)="MSA"&($P(HLNODE,ORFS,2)'="AA") S ORERR=$P(HLNODE,ORFS,4)
.I $E(HLNODE,1,3)="ERR" S OREMSG1=$P(HLNODE,ORFS,9)
.I $E(HLNODE,1,3)="NTE" D
..D REFNTE(.HLNODE,.HLDAT)
..S ORSMSG=$P(@HLDAT@(1),ORFS)
.I $E(HLNODE,1,3)="PID" D
..S @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
..D REFPID(.HLNODE,.HLDAT)
.I $E(HLNODE,1,3)="ORC" D
..;;*541 ;COMPARE THE SELECTED RX# WITH THE RX# RETURNED IN THE HL7 RECORD - IF MATCHES, CONTINUE PROCESSING
..;IF THE RX#'S DO NOT MATCH, DISPLAY MESSAGE AND QUIT PROCESSING
..;SEND THIS INFO TO THE ERROR TRAP SO FURTHER RESEARCH CAN BE DONE TO FIND THE ROOT CAUSE OF THIS
..I $G(RRXNUM),$G(RRXNUM)'=$P($P(HLNODE,ORFS,3),ORCS) D ;*541
...S ORERR="Label interrupted due to HL7 message corruption." ;*541
...S ORERR(1)="Please request a Partial Fill in order to generate a reprint label." ;541
...D APPERROR^%ZTER("MISMATCH RX") ;*541
...S PSORXMM=1 ;*541
..I $G(PRXNUM),$G(PRXNUM)'=$P($P(HLNODE,ORFS,3),ORCS) D ;*541
...S ORERR="Label interrupted due to HL7 message corruption." ;*541
...S ORERR(1)="Please request a Partial Fill in order to generate a reprint label." ;541
...D APPERROR^%ZTER("MISMATCH RX") ;*541
...S PSORXMM=1 ;*541
..D REFORC(.HLNODE,.HLDAT,TYPE)
.I $E(HLNODE,1,3)="RXD" D
..D REFRXD(.HLNODE,.HLDAT,TYPE)
I '$L(ORERR),'$L(OREMSG1) D
.I '$D(@HLDAT) S ORERR="No data was returned from the target vista." Q
.I '$D(@HLDAT@("FLAG")) D MESS($S($G(PRXNUM):1,1:0))
.W !!,"TRANSACTION SUCCESSFUL... The "_$S($G(PRXNUM):"partial ",1:"refill ")_"for RX #"_RRXNUM_" has been recorded on"
.W !,"the prescription at the host system."
.W !!,"Select a printer to generate the label or '^' to bypass printing.",!
.D LOGDATA^PSORWRAP(.HLDAT,TYPE,LOCDRUG,"",,$G(PSOHLSV("HOST RFIEN")),$G(PSOHLSV("HOST PARIEN")))
I $L(ORERR) D
. N PSOERR
. K PSORRBLD ; no need to rebuild worklist
. I ORERR="Invalid Receiving Application" S ORERR="OneVA software not installed at host site" ; This error is returned if patch is not installed at remote/host site. Making it more user friendly.
. W !!,ORERR
. I $D(ORERR)=11 F PSOERR=1:1 W ! Q:'$D(ORERR(PSOERR)) W ORERR(PSOERR) ;541
. S DIR(0)="FO",DIR("A")="Press RETURN to continue"
. D ^DIR
. I $G(PSORXMM) D ;*541
.. W !!,"The "_$S($G(PRXNUM):"partial ",1:"refill ")_"for RX #"_RRXNUM_" has been recorded on the prescription"
.. W !,"at the host system.",!
.. D LOGDATA^PSORWRAP(.HLDAT,TYPE,LOCDRUG,"")
I OREMSG1'="" D
. K PSORRBLD ; no need to rebuild worklist
. W !!,OREMSG1_". "_$S($L(OREMSG2):OREMSG2_".",1:""),!
. I '$D(ORSMSG) S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
I $D(ORSMSG) D
. I '$G(PSORXMM) D
.. S MSGDONE=0
.. F MSGCNT=1:1 D Q:MSGDONE
... S MSGTXT=$P(ORSMSG,"|",MSGCNT) I MSGTXT']"" S MSGDONE=1 Q
... W !,MSGTXT
.S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
Q
; HLDAT(1)=MESSAGE^PATIENT DFN^RX NUMBER^REMOTE SITE#^FILL/PARTIAL DATE^PHARMACIST NAME^QUANTITY^DISPENSE DATE^DRUG NAME^DAYS SUPPLY
REFNTE(DATA,HLDAT) ;
; Message details
N NTETYP,NTETEXT,NTETYPE,I,PSONRDAT,PSONR,PSONRNUM,PSONRTXT,PSOSUB,PSOSUBX
S NTETYPE=$P(DATA,ORFS,3)
S NTETEXT=$P(DATA,ORFS,4)
I NTETYPE="L" D
.I $L($P($G(@HLDAT@(1)),U)) S $P(@HLDAT@(1),U)=$P($G(@HLDAT@(1)),U)_"|"_NTETEXT Q
.S $P(@HLDAT@(1),U)=NTETEXT
I NTETYPE="O" D
.S @HLDAT@("LBL",$O(@HLDAT@("LBL",""),-1)+1)=NTETEXT
I NTETYPE="" D
.I NTETEXT["PATCH INSTALLED FLAG" S @HLDAT@("FLAG",1)=NTETEXT Q
.S @HLDAT@("NARR",$O(@HLDAT@("NARR",""),-1)+1)=NTETEXT
Q
;
REFPID(DATA,HLDAT) ;
; patient IEN from remote site
S $P(@HLDAT@(1),U,2)=$P($P($P(DATA,ORFS,4),ORCS,11),ORRS,2)
Q
;
REFORC(DATA,HLDAT,TYPE) ;
N RXNUM,RXSITE,RXDATE,PHARMLN,PHARMFN,REQSITE,PHONE,PHNAME,PNAME,RPDATE,RPROV
S RXNUM=$P($P(DATA,ORFS,3),ORCS)
S RXSITE=$P($P(DATA,ORFS,14),ORCS,4)
S RPDATE=$P(DATA,ORFS,10)
S RPROV=$P(DATA,ORFS,12)
S PHNAME=$P(DATA,ORFS,11)
S $P(@HLDAT@(1),U,3)=RXNUM
S $P(@HLDAT@(1),U,4)=RXSITE
S $P(@HLDAT@(1),U,5)=RPDATE
S $P(@HLDAT@(1),U,6)=PHNAME
S $P(@HLDAT@("RX0"),U)=RXNUM,$P(@HLDAT@("RX0"),U,2)=DFN,$P(@HLDAT@("RX0"),U,5)=$P($P($P(DATA,ORFS,22),ORCS,8),ORSS,2),$P(@HLDAT@("RX0"),U,6)=LOCDRUG
S $P(@HLDAT@("RX0"),U,4)=$P($P($P(DATA,ORFS,20),ORRS,1),ORCS,2)
S PSOHLSV("ORIG FILL DT")=$P(DATA,ORFS,15)
S ($P(@HLDAT@("RX0"),U,13),PSOHLSV("ISSUED DT"))=$P(DATA,ORFS,16),$P(@HLDAT@("RX0"),U,19)=""
; don't forget copies in p18, if needed
S $P(@HLDAT@("RX2"),U,2)=RPDATE,$P(@HLDAT@("RX2"),U,10)=$P($P($P(DATA,ORFS,20),ORRS,2),ORCS,2)
S $P(@HLDAT@("RX3"),U)=$P(DATA,ORFS,28)
I TYPE="RF" D
.S $P(@HLDAT@("RREF0"),U)=RPDATE,$P(@HLDAT@("RREF0"),U,2)="W",$P(@HLDAT@("RREF0"),U,7)=$P($P($P(DATA,ORFS,20),ORRS,3),ORCS,2)
.S $P(@HLDAT@("RREF0"),U,17)=$P($P($P(DATA,ORFS,20),ORRS,4),ORCS,2)
I TYPE="PR" D
.S $P(@HLDAT@("RPAR0"),U)=RPDATE,$P(@HLDAT@("RPAR0"),U,2)="W",$P(@HLDAT@("RPAR0"),U,7)=$P($P($P(DATA,ORFS,20),ORRS,3),ORCS,2)
.S $P(@HLDAT@("RPAR0"),U,17)=$P($P($P(DATA,ORFS,20),ORRS,4),ORCS,2)
S $P(@HLDAT@("ROR1"),U,5)=$P($P($P(DATA,ORFS,20),ORRS,5),ORCS,2)
S @HLDAT@("RXSTA")=$P($P(DATA,ORFS,26),ORCS),@HLDAT@("RXSTA2")=$P($P(DATA,ORFS,26),ORCS,2)
S @HLDAT@("PATST")=$P($P(DATA,ORFS,26),ORCS,4)
; HOST INFO
; P1 - NAME, P2 - ADDRESS~~CITY~STATE~ZIP, P3 - PHONE NUMBER, P4 - HOST SITE NUMBER
S $P(DATA,ORFS,23)=$P($P(DATA,ORFS,23),ORSS)_ORSS_$P($P(DATA,ORFS,23),ORSS,3,5)
S @HLDAT@("HINFO")=$P($P(DATA,ORFS,22),ORCS)_U_$P(DATA,ORFS,23)_U_$P(DATA,ORFS,24)
S $P(@HLDAT@("HINFO"),U,4)=RXSITE
S $P(@HLDAT@("HINFO"),U,5)=$P($P($P(DATA,ORFS,22),ORCS,8),ORSS,2) ;Clinic
S PSOHLSV("PROVIDER")=RPROV
Q
REFRXD(DATA,HLDAT,TYPE) ;
N QTY,DSUPP,DNAME,HINFO,SIG1D,SIGDAT,SIGNUM,SIGTXT,I
S ($P(@HLDAT@(1),U,7),$P(@HLDAT@("RX0"),U,7))=$P(DATA,ORFS,5) ; quantity
S $P(@HLDAT@(1),U,8)=$P(DATA,ORFS,4) ; dispense date
S $P(@HLDAT@(1),U,9)=$P($P(DATA,ORFS,3),ORCS,1) ; drug name
S ($P(@HLDAT@(1),U,10),$P(@HLDAT@("RX0"),U,8))=$P(DATA,ORFS,12) ; days supply
S ($P(@HLDAT@("RX0"),U,9),PSOHLSV("# OF REFILLS"))=$P(DATA,ORFS,9),$P(@HLDAT@("RX0"),U,11)="W"
S $P(@HLDAT@("RX0"),U,18)=$P(DATA,ORFS,23) ; Copies
S ($P(@HLDAT@("RX2"),U,6),PSOHLSV("EXP DT"))=$P(DATA,ORFS,20) ; Rx Expiration Date
S PSOHLSV("ROUTING")="WINDOW" ;All OneVA fills are Window
S PSOHLSV("CAP")=$P($P(DATA,ORFS,15),"~",2) ;Safety Cap
S PSOHLSV("HOST RX LOG IEN")=$P($P(DATA,ORFS,8),":",5)
S PSOHLSV("TOTAL FILLS")=PSOHLSV("# OF REFILLS")+1
;
I TYPE="RF" D
.S $P(@HLDAT@("RREF0"),U,4)=$P(DATA,ORFS,5),$P(@HLDAT@("RREF0"),U,10)=$P(DATA,ORFS,12)
.S (@HLDAT@("RFIEN"),PSOHLSV("HOST RFIEN"))=$P($P(DATA,ORFS,8),":",3)
I TYPE="PR" D
.S $P(@HLDAT@("RPAR0"),U,4)=$P(DATA,ORFS,5),$P(@HLDAT@("RPAR0"),U,10)=$P(DATA,ORFS,12)
.S (@HLDAT@("PARIEN"),PSOHLSV("HOST PARIEN"))=$P($P(DATA,ORFS,8),":",3)
;
S @HLDAT@("RSIG")=$P($P($P(DATA,ORFS,16),ORRS,1),ORCS,2)_U_$P($P($P(DATA,ORFS,16),ORRS,1),ORCS)
S @HLDAT@("RIEN")=$P($P(DATA,ORFS,8),":")
;I '$P($G(@HLDAT@("RSIG")),U,2) Q
S SIG1D=0
F I=2:1 D Q:SIG1D
.S SIGDAT=$P($P(DATA,ORFS,16),ORRS,I) I SIGDAT']"" S SIG1D=1 Q
.S SIGNUM=$P(SIGDAT,ORCS),SIGNUM=$P(SIGNUM,"_",2),SIGTXT=$P(SIGDAT,ORCS,2) Q:'SIGNUM
.S (@HLDAT@("RSIG1",SIGNUM),PSOHLSV("SIG",SIGNUM))=SIGTXT
Q
PSORPH(DUZ) ;
I $D(^XUSEC("PSORPH",DUZ)) Q 1
Q 0
;
MESS(PSSMTYPE) ;
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
W !,"The OneVA "_$S(PSSMTYPE:"partial fill",1:"refill")_" cannot be sent to the Outpatient Pharmacy Automation"
W !,"Interface (OPAI) to be filled by the Automated Dispensing Device (ADD)."
w !,"Both your site and the remote site must have this capability available"
W !,"at the same time. The remote site does not have this capability yet."
W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORRX2 8626 printed Apr 09, 2024@21:26:51 Page 2
PSORRX2 ;AITC/BWF - Remote RX driver ;8/30/16 12:00am
+1 ;;7.0;OUTPATIENT PHARMACY;**454,479,497,541,643,728**;DEC 1997;Build 5
+2 ;
+3 QUIT
+4 ; read response from refill site
READMSG(HLDAT,TYPE,LOCDRUG) ;
+1 ;*541 - WAIT TO ALLOW THE HOST SITE TO COMPLETE THE PROCESSING OF THE REFILL REQUEST AND SEND OVER THE LABEL INFO
HANG 3
+2 NEW ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,OREMSG1,OREMSG2,ORSMSG,GBLLOC,LBLOOP,LBTXT,LBLOVF,DIR,ORERR,MSGDONE,MSGCNT,MSGTXT,PSORXMM,PSO59P02
+3 SET ORFS="^"
SET ORCS=$EXTRACT($GET(HL("ECH")),1)
SET ORRS=$EXTRACT($GET(HL("ECH")),2)
SET ORES=$EXTRACT($GET(HL("ECH")),3)
SET ORSS=$EXTRACT($GET(HL("ECH")),4)
+4 SET TYPE=$GET(TYPE,"")
+5 SET HLQUIT=0
SET ORQUIT=""
SET OREMSG1=""
SET OREMSG2=""
SET ORERR=""
+6 FOR
XECUTE HLNEXT
if HLQUIT'>0!(ORQUIT'="")
QUIT
Begin DoDot:1
+7 NEW LOOP
+8 SET LOOP=0
FOR
SET LOOP=$ORDER(HLNODE(LOOP))
if LOOP=""
QUIT
SET HLNODE=HLNODE_HLNODE(LOOP)
+9 IF $EXTRACT(HLNODE,1,3)="MSA"&($PIECE(HLNODE,ORFS,2)'="AA")
SET ORERR=$PIECE(HLNODE,ORFS,4)
+10 IF $EXTRACT(HLNODE,1,3)="ERR"
SET OREMSG1=$PIECE(HLNODE,ORFS,9)
+11 IF $EXTRACT(HLNODE,1,3)="NTE"
Begin DoDot:2
+12 DO REFNTE(.HLNODE,.HLDAT)
+13 SET ORSMSG=$PIECE(@HLDAT@(1),ORFS)
End DoDot:2
+14 IF $EXTRACT(HLNODE,1,3)="PID"
Begin DoDot:2
+15 SET @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
+16 DO REFPID(.HLNODE,.HLDAT)
End DoDot:2
+17 IF $EXTRACT(HLNODE,1,3)="ORC"
Begin DoDot:2
+18 ;;*541 ;COMPARE THE SELECTED RX# WITH THE RX# RETURNED IN THE HL7 RECORD - IF MATCHES, CONTINUE PROCESSING
+19 ;IF THE RX#'S DO NOT MATCH, DISPLAY MESSAGE AND QUIT PROCESSING
+20 ;SEND THIS INFO TO THE ERROR TRAP SO FURTHER RESEARCH CAN BE DONE TO FIND THE ROOT CAUSE OF THIS
+21 ;*541
IF $GET(RRXNUM)
IF $GET(RRXNUM)'=$PIECE($PIECE(HLNODE,ORFS,3),ORCS)
Begin DoDot:3
+22 ;*541
SET ORERR="Label interrupted due to HL7 message corruption."
+23 ;541
SET ORERR(1)="Please request a Partial Fill in order to generate a reprint label."
+24 ;*541
DO APPERROR^%ZTER("MISMATCH RX")
+25 ;*541
SET PSORXMM=1
End DoDot:3
+26 ;*541
IF $GET(PRXNUM)
IF $GET(PRXNUM)'=$PIECE($PIECE(HLNODE,ORFS,3),ORCS)
Begin DoDot:3
+27 ;*541
SET ORERR="Label interrupted due to HL7 message corruption."
+28 ;541
SET ORERR(1)="Please request a Partial Fill in order to generate a reprint label."
+29 ;*541
DO APPERROR^%ZTER("MISMATCH RX")
+30 ;*541
SET PSORXMM=1
End DoDot:3
+31 DO REFORC(.HLNODE,.HLDAT,TYPE)
End DoDot:2
+32 IF $EXTRACT(HLNODE,1,3)="RXD"
Begin DoDot:2
+33 DO REFRXD(.HLNODE,.HLDAT,TYPE)
End DoDot:2
End DoDot:1
+34 IF '$LENGTH(ORERR)
IF '$LENGTH(OREMSG1)
Begin DoDot:1
+35 IF '$DATA(@HLDAT)
SET ORERR="No data was returned from the target vista."
QUIT
+36 IF '$DATA(@HLDAT@("FLAG"))
DO MESS($SELECT($GET(PRXNUM):1,1:0))
+37 WRITE !!,"TRANSACTION SUCCESSFUL... The "_$SELECT($GET(PRXNUM):"partial ",1:"refill ")_"for RX #"_RRXNUM_" has been recorded on"
+38 WRITE !,"the prescription at the host system."
+39 WRITE !!,"Select a printer to generate the label or '^' to bypass printing.",!
+40 DO LOGDATA^PSORWRAP(.HLDAT,TYPE,LOCDRUG,"",,$GET(PSOHLSV("HOST RFIEN")),$GET(PSOHLSV("HOST PARIEN")))
End DoDot:1
+41 IF $LENGTH(ORERR)
Begin DoDot:1
+42 NEW PSOERR
+43 ; no need to rebuild worklist
KILL PSORRBLD
+44 ; This error is returned if patch is not installed at remote/host site. Making it more user friendly.
IF ORERR="Invalid Receiving Application"
SET ORERR="OneVA software not installed at host site"
+45 WRITE !!,ORERR
+46 ;541
IF $DATA(ORERR)=11
FOR PSOERR=1:1
WRITE !
if '$DATA(ORERR(PSOERR))
QUIT
WRITE ORERR(PSOERR)
+47 SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
+48 DO ^DIR
+49 ;*541
IF $GET(PSORXMM)
Begin DoDot:2
+50 WRITE !!,"The "_$SELECT($GET(PRXNUM):"partial ",1:"refill ")_"for RX #"_RRXNUM_" has been recorded on the prescription"
+51 WRITE !,"at the host system.",!
+52 DO LOGDATA^PSORWRAP(.HLDAT,TYPE,LOCDRUG,"")
End DoDot:2
End DoDot:1
+53 IF OREMSG1'=""
Begin DoDot:1
+54 ; no need to rebuild worklist
KILL PSORRBLD
+55 WRITE !!,OREMSG1_". "_$SELECT($LENGTH(OREMSG2):OREMSG2_".",1:""),!
+56 IF '$DATA(ORSMSG)
SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
End DoDot:1
+57 IF $DATA(ORSMSG)
Begin DoDot:1
+58 IF '$GET(PSORXMM)
Begin DoDot:2
+59 SET MSGDONE=0
+60 FOR MSGCNT=1:1
Begin DoDot:3
+61 SET MSGTXT=$PIECE(ORSMSG,"|",MSGCNT)
IF MSGTXT']""
SET MSGDONE=1
QUIT
+62 WRITE !,MSGTXT
End DoDot:3
if MSGDONE
QUIT
End DoDot:2
+63 SET DIR(0)="FO"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
End DoDot:1
+64 QUIT
+65 ; HLDAT(1)=MESSAGE^PATIENT DFN^RX NUMBER^REMOTE SITE#^FILL/PARTIAL DATE^PHARMACIST NAME^QUANTITY^DISPENSE DATE^DRUG NAME^DAYS SUPPLY
REFNTE(DATA,HLDAT) ;
+1 ; Message details
+2 NEW NTETYP,NTETEXT,NTETYPE,I,PSONRDAT,PSONR,PSONRNUM,PSONRTXT,PSOSUB,PSOSUBX
+3 SET NTETYPE=$PIECE(DATA,ORFS,3)
+4 SET NTETEXT=$PIECE(DATA,ORFS,4)
+5 IF NTETYPE="L"
Begin DoDot:1
+6 IF $LENGTH($PIECE($GET(@HLDAT@(1)),U))
SET $PIECE(@HLDAT@(1),U)=$PIECE($GET(@HLDAT@(1)),U)_"|"_NTETEXT
QUIT
+7 SET $PIECE(@HLDAT@(1),U)=NTETEXT
End DoDot:1
+8 IF NTETYPE="O"
Begin DoDot:1
+9 SET @HLDAT@("LBL",$ORDER(@HLDAT@("LBL",""),-1)+1)=NTETEXT
End DoDot:1
+10 IF NTETYPE=""
Begin DoDot:1
+11 IF NTETEXT["PATCH INSTALLED FLAG"
SET @HLDAT@("FLAG",1)=NTETEXT
QUIT
+12 SET @HLDAT@("NARR",$ORDER(@HLDAT@("NARR",""),-1)+1)=NTETEXT
End DoDot:1
+13 QUIT
+14 ;
REFPID(DATA,HLDAT) ;
+1 ; patient IEN from remote site
+2 SET $PIECE(@HLDAT@(1),U,2)=$PIECE($PIECE($PIECE(DATA,ORFS,4),ORCS,11),ORRS,2)
+3 QUIT
+4 ;
REFORC(DATA,HLDAT,TYPE) ;
+1 NEW RXNUM,RXSITE,RXDATE,PHARMLN,PHARMFN,REQSITE,PHONE,PHNAME,PNAME,RPDATE,RPROV
+2 SET RXNUM=$PIECE($PIECE(DATA,ORFS,3),ORCS)
+3 SET RXSITE=$PIECE($PIECE(DATA,ORFS,14),ORCS,4)
+4 SET RPDATE=$PIECE(DATA,ORFS,10)
+5 SET RPROV=$PIECE(DATA,ORFS,12)
+6 SET PHNAME=$PIECE(DATA,ORFS,11)
+7 SET $PIECE(@HLDAT@(1),U,3)=RXNUM
+8 SET $PIECE(@HLDAT@(1),U,4)=RXSITE
+9 SET $PIECE(@HLDAT@(1),U,5)=RPDATE
+10 SET $PIECE(@HLDAT@(1),U,6)=PHNAME
+11 SET $PIECE(@HLDAT@("RX0"),U)=RXNUM
SET $PIECE(@HLDAT@("RX0"),U,2)=DFN
SET $PIECE(@HLDAT@("RX0"),U,5)=$PIECE($PIECE($PIECE(DATA,ORFS,22),ORCS,8),ORSS,2)
SET $PIECE(@HLDAT@("RX0"),U,6)=LOCDRUG
+12 SET $PIECE(@HLDAT@("RX0"),U,4)=$PIECE($PIECE($PIECE(DATA,ORFS,20),ORRS,1),ORCS,2)
+13 SET PSOHLSV("ORIG FILL DT")=$PIECE(DATA,ORFS,15)
+14 SET ($PIECE(@HLDAT@("RX0"),U,13),PSOHLSV("ISSUED DT"))=$PIECE(DATA,ORFS,16)
SET $PIECE(@HLDAT@("RX0"),U,19)=""
+15 ; don't forget copies in p18, if needed
+16 SET $PIECE(@HLDAT@("RX2"),U,2)=RPDATE
SET $PIECE(@HLDAT@("RX2"),U,10)=$PIECE($PIECE($PIECE(DATA,ORFS,20),ORRS,2),ORCS,2)
+17 SET $PIECE(@HLDAT@("RX3"),U)=$PIECE(DATA,ORFS,28)
+18 IF TYPE="RF"
Begin DoDot:1
+19 SET $PIECE(@HLDAT@("RREF0"),U)=RPDATE
SET $PIECE(@HLDAT@("RREF0"),U,2)="W"
SET $PIECE(@HLDAT@("RREF0"),U,7)=$PIECE($PIECE($PIECE(DATA,ORFS,20),ORRS,3),ORCS,2)
+20 SET $PIECE(@HLDAT@("RREF0"),U,17)=$PIECE($PIECE($PIECE(DATA,ORFS,20),ORRS,4),ORCS,2)
End DoDot:1
+21 IF TYPE="PR"
Begin DoDot:1
+22 SET $PIECE(@HLDAT@("RPAR0"),U)=RPDATE
SET $PIECE(@HLDAT@("RPAR0"),U,2)="W"
SET $PIECE(@HLDAT@("RPAR0"),U,7)=$PIECE($PIECE($PIECE(DATA,ORFS,20),ORRS,3),ORCS,2)
+23 SET $PIECE(@HLDAT@("RPAR0"),U,17)=$PIECE($PIECE($PIECE(DATA,ORFS,20),ORRS,4),ORCS,2)
End DoDot:1
+24 SET $PIECE(@HLDAT@("ROR1"),U,5)=$PIECE($PIECE($PIECE(DATA,ORFS,20),ORRS,5),ORCS,2)
+25 SET @HLDAT@("RXSTA")=$PIECE($PIECE(DATA,ORFS,26),ORCS)
SET @HLDAT@("RXSTA2")=$PIECE($PIECE(DATA,ORFS,26),ORCS,2)
+26 SET @HLDAT@("PATST")=$PIECE($PIECE(DATA,ORFS,26),ORCS,4)
+27 ; HOST INFO
+28 ; P1 - NAME, P2 - ADDRESS~~CITY~STATE~ZIP, P3 - PHONE NUMBER, P4 - HOST SITE NUMBER
+29 SET $PIECE(DATA,ORFS,23)=$PIECE($PIECE(DATA,ORFS,23),ORSS)_ORSS_$PIECE($PIECE(DATA,ORFS,23),ORSS,3,5)
+30 SET @HLDAT@("HINFO")=$PIECE($PIECE(DATA,ORFS,22),ORCS)_U_$PIECE(DATA,ORFS,23)_U_$PIECE(DATA,ORFS,24)
+31 SET $PIECE(@HLDAT@("HINFO"),U,4)=RXSITE
+32 ;Clinic
SET $PIECE(@HLDAT@("HINFO"),U,5)=$PIECE($PIECE($PIECE(DATA,ORFS,22),ORCS,8),ORSS,2)
+33 SET PSOHLSV("PROVIDER")=RPROV
+34 QUIT
REFRXD(DATA,HLDAT,TYPE) ;
+1 NEW QTY,DSUPP,DNAME,HINFO,SIG1D,SIGDAT,SIGNUM,SIGTXT,I
+2 ; quantity
SET ($PIECE(@HLDAT@(1),U,7),$PIECE(@HLDAT@("RX0"),U,7))=$PIECE(DATA,ORFS,5)
+3 ; dispense date
SET $PIECE(@HLDAT@(1),U,8)=$PIECE(DATA,ORFS,4)
+4 ; drug name
SET $PIECE(@HLDAT@(1),U,9)=$PIECE($PIECE(DATA,ORFS,3),ORCS,1)
+5 ; days supply
SET ($PIECE(@HLDAT@(1),U,10),$PIECE(@HLDAT@("RX0"),U,8))=$PIECE(DATA,ORFS,12)
+6 SET ($PIECE(@HLDAT@("RX0"),U,9),PSOHLSV("# OF REFILLS"))=$PIECE(DATA,ORFS,9)
SET $PIECE(@HLDAT@("RX0"),U,11)="W"
+7 ; Copies
SET $PIECE(@HLDAT@("RX0"),U,18)=$PIECE(DATA,ORFS,23)
+8 ; Rx Expiration Date
SET ($PIECE(@HLDAT@("RX2"),U,6),PSOHLSV("EXP DT"))=$PIECE(DATA,ORFS,20)
+9 ;All OneVA fills are Window
SET PSOHLSV("ROUTING")="WINDOW"
+10 ;Safety Cap
SET PSOHLSV("CAP")=$PIECE($PIECE(DATA,ORFS,15),"~",2)
+11 SET PSOHLSV("HOST RX LOG IEN")=$PIECE($PIECE(DATA,ORFS,8),":",5)
+12 SET PSOHLSV("TOTAL FILLS")=PSOHLSV("# OF REFILLS")+1
+13 ;
+14 IF TYPE="RF"
Begin DoDot:1
+15 SET $PIECE(@HLDAT@("RREF0"),U,4)=$PIECE(DATA,ORFS,5)
SET $PIECE(@HLDAT@("RREF0"),U,10)=$PIECE(DATA,ORFS,12)
+16 SET (@HLDAT@("RFIEN"),PSOHLSV("HOST RFIEN"))=$PIECE($PIECE(DATA,ORFS,8),":",3)
End DoDot:1
+17 IF TYPE="PR"
Begin DoDot:1
+18 SET $PIECE(@HLDAT@("RPAR0"),U,4)=$PIECE(DATA,ORFS,5)
SET $PIECE(@HLDAT@("RPAR0"),U,10)=$PIECE(DATA,ORFS,12)
+19 SET (@HLDAT@("PARIEN"),PSOHLSV("HOST PARIEN"))=$PIECE($PIECE(DATA,ORFS,8),":",3)
End DoDot:1
+20 ;
+21 SET @HLDAT@("RSIG")=$PIECE($PIECE($PIECE(DATA,ORFS,16),ORRS,1),ORCS,2)_U_$PIECE($PIECE($PIECE(DATA,ORFS,16),ORRS,1),ORCS)
+22 SET @HLDAT@("RIEN")=$PIECE($PIECE(DATA,ORFS,8),":")
+23 ;I '$P($G(@HLDAT@("RSIG")),U,2) Q
+24 SET SIG1D=0
+25 FOR I=2:1
Begin DoDot:1
+26 SET SIGDAT=$PIECE($PIECE(DATA,ORFS,16),ORRS,I)
IF SIGDAT']""
SET SIG1D=1
QUIT
+27 SET SIGNUM=$PIECE(SIGDAT,ORCS)
SET SIGNUM=$PIECE(SIGNUM,"_",2)
SET SIGTXT=$PIECE(SIGDAT,ORCS,2)
if 'SIGNUM
QUIT
+28 SET (@HLDAT@("RSIG1",SIGNUM),PSOHLSV("SIG",SIGNUM))=SIGTXT
End DoDot:1
if SIG1D
QUIT
+29 QUIT
PSORPH(DUZ) ;
+1 IF $DATA(^XUSEC("PSORPH",DUZ))
QUIT 1
+2 QUIT 0
+3 ;
MESS(PSSMTYPE) ;
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 WRITE !,"The OneVA "_$SELECT(PSSMTYPE:"partial fill",1:"refill")_" cannot be sent to the Outpatient Pharmacy Automation"
+3 WRITE !,"Interface (OPAI) to be filled by the Automated Dispensing Device (ADD)."
+4 WRITE !,"Both your site and the remote site must have this capability available"
+5 WRITE !,"at the same time. The remote site does not have this capability yet."
+6 WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
WRITE !
+7 QUIT
