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

PSOORRDI.m

Go to the documentation of this file.
  1. PSOORRDI ;BHAM-ISC/EJW - Remote Data Interoperability Order Checks ;04/25/05
  1. ;;7.0;OUTPATIENT PHARMACY;**207,243,251**;DEC 1997;Build 202
  1. ;
  1. ;External references to ^ORRDI1 supported by DBIA 4659
  1. ;External references to ^XTMP("ORRDI" supported by DBIA 4660
  1. ;External reference to ^PS(50.605 supported by DBIA 696
  1. ;External reference to ^PSDRUG supported by DBIA 221
  1. ;External reference to ^PS(56 supported by DBIA 2229
  1. ;External reference to ^PS(50.416 supported by DBIA 692
  1. ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
  1. REMOTE(PSODFN,DREN) ;
  1. ; Input: DFN: PATIENT file (#2) IEN
  1. ; : DREN: DRUG file (#50) IEN of order being checked
  1. I $T(HAVEHDR^ORRDI1)']"" Q
  1. I '$$HAVEHDR^ORRDI1 Q
  1. I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q
  1. .I $T(REMOTE^PSORX1)]"" Q
  1. .W !!,"Remote data not available - Only local order checks processed." D HD^PSODDPR2():(($Y+5)'>IOSL)
  1. I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !!,"Remote data not available - Only local order checks processed." D HD^PSODDPR2():(($Y+5)'>IOSL) Q
  1. N PSORDI,RDIINST,RDIVUID,RDIRX,RDIDNAM,RDISTA,RDISIG,RDIDAYS,RDIQTY,RDIFILL,RDIEXP,RDIISS,RDIFILL,RDIREF,RDIPHYS,PSOPROD,PSOCLASS,DRNM,RDITMP,PSODC,IT,PSOICT,NDF,RDIDI,PSOPRODA,PSOFILE,PSOSIG
  1. I '$G(DT) S DT=$$DT^XLFDT
  1. S (DD,PSORDI)=0
  1. I $T(GET^ORRDI1)]"" S PSORDI=$$GET^ORRDI1(PSODFN,"PSOO")
  1. I PSORDI<1 Q
  1. I '$D(^XTMP("ORRDI","PSOO",PSODFN)) Q
  1. K ^TMP($J,"PSORDI")
  1. D PARSE,FILTER
  1. I '$D(^TMP($J,LIST,"OUT","REMOTE")) Q
  1. ;D DRGNAME ; GET VA PRODUCT FILE NAME FOR FILE 50 DRUG BEING CHECKED
  1. S PSORDI="" F S PSORDI=$O(^TMP($J,LIST,"OUT","REMOTE",PSORDI)) Q:'PSORDI S RDITMP=^(PSORDI) D
  1. .S RDIINST=$P(RDITMP,"^")
  1. .S RDIVUID=$P(RDITMP,"^",2)
  1. .I RDIVUID="" Q
  1. .S RDIDNAM=$P(RDITMP,"^",3)
  1. .S RDISTA=$P(RDITMP,"^",4)
  1. .S RDIRX=$P(RDITMP,"^",5)
  1. .S RDIFILL=$P(RDITMP,"^",6)
  1. .S RDIDAYS=$P(RDITMP,"^",7) I $E(RDIDAYS)="D" S RDIDAYS=$P(RDIDAYS,"D",2)
  1. .S RDIQTY=$P(RDITMP,"^",8)
  1. .S RDIREF=$P(RDITMP,"^",9)
  1. .S RDIEXP=$P(RDITMP,"^",10)
  1. .S RDIPHYS=$P(RDITMP,"^",11)
  1. .S RDIISS=$P(RDITMP,"^",12)
  1. .K ^TMP($J,"PSOPROD")
  1. D REMOTE^PSODDPR5
  1. Q
  1. ;
  1. PARSE ; PULL INFORMATION FROM ^XTMP
  1. N PSORDI,LOCAL,NEWISS,BADEXP,PSOPRE,PSO30,NEWDC,NEWEXP
  1. S PSORDI=0
  1. F S PSORDI=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI)) Q:'PSORDI D
  1. .S RDISTA=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,5,0))
  1. .I RDISTA="DELETED" Q
  1. .S RDIINST=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,1,0))
  1. .S RDIDNAM=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,2,0))
  1. .S RDIVUID=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,3,0))
  1. .I RDIVUID="" Q
  1. .S RDIRX=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,4,0))
  1. .S RDIQTY=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,6,0)),RDIDAYS=$P(RDIQTY,";",2),RDIQTY=$P(RDIQTY,";")
  1. .I $E(RDIDAYS)="D" S RDIDAYS=$P(RDIDAYS,"D",2)
  1. .S RDIEXP=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,7,0))
  1. .S RDIISS=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,8,0))
  1. .I RDIEXP?."/" S BADEXP=1 D I BADEXP Q
  1. ..I RDIISS?."/" Q
  1. ..S PSOPRE=$E(DT) I $P(RDIISS,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
  1. ..S NEWISS=PSOPRE_$P(RDIISS,"/",3)_$P(RDIISS,"/")_$P(RDIISS,"/",2) I NEWISS>(DT-10000) S RDIEXP=RDIISS,BADEXP=0
  1. .I RDISTA["EXPIRE" S PSO30=0 D I PSO30 Q
  1. ..S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q
  1. ..S NEWEXP=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2)
  1. ..S X1=NEWEXP,X2=30 D C^%DTC I X<DT S PSO30=1
  1. .I RDIRX'="" S LOCAL=0 D CHKLOCAL I LOCAL Q
  1. .S RDIFILL=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,9,0))
  1. .I RDISTA["DISCONT" S PSO30=0 D I PSO30 Q
  1. ..S PSOPRE=$E(DT) I $P(RDIFILL,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q
  1. ..S NEWDC=PSOPRE_$P(RDIFILL,"/",3)_$P(RDIFILL,"/")_$P(RDIFILL,"/",2)
  1. ..S X1=NEWDC,X2=30+RDIDAYS D C^%DTC I X<DT S PSO30=1
  1. ..I RDISTA["DRUG INTERACTION" S RDISTA="NON-VERIFIED"
  1. .S RDIREF=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,10,0))
  1. .S RDIPHYS=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,11,0))
  1. .I PSODRUG("NAME")=RDIDNAM S DD=$G(DD)+1,^TMP($J,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_"^"_RDIRX_"R;O"_"^"_RDIINST D Q:'$G(PSOPHI)
  1. ..S ^TMP($J,"DD",DD,1)=RDIDNAM_"^"_RDISTA_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
  1. ..S PSOSIG="" F S PSOSIG=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,14,PSOSIG)) Q:PSOSIG="" S PSOSIG(PSOSIG)=^(PSOSIG)
  1. ..S PSOSIG="" F S PSOSIG=$O(PSOSIG(PSOSIG)) Q:PSOSIG="" S ^TMP($J,"DD",DD,1,PSOSIG)=PSOSIG(PSOSIG)
  1. ..S ^TMP($J,"PSORMDD",PSORDI,0)=1
  1. .D GETPROD
  1. .Q:$E($G(PSOCLASS),1,2)="XA"
  1. .S PSOSIG="" F S PSOSIG=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,14,PSOSIG)) Q:PSOSIG="" S PSOSIG(PSOSIG)=^(PSOSIG)
  1. .S ^TMP($J,LIST,"OUT","REMOTE",PSORDI)=RDIINST_"^"_RDIVUID_"^"_RDIDNAM_"^"_RDISTA_"^"_RDIRX_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
  1. .S PSOSIG="" F S PSOSIG=$O(PSOSIG(PSOSIG)) Q:PSOSIG="" S ^TMP($J,LIST,"OUT","REMOTE",PSORDI,"SIG",PSOSIG)=PSOSIG(PSOSIG)
  1. Q
  1. ;
  1. CHKLOCAL ; IF SAME RX NUMBER AND ISSUE DATE - LOCAL RX
  1. N PSOISS
  1. I $D(^PSRX("B",RDIRX)) D
  1. .N PSORX
  1. .S PSORX=$O(^PSRX("B",RDIRX,"")) I 'PSORX Q
  1. .S PSOISS=$P($G(^PSRX(PSORX,0)),"^",13)
  1. .S PSOISS=$E(PSOISS,4,5)_"/"_$E(PSOISS,6,7)_"/"_$E(PSOISS,2,3)
  1. .I PSOISS=RDIISS S LOCAL=1 Q
  1. Q
  1. ;
  1. VAPROD(PSOPROD) ; GET VA PRODUCT FILE NAME AND DRUG CLASS
  1. S PSOCLASS=$$DCLCODE^PSNAPIS(,PSOPROD)
  1. S DRNM=$P($$PROD0^PSNAPIS(,PSOPROD),"^")
  1. Q
  1. ;
  1. DRGNAME ;
  1. N PSOY,PSODRUG
  1. S PSOY=DREN_"^"_$P($G(^PSDRUG(DREN,0)),"^"),PSOY(0)=$G(^PSDRUG(DREN,0))
  1. S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2)
  1. S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
  1. I PSODRUG("NDF")=0 Q
  1. S PSOPROD=$P(PSODRUG("NDF"),"A",2) I PSOPROD D VAPROD(PSOPROD) S PSODRUG("NAME")=DRNM
  1. Q
  1. ;
  1. FILTER ; FOR SAME DRUG VUID FOR SAME SITE, KEEP 1 ENTRY - CHECK BY ACTIVE STATUS FIRST THEN BY GREATEST EXPIRATION DATE
  1. N XX,RDI,OLDEXP,RDIEXP,RDIEXP2,OLDEXP2,PSORDI,RDISTA,OLDSTA,OLDRDI,ZZ
  1. S PSORDI=0
  1. F S PSORDI=$O(^TMP($J,"PSORDI",PSORDI)) Q:'PSORDI D
  1. .S XX=$G(^TMP($J,"PSORDI",PSORDI)),RDIINST=$P(XX,"^"),RDIVUID=$P(XX,"^",2),RDISTA=$P(XX,"^",4),RDIEXP=$P(XX,"^",10) Q:RDIINST="" Q:RDIVUID="" I RDIEXP="" Q
  1. .I $D(RDI(RDIINST,RDIVUID)) S ZZ=RDI(RDIINST,RDIVUID) D Q
  1. ..I RDISTA="ACTIVE"!(RDISTA["SUSPEN") D Q
  1. ...S OLDSTA=$P(ZZ,"^",2) I OLDSTA["ACTIVE"!(OLDSTA["SUSPEN") D CHKEXP Q
  1. ...S OLDRDI=$P(ZZ,"^") K ^TMP($J,"PSORDI",OLDRDI) D SETRDI
  1. ..S OLDSTA=$P(ZZ,"^",2) I OLDSTA["ACTIVE"!(OLDSTA["SUSPEN") K ^TMP($J,"PSORDI",PSORDI) Q
  1. ..D CHKEXP ; ALL OTHER STATUSES - KEEP BY GREATER EXPIRATION DATE
  1. .D SETRDI
  1. Q
  1. ;
  1. CHKEXP ;
  1. N PSOPRE
  1. S OLDEXP=$P(ZZ,"^",3) D I OLDEXP2>RDIEXP2 K ^TMP($J,"PSORDI",PSORDI) Q
  1. .S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
  1. .S RDIEXP2=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2)
  1. .S PSOPRE=$E(DT) I $P(OLDEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
  1. .S OLDEXP2=PSOPRE_$P(OLDEXP,"/",3)_$P(OLDEXP,"/")_$P(OLDEXP,"/",2)
  1. S OLDRDI=$P(ZZ,"^") K ^TMP($J,"PSORDI",OLDRDI) D SETRDI
  1. Q
  1. ;
  1. SETRDI ;
  1. S RDI(RDIINST,RDIVUID)=PSORDI_"^"_RDISTA_"^"_RDIEXP
  1. Q
  1. ;
  1. GETPROD ;
  1. S PSOFILE=50.68
  1. S DRNM="",PSOCLASS="",PSOPROD=0
  1. N PSOPR
  1. K PSOPRODA
  1. N DIC
  1. D GETIREF^XTID(PSOFILE,.01,RDIVUID,"PSOPRODA",1) I 'PSOPRODA Q
  1. S PSOPR="" F S PSOPR=$O(PSOPRODA(PSOFILE,.01,PSOPR)) Q:PSOPR="" D Q:DRNM'="" Q:PSOCLASS'=""
  1. .I +(PSOPRODA(PSOFILE,.01,PSOPR)) S PSOPROD=+PSOPR D VAPROD(PSOPROD) Q
  1. .I +(PSOPRODA(PSOFILE,.01,PSOPR))=0 I '$O(PSOPRODA(PSOFILE,.01,PSOPR)) S PSOPROD=+PSOPR D VAPROD(PSOPROD) ; USE LAST ENTRY IF ALL ARE INACTIVE
  1. Q
  1. ;