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

PSORRPA1.m

Go to the documentation of this file. 
  1. PSORRPA1 ;AITC/BWF - remote partial prescriptions ;12/12/16 3:21pm
  1.  ;;7.0;OUTPATIENT PHARMACY;**454,475,497,643,740**;DEC 1997;Build 18
  1.  ;
  1.  ;External references L,UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
  1.  ;External reference to ^PSDRUG supported by DBIA 221
  1.  ;External reference to ^DD(52 supported by DBIA 999
  1.  ; bwf - Modified copy of PSORXPA1
  1.  ; bwf - 2/24/14 adding PAR refill tag for API usage.
  1.  ; VALMSG  - return data for remote facility
  1.  ; RXNUM   - rx number
  1.  ; PFDATE  - Partial Fill Date
  1.  ; MW      - Mail or Window
  1.  ; QTY     - Quantity
  1.  ; DSUPP   - Days Supply
  1.  ; REMARKS - Remarks entered by 'remote' (filling) facility.
  1.  ; PHARM   - Remote pharmacist's name
  1.  ; PHONE   - remote pharmacists phone number
  1.  ; SITE    - remote filling site.
  1.  ;
  1. PAR(VALMSG,RXNUM,PFDATE,MW,QTY,DSUPP,REMARKS,PHARM,PHONE,SITE,RX0,RX2,RXSTA,RPROV,RSIG,RPAR0,ROR1,RX3,RREF0) ;
  1.  N RRXIEN,PSOPAR,ORN,PSOLST,XTMPLOC,PASSLOC,HFSIEN,FULLPTH,HFSDONE,PTHDAT,PTHPIECE,DEL,DELARR,FTGOPEN,FOUND,FTGSTRT,FTGOPEN,STATION,HDRUG
  1.  N PERR,PDIR,PFIL,CSVAL,C,D,E,NEWPFIEN,PFIEN,PFIENS,PSOEXREP,PSOFROM,DINACT,PSOPHDUZ,PSODFDIR,PSOFNAME,PSOZ1,RREFIEN,CLOZVAL,NOONEVA
  1.  S $ETRAP="D ^%ZTER Q"
  1.  S (RRXIEN,RXN)=$O(^PSRX("B",RXNUM,0)),PSOSIEN=$$GET1^DIQ(52,RRXIEN,20,"I")
  1.  I '$$GET1^DIQ(59.7,1,101,"I") D  Q
  1.  .S VALMSG(1)="The OneVA pharmacy flag is turned 'OFF' at this facility."
  1.  .S VALMSG(2)="Unable to process refill/partial fill requests."
  1.  .D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
  1.  ; PSO*7*497 - trade name block
  1.  I $$GET1^DIQ(52,RRXIEN,6.5,"E")]"" D  Q
  1.  .D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
  1.  .S VALMSG(1)="This prescription cannot be refilled or partial filled because it has a value"
  1.  .S VALMSG(2)="entered in the Rx trade name field.  Please follow local policy for obtaining"
  1.  .S VALMSG(3)="a new prescription."
  1.  ; PSO*7*497 - end trade name block
  1.  S HDRUG=$$GET1^DIQ(52,RRXIEN,6,"I")
  1.  I '$$VALIDDRUG(HDRUG) D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE) Q
  1.  I $D(^PSRX(RRXIEN,"ADP",PFDATE,RRXIEN)) S VALMSG(1)="A partial fill already exists for "_$$FMTE^XLFDT(PFDATE,"5D")_".",VALMSG(2)="Partial cannot be processed" D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE) Q
  1.  S PSOPAR=$G(^PS(59,PSOSIEN,1)),PSOSITE=PSOSIEN
  1.  ; set up PSOLST
  1.  S ORN=1,PSOLST(ORN)=52_U_RRXIEN_U_U
  1.  S PSOPHDUZ=$$GET1^DIQ(52,RRXIEN,23,"I") I 'PSOPHDUZ S PSOPHDUZ=.5
  1.  S PSORPDFN=+$P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^",2)
  1.  S DA=$P(PSOLST(ORN),"^",2),RX0=^PSRX(DA,0),J=DA,RX2=$G(^(2)),R3=$G(^(3)) S:'$G(BBFLG) BBRX(1)=""
  1.  N PSORF,PSOTRIC D TRIC^PSORXL1(DA) I PSOTRIC&($$STATUS^PSOBPSUT(DA,PSORF)'["PAYABLE") D  Q
  1.  . S VALMSG(1)="Partial cannot be filled on Tricare non-payable Rx."
  1.  . D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
  1.  I +$P($G(^PSRX(DA,2)),"^",6)<DT D
  1.  .S:$P($G(^PSRX(DA,"STA")),"^")<12 $P(^PSRX(DA,"STA"),"^")=11
  1.  .S COMM="Medication Expired on "_$E($P(^PSRX(DA,2),"^",6),4,5)_"/"_$E($P(^(2),"^",6),6,7)_"/"_$E($P(^(2),"^",6),2,3)
  1.  .S STAT="SC",PHARMST="ZE" D EN^PSOHLSN1(DA,STAT,PHARMST,COMM) K STAT,PHARMST,COMM,RX0,J,RX2,R3
  1.  I +^PSRX(DA,"STA"),+^("STA")'=5,+^("STA")'=11 D  K DA D ULK Q
  1.  .S C=";"_+^PSRX(DA,"STA")_":",X=$P(^DD(52,100,0),"^",3),E=$F(X,C),D=$P($E(X,E,999),";")   ;IA#999
  1.  .S VALMSG(1)="Prescription is in a "_D_" status."
  1.  .D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
  1.  I $G(PSXSYS),($O(^PS(52.5,"B",DA,""))) S PSOZ1=$O(^PS(52.5,"B",DA,"")) D
  1.  .I $P($G(^PS(52.5,PSOZ1,0)),"^",7)="Q"!($P($G(^(0)),"^",7)="L") D
  1.  ..S VALMSG(1)="A partial entered for this Rx cannot be suspended."
  1.  ..S VALMSG(2)="A fill for this Rx is already suspended for CMOP transmission."
  1.  ..S VALMSG(3)="You may pull this fill from suspense or enter a partial and print the label."
  1.  ..D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
  1. CLC S PSOCLC=PSOPHDUZ,PHYS=$P(^PSRX(DA,0),"^",4),DRG=$P(^(0),"^",6)
  1.  I 'PHYS,$O(^PSRX(DA,1,0)) F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I  S PHYS=$S($P(^PSRX(DA,1,I,0),"^",17):$P(^PSRX(DA,1,I,0),"^",17),1:PHYS)
  1.  S PSOPRZ=0 I $O(^PSRX(DA,"P",0)) N Z2 F Z2=0:0 S Z2=$O(^PSRX(DA,"P",Z2)) Q:'Z2  S PSOPRZ=Z2
  1.  I $D(RXPR(DA)),'$D(^PSRX(DA,"P",$G(RXPR(DA)))) D RMP^PSOCAN3
  1.  ; bwf - save information into database, just as it would be through ^DIE
  1.  S FDA(52.2,"+1,"_RRXIEN_",",.01)=PFDATE D UPDATE^DIE(,"FDA","NEWPFIEN","PERR") K FDA
  1.  I $D(PERR) M VALMSG=PERR
  1.  S PFIEN=$O(NEWPFIEN(0)),PFIEN=$G(NEWPFIEN(PFIEN))
  1.  ; set Z1 variable as was done in the ^DIE call for later use.
  1.  S Z1=PFIEN
  1.  S PFIENS=PFIEN_","_RRXIEN_","
  1.  ; set PM variable as was done in the ^DIE call for later use.
  1.  I MW="M"!('$P($G(PSOPAR),U,12)) S PM=1
  1.  S FDA(52.2,PFIENS,.02)=MW
  1.  S FDA(52.2,PFIENS,.04)=QTY
  1.  S FDA(52.2,PFIENS,.041)=DSUPP
  1.  ; currently we have no local pharmacist. May need to add entry to file 200 for 'REMOTE,PHARMACIST' or 'PHARMACIST,REMOTE'
  1.  S FDA(52.2,PFIENS,.05)=PSOPHDUZ
  1.  ; can we use DUZ as the clerk code, or will this need another value??
  1.  S FDA(52.2,PFIENS,.07)=PSOPHDUZ
  1.  S FDA(52.2,PFIENS,6)=PHYS
  1.  S FDA(52.2,PFIENS,.08)=$$NOW^XLFDT
  1.  S FDA(52.2,PFIENS,.09)=PSOSITE
  1.  S FDA(52.2,PFIENS,.03)=REMARKS
  1.  ;
  1.  ; setting the partial fill date to the dispense date to match the 
  1.  ; HL7 response
  1.  S FDA(52.2,PFIENS,7.5)=PFDATE
  1.  ;
  1.  S RXPR(RRXIEN)=PFIEN,PSOZZ=1,PRMK=REMARKS
  1.  ; file the rest of the data onto the newly created multiple.
  1.  D FILE^DIE(,"FDA") K FDA
  1.  I Z1,$G(PRMK)]"" D  D:$T(EN^PSOHDR)]"" EN^PSOHDR("PPAR",RXN) K DIE,RXN,RXF
  1.  .D ACT
  1.  .S ZD(RXN)=+^PSRX(RXN,"P",Z1,0),^PSRX(RXN,"TYPE")=Z1,$P(^PSRX(RXN,"P",Z1,0),"^",11)=$P($G(^PSDRUG(DRG,660)),"^",6)
  1.  S:'$D(PSOFROM) PSOFROM="PARTIAL" S BINGCRT=1 ;D:$D(BINGRTE)&($D(DISGROUP)) ^PSOBING1 K BINGRTE,TM,TM1
  1.  ; bwf 8/14/14 - set up needed variables for label printing
  1.  S PSODFN=$P(^PSRX(RRXIEN,0),U,2)
  1.  S PSORX("PSOL",1)=RRXIEN_","
  1.  S PSORX("MAIL/WINDOW")="WINDOW"
  1.  S PSORX("NAME")=$$GET1^DIQ(2,PSODFN,.01)
  1.  S PSORX("QFLG")=0
  1.  S PSORX("METHOD OF PICKUP")=""
  1.  S PSOX=$G(^PS(55,PSODFN,"PS")) I PSOX]"" S PSORX("PATIENT STATUS")=$P($G(^PS(53,PSOX,0)),"^")
  1.  N PPL1
  1.  S PPL1=RRXIEN
  1.  S HFSDONE=0,PTHDAT=""
  1.  S PSODFDIR=$$DEFDIR^%ZISH()
  1.  S PSOFNAME="PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT"
  1.  S FULLPTH=PSODFDIR_PSOFNAME
  1.  ; bwf 8/14/14 - end setup for label printing.
  1.  ; preserve IO
  1.  D SAVDEV^%ZISUTL("ONEVAHLIO")
  1.  ; delete the file first to ensure there isn't one lingering around
  1.  S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSODFDIR,$NA(DELARR))
  1.  S PSOEXREP=1
  1.  ; call out to generate label
  1.  D LABEL^PSORWRAP(RRXIEN,"HFS",PSOSITE,PSOPHDUZ,"",PSOFNAME)
  1.  S XTMPLOC="^XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_",1,0)"
  1.  S PASSLOC="XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_")"
  1.  K ^XTMP("PSORLBL",HLINSTN,+RXNUM)
  1.  S ^XTMP("PSORLBL",HLINSTN,+RXNUM,0)=DT_U_$$FMADD^XLFDT(DT,30)
  1.  ; looks like we have to wait a moment before the file shows up.
  1.  S FTGSTRT=$$NOW^XLFDT,(FOUND,FTGOPEN)=0
  1.  N PAR S PAR=0
  1.  F  D  Q:$$NOW^XLFDT>$$FMADD^XLFDT(FTGSTRT,,,,15)!(FOUND)!(FTGOPEN)
  1.  .S FTGOPEN=$$FTG^%ZISH(PSODFDIR,PSOFNAME,XTMPLOC,4)
  1.  .I $O(^XTMP("PSORLBL",HLINSTN,+RXNUM,0)) S FOUND=1
  1.  S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSODFDIR,$NA(DELARR))
  1.  ; restore IO
  1.  D USE^%ZISUTL("ONEVAHLIO"),RMDEV^%ZISUTL("ONEVAHLIO")
  1.  D UPDPAR(.VALMSG,RRXIEN,PHARM,PHONE,SITE,PASSLOC)
  1.  S RX0=$G(^PSRX(RRXIEN,0)),RX2=$G(^PSRX(RRXIEN,2)),RX3=$G(^PSRX(RRXIEN,3))
  1.  S RXSTA=$G(^PSRX(RRXIEN,"STA")),RPROV=$$GET1^DIQ(200,$P(RX0,U,4),.01,"E")_U_$$GET1^DIQ(200,$P(RX0,U,16),.01,"E")
  1.  S RSIG=$G(^PSRX(RRXIEN,"SIG"))
  1.  S RPAR0=$G(^PSRX(RRXIEN,"P",PFIEN,0))
  1.  S ROR1=$G(^PSRX(RRXIEN,"OR1"))
  1.  S RREFIEN=$O(^PSRX(RRXIEN,1,"A"),-1)
  1.  I RREFIEN S RREF0=$G(^PSRX(RRXIEN,1,RREFIEN,0))
  1. CLCX D ULK K DR,DIE,DRG,PPL,RXP,IOP,DA,PHYS,PSOPRZ,PSORX,PSOSIEN,PSOSITE,PSOX,PSOZZ,PSXSYS,RXPR,ZD Q
  1.  ;
  1. KILL S DA=Z1,DIK="^PSRX("_RXN_",""P""," D ^DIK S ^PSRX(RXN,"TYPE")=0
  1.  D ULK S VALMSG(1)="No Partial Fill Dispensed" D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE) Q
  1. KL K DFN,RFDAT,RLL,%,PRMK,PM,%Y,%X,D0,D1,DA,DI,DIC,DIE,DLAYGO,DQ,DR,I,II,J,JJJ,N,PHYS,PS,PSDATE,RFL,RFL1,RXF,ST,ST0,Z,Z1,X,Y,PDT,PSL,PSNP
  1.  K PSOM,PSOP,PSOD,PSOU,DIK,DUOUT,IFN,RXN,DRG,HRX,I1,PSOCLC,PSOLIST,PSOLST,PSPAR,RXP D KVA^VADPT Q
  1. ACT ;adds activity info for partial rx
  1.  S RXF=0 F I=0:0 S I=$O(^PSRX(RRXIEN,1,I)) Q:'I  S RXF=I S:I>5 RXF=I+1
  1.  S DA=0 F FDA=0:0 S FDA=$O(^PSRX(RRXIEN,"A",FDA)) Q:'FDA  S DA=FDA
  1.  S DA=DA+1,^PSRX(RRXIEN,"A",0)="^52.3DA^"_DA_"^"_DA,^PSRX(RRXIEN,"A",DA,0)=DT_"^"_"P"_"^"_PSOPHDUZ_"^"_RXF_"^"_PRMK
  1. EX K RXF,I,FDA S DA=RXN
  1.  Q
  1. ULK ;
  1.  K PSOMSG,PSOPLCK,PSORPDFN
  1.  Q
  1. PARFAIL(PSOMSG,PSOIEN,RPHARM,RPHONE,RSITE) ;
  1.  S PSOMSG(0)=0_U_$$GET1^DIQ(52,PSOIEN,.01,"I")_U_PSOIEN,$P(PSOMSG(0),U,15)=RPHARM,$P(PSOMSG(0),U,16)=RPHONE,$P(PSOMSG(0),U,17)=RSITE
  1.  Q
  1. VALIDDRUG(DRUGIEN) ;
  1.  S DINACT=$$GET1^DIQ(50,DRUGIEN,100,"I")
  1.  I DINACT>0,($$DT^XLFDT>DINACT) S VALMSG(1)="Drug is inactive for Rx# "_RXNUM_". Cannot process partial fill." Q 0
  1.  S CSVAL=$$GET1^DIQ(50,DRUGIEN,3,"E"),CSVAL=$E(CSVAL,1)
  1.  I CSVAL,CSVAL>0,CSVAL<6 S VALMSG(1)="Rx #"_RXNUM_" cannot be partially filled. The associated drug is considered a controlled substance at the host facility." Q 0
  1.  S CLOZVAL=$$GET1^DIQ(50,DRUGIEN,17.5)  ; Clozapine Check PSO*7*740
  1.  I CLOZVAL="PSOCLO1" S VALMSG(1)="This is a Clozapine prescription.",VALMSG(2)="Cannot process a partial fill for Rx # "_RXNUM_"." Q 0
  1.  ;
  1.  S NOONEVA=$$GET1^DIQ(50,DRUGIEN,907)
  1.  I NOONEVA="YES" S VALMSG(1)="Remote Site Drug is restricted from OneVA Pharmacy processing.",VALMSG(2)="Cannot process a partial fill for Rx # "_RXNUM_"." Q 0
  1.  Q 1
  1. UPDPAR(PSOMSG,PSOIEN,RPHARM,RPHONE,RSITE,PASSLOC) ;
  1.  N PARIEN,PARIENS,PARDATA,FIL,RXNUM,RFILLDT,QTY,DSUPP,CLERK,LOGDATE,IDIV,EDIV,DISPDT,NDC,FDA,DNAME,DIEN
  1.  S FIL=52.2
  1.  ; get last partial data node
  1.  S PARIEN=$O(^PSRX(PSOIEN,"P",""),-1)
  1.  S RXNUM=$$GET1^DIQ(52,PSOIEN,.01,"E")
  1.  S DNAME=$$GET1^DIQ(52,PSOIEN,6,"E")
  1.  S DIEN=$$GET1^DIQ(52,PSOIEN,6,"I")
  1.  S PARIENS=PARIEN_","_PSOIEN_","
  1.  ; first, set in the remote pharmacist data
  1.  S FDA(52.2,PARIENS,91)=RSITE
  1.  S FDA(52.2,PARIENS,92)=RPHARM
  1.  S FDA(52.2,PARIENS,93)=RPHONE
  1.  D FILE^DIE(,"FDA","MSG") K FDA,RPHARM,RPHONE,RSITE
  1.  ; now query data and build RET(0) holding accurate information from the refill multiple
  1.  D GETS^DIQ(FIL,PARIENS,"**","IE","PARDATA")
  1.  S RFILLDT=$G(PARDATA(FIL,PARIENS,.01,"I"))
  1.  S QTY=$G(PARDATA(FIL,PARIENS,.04,"I"))
  1.  S DSUPP=$G(PARDATA(FIL,PARIENS,.041,"I"))
  1.  S CLERK=$G(PARDATA(FIL,PARIENS,.07,"E"))
  1.  S LOGDATE=$G(PARDATA(FIL,PARIENS,.08,"I"))
  1.  ; internal division number (IEN to PSO SITE file)
  1.  S IDIV=$G(PARDATA(FIL,PARIENS,.09,"I"))
  1.  S EDIV=$G(PARDATA(FIL,PARIENS,.09,"E"))
  1.  ;
  1.  ; there is nothing in this field.
  1.  ; HL7 is returning refill date in the RXD
  1.  ; but trying to log the blank dispense date from file 52.2 into 52.09
  1.  S DISPDT=$G(PARDATA(FIL,PARIENS,7.5,"I"))
  1.  ;
  1.  S NDC=$G(PARDATA(FIL,PARIENS,1,"E"))
  1.  S RSITE=$G(PARDATA(FIL,PARIENS,91,"I"))
  1.  S RPHARM=$G(PARDATA(FIL,PARIENS,92,"E"))
  1.  S RPHONE=$G(PARDATA(FIL,PARIENS,93,"E"))
  1.  S $P(DAT(1),U,3)=RXNUM,$P(DAT(1),U,4)=RSITE,$P(DAT(1),U,7)=QTY,$P(DAT(1),U,8)=DISPDT,$P(DAT(1),U,9)=DNAME,$P(DAT(1),U,10)=DSUPP,$P(DAT(1),U,11)=RPHARM,$P(DAT(1),U,12)=RFILLDT
  1.  D LOGDATA^PSORWRAP($NA(DAT),"OP",,,PSOIEN,,PARIEN)
  1.  S PSOMSG(0)=1_U_RXNUM_U_PSOIEN_U_PARIEN_U_RFILLDT_U_DNAME_U_QTY_U_DSUPP_U_CLERK_U_LOGDATE_U_IDIV_U_EDIV_U_DISPDT_U_NDC_U_RPHARM_U_RPHONE_U_RSITE_U_PASSLOC
  1.  I '$L($G(PSOMSG(1))) S PSOMSG(1)="Partial complete for RX #"_RXNUM_"."
  1.  Q
  1.  ;
  1. VALDRGINT(DRUGIEN,FILLTYP,RXNUM) ; Interactive check for drug restrictions
  1.  N DINACT,CSVAL,CLOZVAL,NOONEVA
  1.  ; Inactive
  1.  S DINACT=$$GET1^DIQ(50,DRUGIEN,100,"I")
  1.  I DINACT>0,($$DT^XLFDT>DINACT) D  Q 0
  1.  .;I FILLTYP="F" W !!,"Matched Drug "_$$GET1^DIQ(50,DRUGIEN,.01,"E")_" is inactive.",!,"Cannot refill."
  1.  .W !!,"Matched Drug "_$$GET1^DIQ(50,DRUGIEN,.01,"E")_" is inactive.",!,"Cannot "_$S(FILLTYP="R":"refill.",1:"process a partial fill.")
  1.  .Q
  1.  ; Controlled substance check
  1.  S CSVAL=$$GET1^DIQ(50,DRUGIEN,3,"E"),CSVAL=$E(CSVAL,1)
  1.  I CSVAL,CSVAL>0,CSVAL<6 D  Q 0
  1.  .;I FILLTYP="R" W !!,"This is a controlled substance. Cannot refill Rx#",RXNUM,"."
  1.  .W !!,"This is a controlled substance. Cannot "_$S(FILLTYP="R":"refill",1:"process a partial fill for")_" Rx # ",RXNUM,"."
  1.  .Q
  1.  ; Clozapine check PSO*7*740
  1.  S CLOZVAL=$$GET1^DIQ(50,DRUGIEN,17.5)
  1.  I CLOZVAL="PSOCLO1" D  Q 0
  1.  .;I FILLTYP="F" W !!,"This is a Clozapine prescription.",!,"Cannot refill Rx # ",RXNUM,"."
  1.  .W !!,"This is a Clozapine prescription.",!,"Cannot "_$S(FILLTYP="R":"refill",1:"process a partial fill for")_" Rx # ",RXNUM,"."
  1.  .Q
  1.  ;
  1.  ; Restrict for OneVA
  1.  S NOONEVA=$$GET1^DIQ(50,DRUGIEN,907)
  1.  I NOONEVA="YES" D  Q 0
  1.  .I FILLTYP="F" W !!,"Local Drug is restricted from OneVA Pharmacy processing.",!,"Cannot refill Rx # ",RXNUM,"."
  1.  .E  W !!,"Local Drug is restricted from OneVA Pharmacy processing.",!,"Cannot "_$S(FILLTYP="R":"refill",1:"process a partial fill for")_" Rx # ",RXNUM,"."
  1.  .Q
  1.  Q 1