PSOSULB1 ;BHAM ISC/RTR,SAB-Print suspended labels cont. ;29-May-2012 15:15;PLS
;;7.0;OUTPATIENT PHARMACY;**10,1008,200,264,289,1015**;DEC 1997;Build 62
;Reference to $$INSUR^IBBAPI supported by IA 4419
;Reference to $$DEA^IBNCPDP controlled subscription by IA 4299
; Modified - IHS/MSC/PLS - 05/22/09 - Line QUE+4
DEV D:'$D(PSOPAR) ^PSOLSET G:'$D(PSOPAR) DEV S PSOION=ION
N X S X="PSXRSUS" X ^%ZOSF("TEST") G:($T)&($G(PSXSYS))&($D(^XUSEC("PSXCMOPMGR",DUZ)))&($D(^XUSEC("PSX XMIT",DUZ))) ^PSXRSUS
DEV1 I '$P(PSOPAR,"^",8) G START
N PSOPROP,PFIO W $C(7),!!,"PROFILES MUST BE SENT TO PRINTER !!",! K IOP,%ZIS,IO("Q"),POP S %ZIS="MNQ",%ZIS("A")="Select PROFILE Device: " D ^%ZIS K %ZIS("A") G:POP EXIT^PSOSULBL G:$E(IOST)["C"!(PSOION=ION) DEV S PSOPROP=ION D ^%ZISC
START I $G(PSOCUTDT)']"" S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X,PSOPRPAS=$P(PSOPAR,"^",7)
ASK K ^TMP($J),PSOSU,PSOSUSPR S PFIOQ=0,PDUZ=DUZ W !
S %DT="AEX",%DT("A")="Print labels through date: ",%DT("B")="TODAY" D ^%DT K %DT D:Y<0 MESS G:Y<0 EXIT^PSOSULBL S PRTDT=Y
I '$O(^PS(52.5,"C",0))!($O(^(0))>PRTDT) W $C(7),!!,"NOTHING THRU DATE TO PRINT" G ASK
W ! K DIR S DIR("A")="Sort by Patient Name, ID#, or DEA Special Handling",DIR(0)="SB^P:PATIENT NAME;I:IDENTIFICATION NUMBER;D:DEA SPECIAL HANDLING"
S DIR("?")="Enter 'P' to sort the labels alphabetically by name, enter 'I' to sort by identification number, enter 'D' to sort by DEA Special Handling."
S DIR("?",1)="Sorting by DEA Special Handling will print the labels in three groups. The",DIR("?",2)="first will contain labels with drugs marked with an A or C in the DEA Special"
S DIR("?",3)="Handling field, indicating NARCOTICS AND ALCOHOLICS, and CONTROLLED SUBSTANCES-",DIR("?",4)="NON NARCOTIC. The second group will contain ones marked with an S, indicating"
S DIR("?",5)="SUPPLY, and all others will print in the third group.",DIR("?",6)=""
D ^DIR K DIR D:$D(DIRUT) MESS G:$D(DIRUT) EXIT^PSOSULBL S PSRT=$S(Y="D":"D",Y="P":1,1:0)
I Y="D" W ! K DIR S DIR(0)="SB^P:PATIENT NAME;I:IDENTIFICATION NUMBER",DIR("A")="Within DEA Special Handling, sort by Patient Name or ID#" D ^DIR K DIR D:$D(DIRUT) MESS G:$D(DIRUT) EXIT^PSOSULBL S PSRTONE=Y
S X1=PRTDT,X2=$P(PSOPAR,"^",27) D C^%DTC S XDATE=X K IOP,POP,IO("Q"),ZTSK
PRLBL W ! S %ZIS("A")="Printer 'LABEL' Device: ",%ZIS("B")="",%ZIS="MQN" D ^%ZIS S PSLION=ION I POP S IOP=PSOION D ^%ZIS D MESS G EXIT^PSOSULBL
I $E(IOST)'["P" D MESSL G PRLBL
N PSOIOS S PSOIOS=IOS D DEVBAR^PSOBMST
S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$P(PSOPAR,"^",19)
K PSOION D ^%ZISC I $D(IO("Q")) K IO("Q")
QUE K %DT,PSOTIME,PSOOUT D NOW^%DTC S %DT="REAX",%DT(0)=%,%DT("B")="NOW",%DT("A")="Queue to run at what time: " D ^%DT K %DT I $D(DTOUT)!(Y<0) D MESS G EXIT^PSOSULBL
S (PSOSUSPR,PSODBQ)=1,PSOTIME=Y
S ZTRTN="BEG^PSOSULBL",ZTDESC="PRINT LABELS FROM SUSPENSE",ZTIO=PSLION,ZTDTH=PSOTIME
F G="PSOPAR","PSOSYS","PSOSUSPR","PSODBQ","PSRT","PSRTONE","PSOPROP","PSLION","PFIO","PSOBARS","PSODTCUT","PSOPRPAS","PRTDT","PDUZ","PSOBAR0","PSOBAR1","PSOSITE","XDATE","PSOTIME" S:$D(@G) ZTSAVE(G)=""
S ZTSAVE("APS*")=""
D ^%ZTLOAD W !!,"PRINT FROM SUSPENSE JOB QUEUED!",! D ^%ZISC G EXIT^PSOSULBL
;G:PSRT'="D" BEG^PSOSULBL
MESS W $C(7),!!?3,"NOTHING QUEUED TO PRINT!",! Q
MESSL W $C(7),!?3,"LABELS MUST BE SENT TO A PRINTER!",! Q
BAIMAIL ;Send mail message
S:'$G(PDUZ) PDUZ=+$G(DUZ)
K ^TMP("PSOM",$J)
N SEQ,XMY,XMDUZ,XMSUB,XMTEXT,SEQ,NAME,PSSN,RX,FILL,FIRST
S SEQ=1
S XMY(PDUZ)=""
S XMY("G.PSO EXTERNAL DISPENSE ALERTS")=""
S XMDUZ="OUTPATIENT PHARMACY PACKAGE"
S XMSUB="BAD ADDRESS SUSPENSE NOT PRINTED"
I $G(PSOSITE) S XMSUB=$$GET1^DIQ(59,PSOSITE,.06)_" "_XMSUB
S ^TMP("PSOM",$J,SEQ)="The following prescriptions with a routing of mail were not printed/sent to",SEQ=SEQ+1
S ^TMP("PSOM",$J,SEQ)="external interface due to the BAD ADDRESS INDICATOR being set and no active",SEQ=SEQ+1
S ^TMP("PSOM",$J,SEQ)="temporary address, or the patient has an active MAIL status of DO NOT MAIL, or",SEQ=SEQ+1
S ^TMP("PSOM",$J,SEQ)="the patient has a foreign address:",SEQ=SEQ+1
S NAME="" F S NAME=$O(^TMP("PSOSM",$J,NAME)) Q:NAME="" D
.S PSSN="" F S PSSN=$O(^TMP("PSOSM",$J,NAME,PSSN)) Q:PSSN="" D
..S ^TMP("PSOM",$J,SEQ)="",SEQ=SEQ+1
..S ^TMP("PSOM",$J,SEQ)=NAME_" "_PSSN,FIRST=1
..S RX=0 F S RX=$O(^TMP("PSOSM",$J,NAME,PSSN,RX)) Q:'RX S FILL="" F S FILL=$O(^TMP("PSOSM",$J,NAME,PSSN,RX,FILL)) Q:FILL="" D
...I FIRST D S FIRST=0
....S ^TMP("PSOM",$J,SEQ)=^TMP("PSOM",$J,SEQ)_" ("_$G(^TMP("PSOSM",$J,NAME,PSSN,RX,FILL))_")"
....S SEQ=SEQ+1
...S ^TMP("PSOM",$J,SEQ)=" "_$P(^PSRX(RX,0),"^")_" ("_FILL_") "_$P($G(^PSDRUG($P(^PSRX(RX,0),"^",6),0)),"^"),SEQ=SEQ+1
S ^TMP("PSOM",$J,SEQ+1)=""
S XMTEXT="^TMP(""PSOM"",$J," N DIFROM D ^XMD K XMSUB,XMTEXT,XMY,XMDUZ
Q
;Description:
;This function determines whether the RX SUSPENSE has a DAYS SUPPLY HOLD
;condition.
;Input: REC = Pointer to Suspense file (#52.5)
;Returns: 1 or 0
;1 (one) if ¾ of days supply has elapsed.
;0 (zero) is returned if ¾ of days supply has not elapsed.
;
DSH(REC) ; ePharmacy - verify that 3/4 days supply has elapsed before printing from suspense
N PSINSUR,PSARR,SHDT,DSHOLD,DSHDT,PS0,COMM,DIE,DA,DR,RXIEN,RFL,DAYSSUP,LSTFIL,PTDFN,IBINS,DRG
N DEA,DEAOK,ICD,SFN,SDT
S DSHOLD=1,PS0=^PS(52.5,REC,0),RXIEN=$P(PS0,U,1),RFL=$P(PS0,U,13)
S LSTFIL=$$LSTRFL^PSOBPSU1(RXIEN),PTDFN=$$GET1^DIQ(52,RXIEN,"2","I")
S IBSTAT=$$INSUR^IBBAPI(PTDFN,,"E",.IBINS,"1"),DRG=$$GET1^DIQ(52,RXIEN,"6","I")
S (DEA,ICD)="",DEA=$$GET1^DIQ(50,DRG,3)
I $D(^PSRX(RXIEN,"ICD",1,0)) S ICD=^PSRX(RXIEN,"ICD",1,0)
;
; Don't hold Rx where the previous fill was not ebillable
I $$STATUS^BPSOSRX(RXIEN,LSTFIL-1)="" Q DSHOLD
; Don't hold when the Rx has SC/EI flagged
I ICD[1 Q DSHOLD
; Don't hold rx if DEA special Handling code is non billable (i.e. has M or 0 (zero) or (I, S, N, and/or 9)) without an E
S DEAOK=$$DEA^IBNCPDP(DEA) I 'DEAOK Q DSHOLD
; Don't hold for zero fill renewals
I 'LSTFIL,$$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE",,,)="" Q DSHOLD
; Don't hold if no insurance
I 'IBSTAT!(IBSTAT=-1) Q DSHOLD
;
S DSHDT=$$DSHDT(RXIEN) ; 3/4 of days supply date
I DSHDT>DT S DSHOLD=0 D
. I DSHDT'=$P(PS0,U,14) D ; Update Suspense Hold Date and Activity Log
. . S COMM="3/4 of Days Supply SUSPENSE HOLD until "_$$FMTE^XLFDT(DSHDT,"2D")_"."
. . S DAYSSUP=$$LFDS(RXIEN)
. . D RXACT^PSOBPSU2(RXIEN,RFL,COMM,"S",+$G(DUZ)) ; Update Activity Log
. . S DR="10///^S X=DSHDT",DIE="^PS(52.5,",DA=REC D ^DIE ; File Suspense Hold Date
. . N DA,DIE,DR,PSOX,SFN,INDT,DEAD,SUB,XOK,OLD,X,II
. . S DA=REC,DIE="^PS(52.5,",DR=".02///"_DSHDT D ^DIE
. . S SFN=REC,DEAD=0,INDT=DSHDT D CHANGE^PSOSUCH1(RXIEN,RFL)
Q DSHOLD
;
;Description:
;This function determines the date that 3/4 of the days supply for the
;last refill will occur.
;Input: RXIEN = Prescription file #52 IEN
;Returns: DATE/TIME value
DSHDT(RXIEN) ;
N RXFIL,FILLDT,DAYSSUP,DSH34
I '$D(^PSRX(RXIEN,0)) Q -1
;S RXFIL=$$LSTRFL^PSOBPSU1(RXIEN) ; Last Refill
S FILLDT=$$LDPFDT(RXIEN) ; Last Dispensed Date or Prior Fill Date for renewal
S DAYSSUP=$$LFDS(RXIEN) ; Days Supply of Last Refill
S DSH34=DAYSSUP*.75 ; 3/4 of Days Supply
Q $$FMADD^XLFDT(FILLDT,DSH34) ; Return today plus 3/4 of Days Supply date
;
; Description: This function returns the DAYS SUPPLY for the Latest Fill
; for a Prescription
; Input: RXIEN = Prescription file #52 IEN
; Returns: DAYS SUPPLY for the latest fill
; -1 if RXIEN is not valid
LFDS(RXIEN) ;
N RXFIL
Q:'$D(^PSRX(RXIEN)) -1
S RXFIL=$$LSTRFL^PSOBPSU1(RXIEN)
Q $S(RXFIL=0:$P(^PSRX(RXIEN,0),U,8),1:$P(^PSRX(RXIEN,1,RXFIL,0),U,10))
;
LDPFDT(RXIEN) ; Returns PRIOR FILL DATE if renewal otherwise LAST DISPENSED DATE or -1 if not valid
Q $S('$D(^PSRX(RXIEN)):-1,$$PRFDT(RXIEN):$$PRFDT(RXIEN),1:$$LDT(RXIEN))
;
PRFDT(RXIEN) ; Returns PRIOR FILL DATE in internal format
Q $$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE","I",,)
;
LDT(RXIEN) ; Returns LAST DISPENSED DATE in internal format
Q $$GET1^DIQ(52,RXIEN_",","LAST DISPENSED DATE","I",,)
PSOSULB1 ;BHAM ISC/RTR,SAB-Print suspended labels cont. ;29-May-2012 15:15;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**10,1008,200,264,289,1015**;DEC 1997;Build 62
+2 ;Reference to $$INSUR^IBBAPI supported by IA 4419
+3 ;Reference to $$DEA^IBNCPDP controlled subscription by IA 4299
+4 ; Modified - IHS/MSC/PLS - 05/22/09 - Line QUE+4
DEV IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
GOTO DEV
SET PSOION=ION
+1 NEW X
SET X="PSXRSUS"
XECUTE ^%ZOSF("TEST")
IF ($TEST)&($GET(PSXSYS))&($DATA(^XUSEC("PSXCMOPMGR",DUZ)))&($DATA(^XUSEC("PSX XMIT",DUZ)))
GOTO ^PSXRSUS
DEV1 IF '$PIECE(PSOPAR,"^",8)
GOTO START
+1 NEW PSOPROP,PFIO
WRITE $CHAR(7),!!,"PROFILES MUST BE SENT TO PRINTER !!",!
KILL IOP,%ZIS,IO("Q"),POP
SET %ZIS="MNQ"
SET %ZIS("A")="Select PROFILE Device: "
DO ^%ZIS
KILL %ZIS("A")
IF POP
GOTO EXIT^PSOSULBL
IF $EXTRACT(IOST)["C"!(PSOION=ION)
GOTO DEV
SET PSOPROP=ION
DO ^%ZISC
START IF $GET(PSOCUTDT)']""
SET X1=DT
SET X2=-120
DO C^%DTC
SET PSODTCUT=X
SET PSOPRPAS=$PIECE(PSOPAR,"^",7)
ASK KILL ^TMP($JOB),PSOSU,PSOSUSPR
SET PFIOQ=0
SET PDUZ=DUZ
WRITE !
+1 SET %DT="AEX"
SET %DT("A")="Print labels through date: "
SET %DT("B")="TODAY"
DO ^%DT
KILL %DT
IF Y<0
DO MESS
IF Y<0
GOTO EXIT^PSOSULBL
SET PRTDT=Y
+2 IF '$ORDER(^PS(52.5,"C",0))!($ORDER(^(0))>PRTDT)
WRITE $CHAR(7),!!,"NOTHING THRU DATE TO PRINT"
GOTO ASK
+3 WRITE !
KILL DIR
SET DIR("A")="Sort by Patient Name, ID#, or DEA Special Handling"
SET DIR(0)="SB^P:PATIENT NAME;I:IDENTIFICATION NUMBER;D:DEA SPECIAL HANDLING"
+4 SET DIR("?")="Enter 'P' to sort the labels alphabetically by name, enter 'I' to sort by identification number, enter 'D' to sort by DEA Special Handling."
+5 SET DIR("?",1)="Sorting by DEA Special Handling will print the labels in three groups. The"
SET DIR("?",2)="first will contain labels with drugs marked with an A or C in the DEA Special"
+6 SET DIR("?",3)="Handling field, indicating NARCOTICS AND ALCOHOLICS, and CONTROLLED SUBSTANCES-"
SET DIR("?",4)="NON NARCOTIC. The second group will contain ones marked with an S, indicating"
+7 SET DIR("?",5)="SUPPLY, and all others will print in the third group."
SET DIR("?",6)=""
+8 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
DO MESS
IF $DATA(DIRUT)
GOTO EXIT^PSOSULBL
SET PSRT=$SELECT(Y="D":"D",Y="P":1,1:0)
+9 IF Y="D"
WRITE !
KILL DIR
SET DIR(0)="SB^P:PATIENT NAME;I:IDENTIFICATION NUMBER"
SET DIR("A")="Within DEA Special Handling, sort by Patient Name or ID#"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
DO MESS
IF $DATA(DIRUT)
GOTO EXIT^PSOSULBL
SET PSRTONE=Y
+10 SET X1=PRTDT
SET X2=$PIECE(PSOPAR,"^",27)
DO C^%DTC
SET XDATE=X
KILL IOP,POP,IO("Q"),ZTSK
PRLBL WRITE !
SET %ZIS("A")="Printer 'LABEL' Device: "
SET %ZIS("B")=""
SET %ZIS="MQN"
DO ^%ZIS
SET PSLION=ION
IF POP
SET IOP=PSOION
DO ^%ZIS
DO MESS
GOTO EXIT^PSOSULBL
+1 IF $EXTRACT(IOST)'["P"
DO MESSL
GOTO PRLBL
+2 NEW PSOIOS
SET PSOIOS=IOS
DO DEVBAR^PSOBMST
+3 SET PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$PIECE(PSOPAR,"^",19)
+4 KILL PSOION
DO ^%ZISC
IF $DATA(IO("Q"))
KILL IO("Q")
QUE KILL %DT,PSOTIME,PSOOUT
DO NOW^%DTC
SET %DT="REAX"
SET %DT(0)=%
SET %DT("B")="NOW"
SET %DT("A")="Queue to run at what time: "
DO ^%DT
KILL %DT
IF $DATA(DTOUT)!(Y<0)
DO MESS
GOTO EXIT^PSOSULBL
+1 SET (PSOSUSPR,PSODBQ)=1
SET PSOTIME=Y
+2 SET ZTRTN="BEG^PSOSULBL"
SET ZTDESC="PRINT LABELS FROM SUSPENSE"
SET ZTIO=PSLION
SET ZTDTH=PSOTIME
+3 FOR G="PSOPAR","PSOSYS","PSOSUSPR","PSODBQ","PSRT","PSRTONE","PSOPROP","PSLION","PFIO","PSOBARS","PSODTCUT","PSOPRPAS","PRTDT","PDUZ","PSOBAR0","PSOBAR1","PSOSITE","XDATE","PSOTIME"
IF $DATA(@G)
SET ZTSAVE(G)=""
+4 SET ZTSAVE("APS*")=""
+5 DO ^%ZTLOAD
WRITE !!,"PRINT FROM SUSPENSE JOB QUEUED!",!
DO ^%ZISC
GOTO EXIT^PSOSULBL
+6 ;G:PSRT'="D" BEG^PSOSULBL
MESS WRITE $CHAR(7),!!?3,"NOTHING QUEUED TO PRINT!",!
QUIT
MESSL WRITE $CHAR(7),!?3,"LABELS MUST BE SENT TO A PRINTER!",!
QUIT
BAIMAIL ;Send mail message
+1 IF '$GET(PDUZ)
SET PDUZ=+$GET(DUZ)
+2 KILL ^TMP("PSOM",$JOB)
+3 NEW SEQ,XMY,XMDUZ,XMSUB,XMTEXT,SEQ,NAME,PSSN,RX,FILL,FIRST
+4 SET SEQ=1
+5 SET XMY(PDUZ)=""
+6 SET XMY("G.PSO EXTERNAL DISPENSE ALERTS")=""
+7 SET XMDUZ="OUTPATIENT PHARMACY PACKAGE"
+8 SET XMSUB="BAD ADDRESS SUSPENSE NOT PRINTED"
+9 IF $GET(PSOSITE)
SET XMSUB=$$GET1^DIQ(59,PSOSITE,.06)_" "_XMSUB
+10 SET ^TMP("PSOM",$JOB,SEQ)="The following prescriptions with a routing of mail were not printed/sent to"
SET SEQ=SEQ+1
+11 SET ^TMP("PSOM",$JOB,SEQ)="external interface due to the BAD ADDRESS INDICATOR being set and no active"
SET SEQ=SEQ+1
+12 SET ^TMP("PSOM",$JOB,SEQ)="temporary address, or the patient has an active MAIL status of DO NOT MAIL, or"
SET SEQ=SEQ+1
+13 SET ^TMP("PSOM",$JOB,SEQ)="the patient has a foreign address:"
SET SEQ=SEQ+1
+14 SET NAME=""
FOR
SET NAME=$ORDER(^TMP("PSOSM",$JOB,NAME))
IF NAME=""
QUIT
Begin DoDot:1
+15 SET PSSN=""
FOR
SET PSSN=$ORDER(^TMP("PSOSM",$JOB,NAME,PSSN))
IF PSSN=""
QUIT
Begin DoDot:2
+16 SET ^TMP("PSOM",$JOB,SEQ)=""
SET SEQ=SEQ+1
+17 SET ^TMP("PSOM",$JOB,SEQ)=NAME_" "_PSSN
SET FIRST=1
+18 SET RX=0
FOR
SET RX=$ORDER(^TMP("PSOSM",$JOB,NAME,PSSN,RX))
IF 'RX
QUIT
SET FILL=""
FOR
SET FILL=$ORDER(^TMP("PSOSM",$JOB,NAME,PSSN,RX,FILL))
IF FILL=""
QUIT
Begin DoDot:3
+19 IF FIRST
Begin DoDot:4
+20 SET ^TMP("PSOM",$JOB,SEQ)=^TMP("PSOM",$JOB,SEQ)_" ("_$GET(^TMP("PSOSM",$JOB,NAME,PSSN,RX,FILL))_")"
+21 SET SEQ=SEQ+1
End DoDot:4
SET FIRST=0
+22 SET ^TMP("PSOM",$JOB,SEQ)=" "_$PIECE(^PSRX(RX,0),"^")_" ("_FILL_") "_$PIECE($GET(^PSDRUG($PIECE(^PSRX(RX,0),"^",6),0)),"^")
SET SEQ=SEQ+1
End DoDot:3
End DoDot:2
End DoDot:1
+23 SET ^TMP("PSOM",$JOB,SEQ+1)=""
+24 SET XMTEXT="^TMP(""PSOM"",$J,"
NEW DIFROM
DO ^XMD
KILL XMSUB,XMTEXT,XMY,XMDUZ
+25 QUIT
+26 ;Description:
+27 ;This function determines whether the RX SUSPENSE has a DAYS SUPPLY HOLD
+28 ;condition.
+29 ;Input: REC = Pointer to Suspense file (#52.5)
+30 ;Returns: 1 or 0
+31 ;1 (one) if ¾ of days supply has elapsed.
+32 ;0 (zero) is returned if ¾ of days supply has not elapsed.
+33 ;
DSH(REC) ; ePharmacy - verify that 3/4 days supply has elapsed before printing from suspense
+1 NEW PSINSUR,PSARR,SHDT,DSHOLD,DSHDT,PS0,COMM,DIE,DA,DR,RXIEN,RFL,DAYSSUP,LSTFIL,PTDFN,IBINS,DRG
+2 NEW DEA,DEAOK,ICD,SFN,SDT
+3 SET DSHOLD=1
SET PS0=^PS(52.5,REC,0)
SET RXIEN=$PIECE(PS0,U,1)
SET RFL=$PIECE(PS0,U,13)
+4 SET LSTFIL=$$LSTRFL^PSOBPSU1(RXIEN)
SET PTDFN=$$GET1^DIQ(52,RXIEN,"2","I")
+5 SET IBSTAT=$$INSUR^IBBAPI(PTDFN,,"E",.IBINS,"1")
SET DRG=$$GET1^DIQ(52,RXIEN,"6","I")
+6 SET (DEA,ICD)=""
SET DEA=$$GET1^DIQ(50,DRG,3)
+7 IF $DATA(^PSRX(RXIEN,"ICD",1,0))
SET ICD=^PSRX(RXIEN,"ICD",1,0)
+8 ;
+9 ; Don't hold Rx where the previous fill was not ebillable
+10 IF $$STATUS^BPSOSRX(RXIEN,LSTFIL-1)=""
QUIT DSHOLD
+11 ; Don't hold when the Rx has SC/EI flagged
+12 IF ICD[1
QUIT DSHOLD
+13 ; Don't hold rx if DEA special Handling code is non billable (i.e. has M or 0 (zero) or (I, S, N, and/or 9)) without an E
+14 SET DEAOK=$$DEA^IBNCPDP(DEA)
IF 'DEAOK
QUIT DSHOLD
+15 ; Don't hold for zero fill renewals
+16 IF 'LSTFIL
IF $$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE",,,)=""
QUIT DSHOLD
+17 ; Don't hold if no insurance
+18 IF 'IBSTAT!(IBSTAT=-1)
QUIT DSHOLD
+19 ;
+20 ; 3/4 of days supply date
SET DSHDT=$$DSHDT(RXIEN)
+21 IF DSHDT>DT
SET DSHOLD=0
Begin DoDot:1
+22 ; Update Suspense Hold Date and Activity Log
IF DSHDT'=$PIECE(PS0,U,14)
Begin DoDot:2
+23 SET COMM="3/4 of Days Supply SUSPENSE HOLD until "_$$FMTE^XLFDT(DSHDT,"2D")_"."
+24 SET DAYSSUP=$$LFDS(RXIEN)
+25 ; Update Activity Log
DO RXACT^PSOBPSU2(RXIEN,RFL,COMM,"S",+$GET(DUZ))
+26 ; File Suspense Hold Date
SET DR="10///^S X=DSHDT"
SET DIE="^PS(52.5,"
SET DA=REC
DO ^DIE
+27 NEW DA,DIE,DR,PSOX,SFN,INDT,DEAD,SUB,XOK,OLD,X,II
+28 SET DA=REC
SET DIE="^PS(52.5,"
SET DR=".02///"_DSHDT
DO ^DIE
+29 SET SFN=REC
SET DEAD=0
SET INDT=DSHDT
DO CHANGE^PSOSUCH1(RXIEN,RFL)
End DoDot:2
End DoDot:1
+30 QUIT DSHOLD
+31 ;
+32 ;Description:
+33 ;This function determines the date that 3/4 of the days supply for the
+34 ;last refill will occur.
+35 ;Input: RXIEN = Prescription file #52 IEN
+36 ;Returns: DATE/TIME value
DSHDT(RXIEN) ;
+1 NEW RXFIL,FILLDT,DAYSSUP,DSH34
+2 IF '$DATA(^PSRX(RXIEN,0))
QUIT -1
+3 ;S RXFIL=$$LSTRFL^PSOBPSU1(RXIEN) ; Last Refill
+4 ; Last Dispensed Date or Prior Fill Date for renewal
SET FILLDT=$$LDPFDT(RXIEN)
+5 ; Days Supply of Last Refill
SET DAYSSUP=$$LFDS(RXIEN)
+6 ; 3/4 of Days Supply
SET DSH34=DAYSSUP*.75
+7 ; Return today plus 3/4 of Days Supply date
QUIT $$FMADD^XLFDT(FILLDT,DSH34)
+8 ;
+9 ; Description: This function returns the DAYS SUPPLY for the Latest Fill
+10 ; for a Prescription
+11 ; Input: RXIEN = Prescription file #52 IEN
+12 ; Returns: DAYS SUPPLY for the latest fill
+13 ; -1 if RXIEN is not valid
LFDS(RXIEN) ;
+1 NEW RXFIL
+2 IF '$DATA(^PSRX(RXIEN))
QUIT -1
+3 SET RXFIL=$$LSTRFL^PSOBPSU1(RXIEN)
+4 QUIT $SELECT(RXFIL=0:$PIECE(^PSRX(RXIEN,0),U,8),1:$PIECE(^PSRX(RXIEN,1,RXFIL,0),U,10))
+5 ;
LDPFDT(RXIEN) ; Returns PRIOR FILL DATE if renewal otherwise LAST DISPENSED DATE or -1 if not valid
+1 QUIT $SELECT('$DATA(^PSRX(RXIEN)):-1,$$PRFDT(RXIEN):$$PRFDT(RXIEN),1:$$LDT(RXIEN))
+2 ;
PRFDT(RXIEN) ; Returns PRIOR FILL DATE in internal format
+1 QUIT $$GET1^DIQ(52,RXIEN_",","PRIOR FILL DATE","I",,)
+2 ;
LDT(RXIEN) ; Returns LAST DISPENSED DATE in internal format
+1 QUIT $$GET1^DIQ(52,RXIEN_",","LAST DISPENSED DATE","I",,)
