- PSOORRDI ;BHAM-ISC/EJW - Remote Data Interoperability Order Checks ;04/25/05
- ;;7.0;OUTPATIENT PHARMACY;**207,243,251**;DEC 1997;Build 202
- ;
- ;External references to ^ORRDI1 supported by DBIA 4659
- ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- ;External reference to ^PS(50.605 supported by DBIA 696
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^PS(56 supported by DBIA 2229
- ;External reference to ^PS(50.416 supported by DBIA 692
- ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
- REMOTE(PSODFN,DREN) ;
- ; Input: DFN: PATIENT file (#2) IEN
- ; : DREN: DRUG file (#50) IEN of order being checked
- I $T(HAVEHDR^ORRDI1)']"" Q
- I '$$HAVEHDR^ORRDI1 Q
- I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q
- .I $T(REMOTE^PSORX1)]"" Q
- .W !!,"Remote data not available - Only local order checks processed." D HD^PSODDPR2():(($Y+5)'>IOSL)
- 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
- 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
- I '$G(DT) S DT=$$DT^XLFDT
- S (DD,PSORDI)=0
- I $T(GET^ORRDI1)]"" S PSORDI=$$GET^ORRDI1(PSODFN,"PSOO")
- I PSORDI<1 Q
- I '$D(^XTMP("ORRDI","PSOO",PSODFN)) Q
- K ^TMP($J,"PSORDI")
- D PARSE,FILTER
- I '$D(^TMP($J,LIST,"OUT","REMOTE")) Q
- ;D DRGNAME ; GET VA PRODUCT FILE NAME FOR FILE 50 DRUG BEING CHECKED
- S PSORDI="" F S PSORDI=$O(^TMP($J,LIST,"OUT","REMOTE",PSORDI)) Q:'PSORDI S RDITMP=^(PSORDI) D
- .S RDIINST=$P(RDITMP,"^")
- .S RDIVUID=$P(RDITMP,"^",2)
- .I RDIVUID="" Q
- .S RDIDNAM=$P(RDITMP,"^",3)
- .S RDISTA=$P(RDITMP,"^",4)
- .S RDIRX=$P(RDITMP,"^",5)
- .S RDIFILL=$P(RDITMP,"^",6)
- .S RDIDAYS=$P(RDITMP,"^",7) I $E(RDIDAYS)="D" S RDIDAYS=$P(RDIDAYS,"D",2)
- .S RDIQTY=$P(RDITMP,"^",8)
- .S RDIREF=$P(RDITMP,"^",9)
- .S RDIEXP=$P(RDITMP,"^",10)
- .S RDIPHYS=$P(RDITMP,"^",11)
- .S RDIISS=$P(RDITMP,"^",12)
- .K ^TMP($J,"PSOPROD")
- D REMOTE^PSODDPR5
- Q
- ;
- PARSE ; PULL INFORMATION FROM ^XTMP
- N PSORDI,LOCAL,NEWISS,BADEXP,PSOPRE,PSO30,NEWDC,NEWEXP
- S PSORDI=0
- F S PSORDI=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI)) Q:'PSORDI D
- .S RDISTA=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,5,0))
- .I RDISTA="DELETED" Q
- .S RDIINST=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,1,0))
- .S RDIDNAM=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,2,0))
- .S RDIVUID=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,3,0))
- .I RDIVUID="" Q
- .S RDIRX=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,4,0))
- .S RDIQTY=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,6,0)),RDIDAYS=$P(RDIQTY,";",2),RDIQTY=$P(RDIQTY,";")
- .I $E(RDIDAYS)="D" S RDIDAYS=$P(RDIDAYS,"D",2)
- .S RDIEXP=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,7,0))
- .S RDIISS=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,8,0))
- .I RDIEXP?."/" S BADEXP=1 D I BADEXP Q
- ..I RDIISS?."/" Q
- ..S PSOPRE=$E(DT) I $P(RDIISS,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
- ..S NEWISS=PSOPRE_$P(RDIISS,"/",3)_$P(RDIISS,"/")_$P(RDIISS,"/",2) I NEWISS>(DT-10000) S RDIEXP=RDIISS,BADEXP=0
- .I RDISTA["EXPIRE" S PSO30=0 D I PSO30 Q
- ..S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q
- ..S NEWEXP=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2)
- ..S X1=NEWEXP,X2=30 D C^%DTC I X<DT S PSO30=1
- .I RDIRX'="" S LOCAL=0 D CHKLOCAL I LOCAL Q
- .S RDIFILL=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,9,0))
- .I RDISTA["DISCONT" S PSO30=0 D I PSO30 Q
- ..S PSOPRE=$E(DT) I $P(RDIFILL,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q
- ..S NEWDC=PSOPRE_$P(RDIFILL,"/",3)_$P(RDIFILL,"/")_$P(RDIFILL,"/",2)
- ..S X1=NEWDC,X2=30+RDIDAYS D C^%DTC I X<DT S PSO30=1
- ..I RDISTA["DRUG INTERACTION" S RDISTA="NON-VERIFIED"
- .S RDIREF=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,10,0))
- .S RDIPHYS=$G(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,11,0))
- .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)
- ..S ^TMP($J,"DD",DD,1)=RDIDNAM_"^"_RDISTA_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
- ..S PSOSIG="" F S PSOSIG=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,14,PSOSIG)) Q:PSOSIG="" S PSOSIG(PSOSIG)=^(PSOSIG)
- ..S PSOSIG="" F S PSOSIG=$O(PSOSIG(PSOSIG)) Q:PSOSIG="" S ^TMP($J,"DD",DD,1,PSOSIG)=PSOSIG(PSOSIG)
- ..S ^TMP($J,"PSORMDD",PSORDI,0)=1
- .D GETPROD
- .Q:$E($G(PSOCLASS),1,2)="XA"
- .S PSOSIG="" F S PSOSIG=$O(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,14,PSOSIG)) Q:PSOSIG="" S PSOSIG(PSOSIG)=^(PSOSIG)
- .S ^TMP($J,LIST,"OUT","REMOTE",PSORDI)=RDIINST_"^"_RDIVUID_"^"_RDIDNAM_"^"_RDISTA_"^"_RDIRX_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
- .S PSOSIG="" F S PSOSIG=$O(PSOSIG(PSOSIG)) Q:PSOSIG="" S ^TMP($J,LIST,"OUT","REMOTE",PSORDI,"SIG",PSOSIG)=PSOSIG(PSOSIG)
- Q
- ;
- CHKLOCAL ; IF SAME RX NUMBER AND ISSUE DATE - LOCAL RX
- N PSOISS
- I $D(^PSRX("B",RDIRX)) D
- .N PSORX
- .S PSORX=$O(^PSRX("B",RDIRX,"")) I 'PSORX Q
- .S PSOISS=$P($G(^PSRX(PSORX,0)),"^",13)
- .S PSOISS=$E(PSOISS,4,5)_"/"_$E(PSOISS,6,7)_"/"_$E(PSOISS,2,3)
- .I PSOISS=RDIISS S LOCAL=1 Q
- Q
- ;
- VAPROD(PSOPROD) ; GET VA PRODUCT FILE NAME AND DRUG CLASS
- S PSOCLASS=$$DCLCODE^PSNAPIS(,PSOPROD)
- S DRNM=$P($$PROD0^PSNAPIS(,PSOPROD),"^")
- Q
- ;
- DRGNAME ;
- N PSOY,PSODRUG
- S PSOY=DREN_"^"_$P($G(^PSDRUG(DREN,0)),"^"),PSOY(0)=$G(^PSDRUG(DREN,0))
- S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2)
- S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)
- I PSODRUG("NDF")=0 Q
- S PSOPROD=$P(PSODRUG("NDF"),"A",2) I PSOPROD D VAPROD(PSOPROD) S PSODRUG("NAME")=DRNM
- Q
- ;
- FILTER ; FOR SAME DRUG VUID FOR SAME SITE, KEEP 1 ENTRY - CHECK BY ACTIVE STATUS FIRST THEN BY GREATEST EXPIRATION DATE
- N XX,RDI,OLDEXP,RDIEXP,RDIEXP2,OLDEXP2,PSORDI,RDISTA,OLDSTA,OLDRDI,ZZ
- S PSORDI=0
- F S PSORDI=$O(^TMP($J,"PSORDI",PSORDI)) Q:'PSORDI D
- .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
- .I $D(RDI(RDIINST,RDIVUID)) S ZZ=RDI(RDIINST,RDIVUID) D Q
- ..I RDISTA="ACTIVE"!(RDISTA["SUSPEN") D Q
- ...S OLDSTA=$P(ZZ,"^",2) I OLDSTA["ACTIVE"!(OLDSTA["SUSPEN") D CHKEXP Q
- ...S OLDRDI=$P(ZZ,"^") K ^TMP($J,"PSORDI",OLDRDI) D SETRDI
- ..S OLDSTA=$P(ZZ,"^",2) I OLDSTA["ACTIVE"!(OLDSTA["SUSPEN") K ^TMP($J,"PSORDI",PSORDI) Q
- ..D CHKEXP ; ALL OTHER STATUSES - KEEP BY GREATER EXPIRATION DATE
- .D SETRDI
- Q
- ;
- CHKEXP ;
- N PSOPRE
- S OLDEXP=$P(ZZ,"^",3) D I OLDEXP2>RDIEXP2 K ^TMP($J,"PSORDI",PSORDI) Q
- .S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
- .S RDIEXP2=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2)
- .S PSOPRE=$E(DT) I $P(OLDEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1
- .S OLDEXP2=PSOPRE_$P(OLDEXP,"/",3)_$P(OLDEXP,"/")_$P(OLDEXP,"/",2)
- S OLDRDI=$P(ZZ,"^") K ^TMP($J,"PSORDI",OLDRDI) D SETRDI
- Q
- ;
- SETRDI ;
- S RDI(RDIINST,RDIVUID)=PSORDI_"^"_RDISTA_"^"_RDIEXP
- Q
- ;
- GETPROD ;
- S PSOFILE=50.68
- S DRNM="",PSOCLASS="",PSOPROD=0
- N PSOPR
- K PSOPRODA
- N DIC
- D GETIREF^XTID(PSOFILE,.01,RDIVUID,"PSOPRODA",1) I 'PSOPRODA Q
- S PSOPR="" F S PSOPR=$O(PSOPRODA(PSOFILE,.01,PSOPR)) Q:PSOPR="" D Q:DRNM'="" Q:PSOCLASS'=""
- .I +(PSOPRODA(PSOFILE,.01,PSOPR)) S PSOPROD=+PSOPR D VAPROD(PSOPROD) Q
- .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
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORRDI 7535 printed Jan 18, 2025@03:33:25 Page 2
- PSOORRDI ;BHAM-ISC/EJW - Remote Data Interoperability Order Checks ;04/25/05
- +1 ;;7.0;OUTPATIENT PHARMACY;**207,243,251**;DEC 1997;Build 202
- +2 ;
- +3 ;External references to ^ORRDI1 supported by DBIA 4659
- +4 ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- +5 ;External reference to ^PS(50.605 supported by DBIA 696
- +6 ;External reference to ^PSDRUG supported by DBIA 221
- +7 ;External reference to ^PS(56 supported by DBIA 2229
- +8 ;External reference to ^PS(50.416 supported by DBIA 692
- +9 ;External reference to DDIEX^PSNAPIS supported by DBIA 2574
- REMOTE(PSODFN,DREN) ;
- +1 ; Input: DFN: PATIENT file (#2) IEN
- +2 ; : DREN: DRUG file (#50) IEN of order being checked
- +3 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +4 IF '$$HAVEHDR^ORRDI1
- QUIT
- +5 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
- Begin DoDot:1
- +6 IF $TEXT(REMOTE^PSORX1)]""
- QUIT
- +7 WRITE !!,"Remote data not available - Only local order checks processed."
- if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- End DoDot:1
- QUIT
- +8 IF $PIECE($GET(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0
- WRITE !!,"Remote data not available - Only local order checks processed."
- if (($Y+5)'>IOSL)
- DO HD^PSODDPR2()
- QUIT
- +9 NEW 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
- +10 IF '$GET(DT)
- SET DT=$$DT^XLFDT
- +11 SET (DD,PSORDI)=0
- +12 IF $TEXT(GET^ORRDI1)]""
- SET PSORDI=$$GET^ORRDI1(PSODFN,"PSOO")
- +13 IF PSORDI<1
- QUIT
- +14 IF '$DATA(^XTMP("ORRDI","PSOO",PSODFN))
- QUIT
- +15 KILL ^TMP($JOB,"PSORDI")
- +16 DO PARSE
- DO FILTER
- +17 IF '$DATA(^TMP($JOB,LIST,"OUT","REMOTE"))
- QUIT
- +18 ;D DRGNAME ; GET VA PRODUCT FILE NAME FOR FILE 50 DRUG BEING CHECKED
- +19 SET PSORDI=""
- FOR
- SET PSORDI=$ORDER(^TMP($JOB,LIST,"OUT","REMOTE",PSORDI))
- if 'PSORDI
- QUIT
- SET RDITMP=^(PSORDI)
- Begin DoDot:1
- +20 SET RDIINST=$PIECE(RDITMP,"^")
- +21 SET RDIVUID=$PIECE(RDITMP,"^",2)
- +22 IF RDIVUID=""
- QUIT
- +23 SET RDIDNAM=$PIECE(RDITMP,"^",3)
- +24 SET RDISTA=$PIECE(RDITMP,"^",4)
- +25 SET RDIRX=$PIECE(RDITMP,"^",5)
- +26 SET RDIFILL=$PIECE(RDITMP,"^",6)
- +27 SET RDIDAYS=$PIECE(RDITMP,"^",7)
- IF $EXTRACT(RDIDAYS)="D"
- SET RDIDAYS=$PIECE(RDIDAYS,"D",2)
- +28 SET RDIQTY=$PIECE(RDITMP,"^",8)
- +29 SET RDIREF=$PIECE(RDITMP,"^",9)
- +30 SET RDIEXP=$PIECE(RDITMP,"^",10)
- +31 SET RDIPHYS=$PIECE(RDITMP,"^",11)
- +32 SET RDIISS=$PIECE(RDITMP,"^",12)
- +33 KILL ^TMP($JOB,"PSOPROD")
- End DoDot:1
- +34 DO REMOTE^PSODDPR5
- +35 QUIT
- +36 ;
- PARSE ; PULL INFORMATION FROM ^XTMP
- +1 NEW PSORDI,LOCAL,NEWISS,BADEXP,PSOPRE,PSO30,NEWDC,NEWEXP
- +2 SET PSORDI=0
- +3 FOR
- SET PSORDI=$ORDER(^XTMP("ORRDI","PSOO",PSODFN,PSORDI))
- if 'PSORDI
- QUIT
- Begin DoDot:1
- +4 SET RDISTA=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,5,0))
- +5 IF RDISTA="DELETED"
- QUIT
- +6 SET RDIINST=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,1,0))
- +7 SET RDIDNAM=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,2,0))
- +8 SET RDIVUID=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,3,0))
- +9 IF RDIVUID=""
- QUIT
- +10 SET RDIRX=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,4,0))
- +11 SET RDIQTY=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,6,0))
- SET RDIDAYS=$PIECE(RDIQTY,";",2)
- SET RDIQTY=$PIECE(RDIQTY,";")
- +12 IF $EXTRACT(RDIDAYS)="D"
- SET RDIDAYS=$PIECE(RDIDAYS,"D",2)
- +13 SET RDIEXP=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,7,0))
- +14 SET RDIISS=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,8,0))
- +15 IF RDIEXP?."/"
- SET BADEXP=1
- Begin DoDot:2
- +16 IF RDIISS?."/"
- QUIT
- +17 SET PSOPRE=$EXTRACT(DT)
- IF $PIECE(RDIISS,"/",3)>($EXTRACT(DT,2,3)+1)
- SET PSOPRE=PSOPRE-1
- +18 SET NEWISS=PSOPRE_$PIECE(RDIISS,"/",3)_$PIECE(RDIISS,"/")_$PIECE(RDIISS,"/",2)
- IF NEWISS>(DT-10000)
- SET RDIEXP=RDIISS
- SET BADEXP=0
- End DoDot:2
- IF BADEXP
- QUIT
- +19 IF RDISTA["EXPIRE"
- SET PSO30=0
- Begin DoDot:2
- +20 SET PSOPRE=$EXTRACT(DT)
- IF $PIECE(RDIEXP,"/",3)>($EXTRACT(DT,2,3)+1)
- SET PSO30=1
- QUIT
- +21 SET NEWEXP=PSOPRE_$PIECE(RDIEXP,"/",3)_$PIECE(RDIEXP,"/")_$PIECE(RDIEXP,"/",2)
- +22 SET X1=NEWEXP
- SET X2=30
- DO C^%DTC
- IF X<DT
- SET PSO30=1
- End DoDot:2
- IF PSO30
- QUIT
- +23 IF RDIRX'=""
- SET LOCAL=0
- DO CHKLOCAL
- IF LOCAL
- QUIT
- +24 SET RDIFILL=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,9,0))
- +25 IF RDISTA["DISCONT"
- SET PSO30=0
- Begin DoDot:2
- +26 SET PSOPRE=$EXTRACT(DT)
- IF $PIECE(RDIFILL,"/",3)>($EXTRACT(DT,2,3)+1)
- SET PSO30=1
- QUIT
- +27 SET NEWDC=PSOPRE_$PIECE(RDIFILL,"/",3)_$PIECE(RDIFILL,"/")_$PIECE(RDIFILL,"/",2)
- +28 SET X1=NEWDC
- SET X2=30+RDIDAYS
- DO C^%DTC
- IF X<DT
- SET PSO30=1
- +29 IF RDISTA["DRUG INTERACTION"
- SET RDISTA="NON-VERIFIED"
- End DoDot:2
- IF PSO30
- QUIT
- +30 SET RDIREF=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,10,0))
- +31 SET RDIPHYS=$GET(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,11,0))
- +32 IF PSODRUG("NAME")=RDIDNAM
- SET DD=$GET(DD)+1
- SET ^TMP($JOB,"DD",DD,0)=PSODRUG("IEN")_"^"_PSODRUG("NAME")_"^"_"^"_RDIRX_"R;O"_"^"_RDIINST
- Begin DoDot:2
- +33 SET ^TMP($JOB,"DD",DD,1)=RDIDNAM_"^"_RDISTA_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
- +34 SET PSOSIG=""
- FOR
- SET PSOSIG=$ORDER(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,14,PSOSIG))
- if PSOSIG=""
- QUIT
- SET PSOSIG(PSOSIG)=^(PSOSIG)
- +35 SET PSOSIG=""
- FOR
- SET PSOSIG=$ORDER(PSOSIG(PSOSIG))
- if PSOSIG=""
- QUIT
- SET ^TMP($JOB,"DD",DD,1,PSOSIG)=PSOSIG(PSOSIG)
- +36 SET ^TMP($JOB,"PSORMDD",PSORDI,0)=1
- End DoDot:2
- if '$GET(PSOPHI)
- QUIT
- +37 DO GETPROD
- +38 if $EXTRACT($GET(PSOCLASS),1,2)="XA"
- QUIT
- +39 SET PSOSIG=""
- FOR
- SET PSOSIG=$ORDER(^XTMP("ORRDI","PSOO",PSODFN,PSORDI,14,PSOSIG))
- if PSOSIG=""
- QUIT
- SET PSOSIG(PSOSIG)=^(PSOSIG)
- +40 SET ^TMP($JOB,LIST,"OUT","REMOTE",PSORDI)=RDIINST_"^"_RDIVUID_"^"_RDIDNAM_"^"_RDISTA_"^"_RDIRX_"^"_RDIFILL_"^"_RDIDAYS_"^"_RDIQTY_"^"_RDIREF_"^"_RDIEXP_"^"_RDIPHYS_"^"_RDIISS
- +41 SET PSOSIG=""
- FOR
- SET PSOSIG=$ORDER(PSOSIG(PSOSIG))
- if PSOSIG=""
- QUIT
- SET ^TMP($JOB,LIST,"OUT","REMOTE",PSORDI,"SIG",PSOSIG)=PSOSIG(PSOSIG)
- End DoDot:1
- +42 QUIT
- +43 ;
- CHKLOCAL ; IF SAME RX NUMBER AND ISSUE DATE - LOCAL RX
- +1 NEW PSOISS
- +2 IF $DATA(^PSRX("B",RDIRX))
- Begin DoDot:1
- +3 NEW PSORX
- +4 SET PSORX=$ORDER(^PSRX("B",RDIRX,""))
- IF 'PSORX
- QUIT
- +5 SET PSOISS=$PIECE($GET(^PSRX(PSORX,0)),"^",13)
- +6 SET PSOISS=$EXTRACT(PSOISS,4,5)_"/"_$EXTRACT(PSOISS,6,7)_"/"_$EXTRACT(PSOISS,2,3)
- +7 IF PSOISS=RDIISS
- SET LOCAL=1
- QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- VAPROD(PSOPROD) ; GET VA PRODUCT FILE NAME AND DRUG CLASS
- +1 SET PSOCLASS=$$DCLCODE^PSNAPIS(,PSOPROD)
- +2 SET DRNM=$PIECE($$PROD0^PSNAPIS(,PSOPROD),"^")
- +3 QUIT
- +4 ;
- DRGNAME ;
- +1 NEW PSOY,PSODRUG
- +2 SET PSOY=DREN_"^"_$PIECE($GET(^PSDRUG(DREN,0)),"^")
- SET PSOY(0)=$GET(^PSDRUG(DREN,0))
- +3 SET PSODRUG("IEN")=+PSOY
- SET PSODRUG("VA CLASS")=$PIECE(PSOY(0),"^",2)
- +4 SET PSODRUG("NDF")=$SELECT($GET(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)
- +5 IF PSODRUG("NDF")=0
- QUIT
- +6 SET PSOPROD=$PIECE(PSODRUG("NDF"),"A",2)
- IF PSOPROD
- DO VAPROD(PSOPROD)
- SET PSODRUG("NAME")=DRNM
- +7 QUIT
- +8 ;
- FILTER ; FOR SAME DRUG VUID FOR SAME SITE, KEEP 1 ENTRY - CHECK BY ACTIVE STATUS FIRST THEN BY GREATEST EXPIRATION DATE
- +1 NEW XX,RDI,OLDEXP,RDIEXP,RDIEXP2,OLDEXP2,PSORDI,RDISTA,OLDSTA,OLDRDI,ZZ
- +2 SET PSORDI=0
- +3 FOR
- SET PSORDI=$ORDER(^TMP($JOB,"PSORDI",PSORDI))
- if 'PSORDI
- QUIT
- Begin DoDot:1
- +4 SET XX=$GET(^TMP($JOB,"PSORDI",PSORDI))
- SET RDIINST=$PIECE(XX,"^")
- SET RDIVUID=$PIECE(XX,"^",2)
- SET RDISTA=$PIECE(XX,"^",4)
- SET RDIEXP=$PIECE(XX,"^",10)
- if RDIINST=""
- QUIT
- if RDIVUID=""
- QUIT
- IF RDIEXP=""
- QUIT
- +5 IF $DATA(RDI(RDIINST,RDIVUID))
- SET ZZ=RDI(RDIINST,RDIVUID)
- Begin DoDot:2
- +6 IF RDISTA="ACTIVE"!(RDISTA["SUSPEN")
- Begin DoDot:3
- +7 SET OLDSTA=$PIECE(ZZ,"^",2)
- IF OLDSTA["ACTIVE"!(OLDSTA["SUSPEN")
- DO CHKEXP
- QUIT
- +8 SET OLDRDI=$PIECE(ZZ,"^")
- KILL ^TMP($JOB,"PSORDI",OLDRDI)
- DO SETRDI
- End DoDot:3
- QUIT
- +9 SET OLDSTA=$PIECE(ZZ,"^",2)
- IF OLDSTA["ACTIVE"!(OLDSTA["SUSPEN")
- KILL ^TMP($JOB,"PSORDI",PSORDI)
- QUIT
- +10 ; ALL OTHER STATUSES - KEEP BY GREATER EXPIRATION DATE
- DO CHKEXP
- End DoDot:2
- QUIT
- +11 DO SETRDI
- End DoDot:1
- +12 QUIT
- +13 ;
- CHKEXP ;
- +1 NEW PSOPRE
- +2 SET OLDEXP=$PIECE(ZZ,"^",3)
- Begin DoDot:1
- +3 SET PSOPRE=$EXTRACT(DT)
- IF $PIECE(RDIEXP,"/",3)>($EXTRACT(DT,2,3)+1)
- SET PSOPRE=PSOPRE-1
- +4 SET RDIEXP2=PSOPRE_$PIECE(RDIEXP,"/",3)_$PIECE(RDIEXP,"/")_$PIECE(RDIEXP,"/",2)
- +5 SET PSOPRE=$EXTRACT(DT)
- IF $PIECE(OLDEXP,"/",3)>($EXTRACT(DT,2,3)+1)
- SET PSOPRE=PSOPRE-1
- +6 SET OLDEXP2=PSOPRE_$PIECE(OLDEXP,"/",3)_$PIECE(OLDEXP,"/")_$PIECE(OLDEXP,"/",2)
- End DoDot:1
- IF OLDEXP2>RDIEXP2
- KILL ^TMP($JOB,"PSORDI",PSORDI)
- QUIT
- +7 SET OLDRDI=$PIECE(ZZ,"^")
- KILL ^TMP($JOB,"PSORDI",OLDRDI)
- DO SETRDI
- +8 QUIT
- +9 ;
- SETRDI ;
- +1 SET RDI(RDIINST,RDIVUID)=PSORDI_"^"_RDISTA_"^"_RDIEXP
- +2 QUIT
- +3 ;
- GETPROD ;
- +1 SET PSOFILE=50.68
- +2 SET DRNM=""
- SET PSOCLASS=""
- SET PSOPROD=0
- +3 NEW PSOPR
- +4 KILL PSOPRODA
- +5 NEW DIC
- +6 DO GETIREF^XTID(PSOFILE,.01,RDIVUID,"PSOPRODA",1)
- IF 'PSOPRODA
- QUIT
- +7 SET PSOPR=""
- FOR
- SET PSOPR=$ORDER(PSOPRODA(PSOFILE,.01,PSOPR))
- if PSOPR=""
- QUIT
- Begin DoDot:1
- +8 IF +(PSOPRODA(PSOFILE,.01,PSOPR))
- SET PSOPROD=+PSOPR
- DO VAPROD(PSOPROD)
- QUIT
- +9 ; USE LAST ENTRY IF ALL ARE INACTIVE
- IF +(PSOPRODA(PSOFILE,.01,PSOPR))=0
- IF '$ORDER(PSOPRODA(PSOFILE,.01,PSOPR))
- SET PSOPROD=+PSOPR
- DO VAPROD(PSOPROD)
- End DoDot:1
- if DRNM'=""
- QUIT
- if PSOCLASS'=""
- QUIT
- +10 QUIT
- +11 ;