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

PSORRX2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ; read response from refill site
  1. READMSG(HLDAT,TYPE,LOCDRUG) ;
  1.  H 3  ;*541 - WAIT TO ALLOW THE HOST SITE TO COMPLETE THE PROCESSING OF THE REFILL REQUEST AND SEND OVER THE LABEL INFO
  1.  N ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,OREMSG1,OREMSG2,ORSMSG,GBLLOC,LBLOOP,LBTXT,LBLOVF,DIR,ORERR,MSGDONE,MSGCNT,MSGTXT,PSORXMM,PSO59P02
  1.  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)
  1.  S TYPE=$G(TYPE,"")
  1.  S HLQUIT=0,ORQUIT="",OREMSG1="",OREMSG2="",ORERR=""
  1.  F  X HLNEXT Q:HLQUIT'>0!(ORQUIT'="")  D
  1.  .N LOOP
  1.  .S LOOP=0 F  S LOOP=$O(HLNODE(LOOP)) Q:LOOP=""  S HLNODE=HLNODE_HLNODE(LOOP)
  1.  .I $E(HLNODE,1,3)="MSA"&($P(HLNODE,ORFS,2)'="AA") S ORERR=$P(HLNODE,ORFS,4)
  1.  .I $E(HLNODE,1,3)="ERR" S OREMSG1=$P(HLNODE,ORFS,9)
  1.  .I $E(HLNODE,1,3)="NTE" D
  1.  ..D REFNTE(.HLNODE,.HLDAT)
  1.  ..S ORSMSG=$P(@HLDAT@(1),ORFS)
  1.  .I $E(HLNODE,1,3)="PID" D
  1.  ..S @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
  1.  ..D REFPID(.HLNODE,.HLDAT)
  1.  .I $E(HLNODE,1,3)="ORC" D
  1.  ..;;*541 ;COMPARE THE SELECTED RX# WITH THE RX# RETURNED IN THE HL7 RECORD - IF MATCHES, CONTINUE PROCESSING
  1.  ..;IF THE RX#'S DO NOT MATCH, DISPLAY MESSAGE AND QUIT PROCESSING
  1.  ..;SEND THIS INFO TO THE ERROR TRAP SO FURTHER RESEARCH CAN BE DONE TO FIND THE ROOT CAUSE OF THIS
  1.  ..I $G(RRXNUM),$G(RRXNUM)'=$P($P(HLNODE,ORFS,3),ORCS) D     ;*541
  1.  ...S ORERR="Label interrupted due to HL7 message corruption."  ;*541
  1.  ...S ORERR(1)="Please request a Partial Fill in order to generate a reprint label."  ;541
  1.  ...D APPERROR^%ZTER("MISMATCH RX")  ;*541
  1.  ...S PSORXMM=1  ;*541
  1.  ..I $G(PRXNUM),$G(PRXNUM)'=$P($P(HLNODE,ORFS,3),ORCS) D     ;*541
  1.  ...S ORERR="Label interrupted due to HL7 message corruption."  ;*541
  1.  ...S ORERR(1)="Please request a Partial Fill in order to generate a reprint label."  ;541
  1.  ...D APPERROR^%ZTER("MISMATCH RX")  ;*541
  1.  ...S PSORXMM=1  ;*541
  1.  ..D REFORC(.HLNODE,.HLDAT,TYPE)
  1.  .I $E(HLNODE,1,3)="RXD" D
  1.  ..D REFRXD(.HLNODE,.HLDAT,TYPE)
  1.  I '$L(ORERR),'$L(OREMSG1) D
  1.  .I '$D(@HLDAT) S ORERR="No data was returned from the target vista." Q
  1.  .I '$D(@HLDAT@("FLAG")) D MESS($S($G(PRXNUM):1,1:0))
  1.  .W !!,"TRANSACTION SUCCESSFUL...  The "_$S($G(PRXNUM):"partial ",1:"refill ")_"for RX #"_RRXNUM_" has been recorded on"
  1.  .W !,"the prescription at the host system."
  1.  .W !!,"Select a printer to generate the label or '^' to bypass printing.",!
  1.  .D LOGDATA^PSORWRAP(.HLDAT,TYPE,LOCDRUG,"",,$G(PSOHLSV("HOST RFIEN")),$G(PSOHLSV("HOST PARIEN")))
  1.  I $L(ORERR) D
  1.  . N PSOERR
  1.  . K PSORRBLD  ; no need to rebuild worklist
  1.  . 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.
  1.  . W !!,ORERR
  1.  . I $D(ORERR)=11 F PSOERR=1:1 W ! Q:'$D(ORERR(PSOERR))  W ORERR(PSOERR)  ;541
  1.  . S DIR(0)="FO",DIR("A")="Press RETURN to continue"
  1.  . D ^DIR
  1.  . I $G(PSORXMM) D  ;*541
  1.  .. W !!,"The "_$S($G(PRXNUM):"partial ",1:"refill ")_"for RX #"_RRXNUM_" has been recorded on the prescription"
  1.  .. W !,"at the host system.",!
  1.  .. D LOGDATA^PSORWRAP(.HLDAT,TYPE,LOCDRUG,"")
  1.  I OREMSG1'="" D
  1.  . K PSORRBLD  ; no need to rebuild worklist
  1.  . W !!,OREMSG1_". "_$S($L(OREMSG2):OREMSG2_".",1:""),!
  1.  . I '$D(ORSMSG) S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
  1.  I $D(ORSMSG) D
  1.  . I '$G(PSORXMM) D
  1.  .. S MSGDONE=0
  1.  .. F MSGCNT=1:1 D  Q:MSGDONE
  1.  ... S MSGTXT=$P(ORSMSG,"|",MSGCNT) I MSGTXT']"" S MSGDONE=1 Q
  1.  ... W !,MSGTXT
  1.  .S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
  1.  Q
  1.  ; HLDAT(1)=MESSAGE^PATIENT DFN^RX NUMBER^REMOTE SITE#^FILL/PARTIAL DATE^PHARMACIST NAME^QUANTITY^DISPENSE DATE^DRUG NAME^DAYS SUPPLY
  1. REFNTE(DATA,HLDAT) ;
  1.  ; Message details
  1.  N NTETYP,NTETEXT,NTETYPE,I,PSONRDAT,PSONR,PSONRNUM,PSONRTXT,PSOSUB,PSOSUBX
  1.  S NTETYPE=$P(DATA,ORFS,3)
  1.  S NTETEXT=$P(DATA,ORFS,4)
  1.  I NTETYPE="L" D
  1.  .I $L($P($G(@HLDAT@(1)),U)) S $P(@HLDAT@(1),U)=$P($G(@HLDAT@(1)),U)_"|"_NTETEXT Q
  1.  .S $P(@HLDAT@(1),U)=NTETEXT
  1.  I NTETYPE="O" D
  1.  .S @HLDAT@("LBL",$O(@HLDAT@("LBL",""),-1)+1)=NTETEXT
  1.  I NTETYPE="" D
  1.  .I NTETEXT["PATCH INSTALLED FLAG" S @HLDAT@("FLAG",1)=NTETEXT Q
  1.  .S @HLDAT@("NARR",$O(@HLDAT@("NARR",""),-1)+1)=NTETEXT
  1.  Q
  1.  ;
  1. REFPID(DATA,HLDAT) ;
  1.  ; patient IEN from remote site
  1.  S $P(@HLDAT@(1),U,2)=$P($P($P(DATA,ORFS,4),ORCS,11),ORRS,2)
  1.  Q
  1.  ;
  1. REFORC(DATA,HLDAT,TYPE) ;
  1.  N RXNUM,RXSITE,RXDATE,PHARMLN,PHARMFN,REQSITE,PHONE,PHNAME,PNAME,RPDATE,RPROV
  1.  S RXNUM=$P($P(DATA,ORFS,3),ORCS)
  1.  S RXSITE=$P($P(DATA,ORFS,14),ORCS,4)
  1.  S RPDATE=$P(DATA,ORFS,10)
  1.  S RPROV=$P(DATA,ORFS,12)
  1.  S PHNAME=$P(DATA,ORFS,11)
  1.  S $P(@HLDAT@(1),U,3)=RXNUM
  1.  S $P(@HLDAT@(1),U,4)=RXSITE
  1.  S $P(@HLDAT@(1),U,5)=RPDATE
  1.  S $P(@HLDAT@(1),U,6)=PHNAME
  1.  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
  1.  S $P(@HLDAT@("RX0"),U,4)=$P($P($P(DATA,ORFS,20),ORRS,1),ORCS,2)
  1.  S PSOHLSV("ORIG FILL DT")=$P(DATA,ORFS,15)
  1.  S ($P(@HLDAT@("RX0"),U,13),PSOHLSV("ISSUED DT"))=$P(DATA,ORFS,16),$P(@HLDAT@("RX0"),U,19)=""
  1.  ; don't forget copies in p18, if needed
  1.  S $P(@HLDAT@("RX2"),U,2)=RPDATE,$P(@HLDAT@("RX2"),U,10)=$P($P($P(DATA,ORFS,20),ORRS,2),ORCS,2)
  1.  S $P(@HLDAT@("RX3"),U)=$P(DATA,ORFS,28)
  1.  I TYPE="RF" D
  1.  .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)
  1.  .S $P(@HLDAT@("RREF0"),U,17)=$P($P($P(DATA,ORFS,20),ORRS,4),ORCS,2)
  1.  I TYPE="PR" D
  1.  .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)
  1.  .S $P(@HLDAT@("RPAR0"),U,17)=$P($P($P(DATA,ORFS,20),ORRS,4),ORCS,2)
  1.  S $P(@HLDAT@("ROR1"),U,5)=$P($P($P(DATA,ORFS,20),ORRS,5),ORCS,2)
  1.  S @HLDAT@("RXSTA")=$P($P(DATA,ORFS,26),ORCS),@HLDAT@("RXSTA2")=$P($P(DATA,ORFS,26),ORCS,2)
  1.  S @HLDAT@("PATST")=$P($P(DATA,ORFS,26),ORCS,4)
  1.  ; HOST INFO
  1.  ; P1 - NAME, P2 - ADDRESS~~CITY~STATE~ZIP, P3 - PHONE NUMBER, P4 - HOST SITE NUMBER
  1.  S $P(DATA,ORFS,23)=$P($P(DATA,ORFS,23),ORSS)_ORSS_$P($P(DATA,ORFS,23),ORSS,3,5)
  1.  S @HLDAT@("HINFO")=$P($P(DATA,ORFS,22),ORCS)_U_$P(DATA,ORFS,23)_U_$P(DATA,ORFS,24)
  1.  S $P(@HLDAT@("HINFO"),U,4)=RXSITE
  1.  S $P(@HLDAT@("HINFO"),U,5)=$P($P($P(DATA,ORFS,22),ORCS,8),ORSS,2)  ;Clinic
  1.  S PSOHLSV("PROVIDER")=RPROV
  1.  Q
  1. REFRXD(DATA,HLDAT,TYPE)  ;
  1.  N QTY,DSUPP,DNAME,HINFO,SIG1D,SIGDAT,SIGNUM,SIGTXT,I
  1.  S ($P(@HLDAT@(1),U,7),$P(@HLDAT@("RX0"),U,7))=$P(DATA,ORFS,5)  ; quantity
  1.  S $P(@HLDAT@(1),U,8)=$P(DATA,ORFS,4) ; dispense date
  1.  S $P(@HLDAT@(1),U,9)=$P($P(DATA,ORFS,3),ORCS,1) ; drug name
  1.  S ($P(@HLDAT@(1),U,10),$P(@HLDAT@("RX0"),U,8))=$P(DATA,ORFS,12) ; days supply
  1.  S ($P(@HLDAT@("RX0"),U,9),PSOHLSV("# OF REFILLS"))=$P(DATA,ORFS,9),$P(@HLDAT@("RX0"),U,11)="W"
  1.  S $P(@HLDAT@("RX0"),U,18)=$P(DATA,ORFS,23)  ; Copies
  1.  S ($P(@HLDAT@("RX2"),U,6),PSOHLSV("EXP DT"))=$P(DATA,ORFS,20)  ; Rx Expiration Date 
  1.  S PSOHLSV("ROUTING")="WINDOW" ;All OneVA fills are Window
  1.  S PSOHLSV("CAP")=$P($P(DATA,ORFS,15),"~",2) ;Safety Cap
  1.  S PSOHLSV("HOST RX LOG IEN")=$P($P(DATA,ORFS,8),":",5)
  1.  S PSOHLSV("TOTAL FILLS")=PSOHLSV("# OF REFILLS")+1
  1.  ;
  1.  I TYPE="RF" D
  1.  .S $P(@HLDAT@("RREF0"),U,4)=$P(DATA,ORFS,5),$P(@HLDAT@("RREF0"),U,10)=$P(DATA,ORFS,12)
  1.  .S (@HLDAT@("RFIEN"),PSOHLSV("HOST RFIEN"))=$P($P(DATA,ORFS,8),":",3)
  1.  I TYPE="PR" D
  1.  .S $P(@HLDAT@("RPAR0"),U,4)=$P(DATA,ORFS,5),$P(@HLDAT@("RPAR0"),U,10)=$P(DATA,ORFS,12)
  1.  .S (@HLDAT@("PARIEN"),PSOHLSV("HOST PARIEN"))=$P($P(DATA,ORFS,8),":",3)
  1.  ;
  1.  S @HLDAT@("RSIG")=$P($P($P(DATA,ORFS,16),ORRS,1),ORCS,2)_U_$P($P($P(DATA,ORFS,16),ORRS,1),ORCS)
  1.  S @HLDAT@("RIEN")=$P($P(DATA,ORFS,8),":")
  1.  ;I '$P($G(@HLDAT@("RSIG")),U,2) Q
  1.  S SIG1D=0
  1.  F I=2:1 D  Q:SIG1D
  1.  .S SIGDAT=$P($P(DATA,ORFS,16),ORRS,I) I SIGDAT']"" S SIG1D=1 Q
  1.  .S SIGNUM=$P(SIGDAT,ORCS),SIGNUM=$P(SIGNUM,"_",2),SIGTXT=$P(SIGDAT,ORCS,2) Q:'SIGNUM
  1.  .S (@HLDAT@("RSIG1",SIGNUM),PSOHLSV("SIG",SIGNUM))=SIGTXT
  1.  Q
  1. PSORPH(DUZ) ;
  1.  I $D(^XUSEC("PSORPH",DUZ)) Q 1
  1.  Q 0
  1.  ;
  1. MESS(PSSMTYPE) ;
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  W !,"The OneVA "_$S(PSSMTYPE:"partial fill",1:"refill")_" cannot be sent to the Outpatient Pharmacy Automation"
  1.  W !,"Interface (OPAI) to be filled by the Automated Dispensing Device (ADD)."
  1.  w !,"Both your site and the remote site must have this capability available"
  1.  W !,"at the same time. The remote site does not have this capability yet."
  1.  W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR W !
  1.  Q