PSOREF0 ;IHS/JCM - REFILL CON'T ;21-Nov-2010 19:44;SM
;;7.0;OUTPATIENT PHARMACY;**14,152,180,1003,1005,1009,186,204,306,1014**;DEC 1997;Build 62
;External reference to ^PSDRUG supported by DBIA 221
;
;PSO*186 add check for DEA Special handling field refill restrictions
; Modified - IHS/CIA/PLS - 01/06/04 - Line PROCESS+5 and PROCESS+8
; 08/30/05 - Line PROCESS+7
; 01/22/07 - Line PROCESS+6
; 01/25/07 - Line PROCESS+10 - Added XFROM conditional
; 11/20/10 - Line CHECK+3
PROCESS ;
K PSODF S PSOREF("RX0")=^PSRX(PSOREF("IRXN"),0),PSOREF("RX2")=^(2),PSOREF("RX3")=^(3),PSOREF("STA")=+$G(^("STA")),PSOREF("SIG")=$P($G(^("SIG")),"^"),PSOREF("PSODFN")=$P(PSOREF("RX0"),"^",2)
S PSOREF("DAYS SUPPLY")=$P(PSOREF("RX0"),"^",8)
I $D(PSORX("BAR CODE")),PSODFN'=PSOREF("PSODFN") D NEWPT
W !,"Now refilling Rx# ",$P(PSOREF("RX0"),"^")_" Drug: "_$P(^PSDRUG($P(PSOREF("RX0"),"^",6),0),"^")
K ZD(PSOREF("IRXN")) ;*306
; IHS/MSC/PLS - 01/22/07 - Added next line - Patch 1005
W !,"Patient: "_$$GET1^DIQ(2,PSODFN,.01)_" HRN: "_$$HRN^AUPNPAT(PSODFN,DUZ(2))_" LFDT: "_$$FMTE^XLFDT(+PSOREF("RX3"),"5Z")
D PRINT^APSQLAB ; IHS/CIA/PLS - 01/06/04 - Display appropriate lab results
S PSOREF("DFLG")=0 D DSPLY G:PSOREF("DFLG") PROCESSX
;IHS/CIA/PLS - 08/30/205 - Added logic to populate IHS fields
;IHS/MSC/PLS - 01/25/2007 - Added XFROM condition for AudioCare processing
D:$G(XFROM)="BATCH"!('$D(PSOREF("AWP"))) IHSSET^PSOREF1
D CHECK G:$G(PSODF) PROCESS G:PSOREF("DFLG") PROCESSX D EN^PSOR52(.PSOREF)
; IHS/CIA/PLS - 02/10/04 - Paperless refill
; 04/29/05 - PCC logic moved to APSP namespace
;S X="CIAZPRX1" X ^%ZOSF("TEST") I $T D EN^CIAZPRX1(PSOREF("PSODFN"),PSOREF("IRXN"))
D EN^APSPPCC1(PSOREF("PSODFN"),PSOREF("IRXN"))
S:$G(PSOREF("MAIL/WINDOW"))["W" BINGRTE="W",BINGCRT=1
PROCESSX D:$G(PSOREF("OLD FILL DATE"))]"" SUSDATEK^PSOUTIL(.PSOREF)
Q
DSPLY ;W !!,$P(PSOREF("RX0"),"^"),?12," ",$P(^PSDRUG($P(PSOREF("RX0"),"^",6),0),"^"),?45," SIG: "_PSOREF("SIG"),?60," QTY: ",$P(PSOREF("RX0"),"^",7)
K FSIG,BSIG I $P($G(^PSRX(PSOREF("IRXN"),"SIG")),"^",2) D FSIG^PSOUTLA("R",PSOREF("IRXN"),54) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
K FSIG,PSREV I '$P($G(^PSRX(PSOREF("IRXN"),"SIG")),"^",2) D EN2^PSOUTLA1(PSOREF("IRXN"),54)
W !!,"Qty: ",$P(PSOREF("RX0"),"^",7),?19,"Sig: ",$G(BSIG(1))
I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?24,$G(BSIG(PSREV))
K BSIG,PSREV
DSPLYX Q
CHECK ;
I '$P(PSOPAR,"^",11),$G(^PSDRUG($P(PSOREF("RX0"),"^",6),"I"))]"",DT>$G(^("I")) D G CKQ
.W $C(7),!!," *** Drug is inactive for Rx # "_$P(PSOREF("RX0"),"^")_" cannot be refilled ***",!
I '$$SCREEN^APSPMULT(+$P(PSOREF("RX0"),"^",6),,1) W $C(7),!!,"** Drug is not selectable for Rx # "_$P(PSOREF("RX0"),"^")_" cannot be refilled ***",! G CKQ ;IHS/MSC/JDS - 11/20/10
I '$D(PSORX("BAR CODE")),PSOREF("PSODFN")'=PSODFN W !!,?5,$C(7),"Can't refill Rx # "_$P(PSOREF("RX0"),"^")_", it is not for this patient." G CKQ
S (PSOX,PSOY,STA)=""
I $G(PSOSD) F S STA=$O(PSOSD(STA)) Q:STA="" F S PSOX=$O(PSOSD(STA,PSOX)) Q:PSOX']""!(PSOREF("DFLG")) I PSOREF("IRXN")=+PSOSD(STA,PSOX) S PSOY=PSOSD(STA,PSOX) I $P(PSOY,"^",4)]"" D
. S PSOREF("DFLG")=1 W:'$G(PSOERR) !,$C(7),"Cannot refill Rx # "_$P(PSOREF("RX0"),"^") S PSOREA=$P(PSOY,"^",4),PSOSTAT=PSOREF("STA")
. D STATUS^PSOUTIL(PSOREA,PSOSTAT) K PSOREA,PSOSTAT
. Q
I PSOY="" W !,$C(7),"Cannot refill, Rx is discontinued or expired. Later Rx may exist.",! D I $G(PSODF) Q
.D LOOK^PSOREF2 I $G(PSODF) Q
.S PSOREF("DFLG")=1
K PSOX,PSOY G:PSOREF("DFLG") CHECKX
I $O(^PS(52.5,"B",PSOREF("IRXN"),0)),'$G(^PS(52.5,+$O(^PS(52.5,"B",PSOREF("IRXN"),0)),"P")) W !,$C(7),"Rx is in suspense and cannot be refilled" S PSOREF("DFLG")=1 G CHECKX
;
S PSOREF("RXSTATUS")=PSOREF("STA")
I PSOREF("RXSTATUS"),PSOREF("RXSTATUS")'=6 D G CHECKX
. S PSOY=";"_PSOREF("RXSTATUS"),PSOX=$P(^DD(52,100,0),"^",3),PSOY=$F(PSOX,PSOY),PSOY=$P($E(PSOX,PSOY,999),";",1)
. W !,$C(7),"Rx is in "_PSOY_" status, cannot be refilled" S PSOREF("DFLG")=1
D CHKDIV G:PSOREF("DFLG") CHECKX
D NUMBER I PSOREF("NUMBER")>$P(PSOREF("RX0"),"^",9) W !?5,"Can't refill, no refills remaining." S PSOREF("DFLG")=1 G CHECKX
;
;PSO*7*186 check DEA, SPEC HNDLG field, in case changed, and apply
N PSODRG,PSODEA,PSODAY
S PSODRG=$G(^PSDRUG($P(PSOREF("RX0"),U,6),0)),PSODEA=$P(PSODRG,U,3)
S PSODAY=$P(PSOREF("RX0"),U,8)
I $$DEACHK^PSOUTLA1(PSOREF("IRXN"),PSODEA,PSODAY) D G CHECKX
. W $C(7),!!,"This drug has been changed, No refills allowed",!
. S PSOREF("DFLG")=1
;
D DATES
CHECKX Q
CKQ ;
S PSOREF("DFLG")=1 D PAUSE^VALM1 G CHECKX
Q
;
CHKDIV G:$P(PSOREF("RX2"),"^",9)=+PSOSITE CHKDIVX
W !?5,$C(7),"RX # ",$P(PSOREF("RX0"),"^")," is for (",$P(^PS(59,$P(PSOREF("RX2"),"^",9),0),"^"),") division."
I '$P($G(PSOSYS),"^",2) S (PSOREF("DFLG"),PSOMHV)=1 W !,"********* Not Refilled *********" G CHKDIVX
D:$P($G(PSOSYS),"^",3) DIR
CHKDIVX Q
;
NUMBER K PSOX,PSOY S PSOREF("# OF REFILLS")=0
I $G(^PSRX(PSOREF("IRXN"),1,0))]"" F PSOX=0:0 S PSOX=$O(^PSRX(PSOREF("IRXN"),1,PSOX)) Q:'PSOX S PSOREF("# OF REFILLS")=PSOX
S PSOREF("NUMBER")=PSOREF("# OF REFILLS")+1
Q
;
DATES S PSOREF("STOP DATE")=$P(PSOREF("RX2"),"^",6) D NEXT^PSOUTIL(.PSOREF)
D:$G(PSOBBC("QFLG"))&($P(PSOPAR,"^",6)) EDATE Q:$G(PSOREF("DFLG"))
S PSOREF("FILL DATE")=$S($G(PSOREF("FILL DATE")):PSOREF("FILL DATE"),1:DT)
I $P(PSOPAR,"^",6),PSOREF("FILL DATE")<$P(PSOREF("RX3"),"^",2) D SUSDATE^PSOUTIL(.PSOREF)
;
I PSOREF("FILL DATE")>PSOREF("STOP DATE") D
. W !!?5,$C(7),"Can't refill, Refill Date ",$E(PSOREF("FILL DATE"),4,5),"/",$E(PSOREF("FILL DATE"),6,7),"/"
. W $E(PSOREF("FILL DATE"),2,3)," is past Expiration Date ",$E(PSOREF("STOP DATE"),4,5),"/",$E(PSOREF("STOP DATE"),6,7),"/"
. W $E(PSOREF("STOP DATE"),2,3) S PSOREF("DFLG")=1
EDATE S PSOREF("LAST REFILL DATE")=$P(PSOREF("RX3"),"^",1)
I PSOREF("LAST REFILL DATE"),PSOREF("FILL DATE")=PSOREF("LAST REFILL DATE") D G DATESX
. W !?5,"Can't refill, Fill Date already exists for ",$E(PSOREF("FILL DATE"),4,5),"/",$E(PSOREF("FILL DATE"),6,7),"/",$E(PSOREF("FILL DATE"),2,3)
. S PSOREF("DFLG")=1
I PSOREF("LAST REFILL DATE"),PSOREF("FILL DATE")<PSOREF("LAST REFILL DATE") D G DATESX
. W !?5,"Can't refill, later Refill Date already exists for ",$E(PSOREF("LAST REFILL DATE"),4,5),"/",$E(PSOREF("LAST REFILL DATE"),6,7),"/",$E(PSOREF("LAST REFILL DATE"),2,3)
. S PSOREF("DFLG")=1
I '$P(PSOPAR,"^",6),'$D(PSOREF("EAOK")),$P(PSOREF("RX3"),"^",2)>PSOREF("FILL DATE") D
. S PSOX1=(PSOREF("NUMBER")+1)*PSOREF("DAYS SUPPLY")-10
. W !?5,$C(7),"LESS THAN ",PSOX1," DAYS FOR ",PSOREF("NUMBER")+1," FILLS",! D DIR K PSOX1
I '$P(PSOPAR,"^",6),$G(PSOREF("EAOK"))=0,$P(PSOREF("RX3"),"^",2)>PSOREF("FILL DATE") D
. S Y=$P(PSOREF("RX3"),"^",2) D DD^%DT W !!,$C(7),"Cannot be refilled until "_Y_"." S (PSOREF("DFLG"),PSOMHV)=1 K Y
DATESX Q
DIR K DIR,X,Y S DIR(0)="Y",DIR("A")="Continue ",DIR("B")="N",DIR("?")="Answer YES to Refill, NO to bypass"
D ^DIR K DIR S:$D(DIRUT)!('Y) (PSOREF("DFLG"),PSOMHV)=1 K DIRUT,DTOUT,DUOUT,X,Y
Q
NEWPT S PSOQFLG=0,(DFN,PSODFN)=PSOREF("PSODFN") D ^PSOPTPST I PSOQFLG S PSOREF("DFLG")=1,PSOQFLG=0 G NEWPTX
D PROFILE^PSOREF1
NEWPTX Q
;
EN(PSOREF) ; Entry Point for Batch Barcode Option
D PROCESS K DRUG,PSODF
Q
PSOREF0 ;IHS/JCM - REFILL CON'T ;21-Nov-2010 19:44;SM
+1 ;;7.0;OUTPATIENT PHARMACY;**14,152,180,1003,1005,1009,186,204,306,1014**;DEC 1997;Build 62
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;
+4 ;PSO*186 add check for DEA Special handling field refill restrictions
+5 ; Modified - IHS/CIA/PLS - 01/06/04 - Line PROCESS+5 and PROCESS+8
+6 ; 08/30/05 - Line PROCESS+7
+7 ; 01/22/07 - Line PROCESS+6
+8 ; 01/25/07 - Line PROCESS+10 - Added XFROM conditional
+9 ; 11/20/10 - Line CHECK+3
PROCESS ;
+1 KILL PSODF
SET PSOREF("RX0")=^PSRX(PSOREF("IRXN"),0)
SET PSOREF("RX2")=^(2)
SET PSOREF("RX3")=^(3)
SET PSOREF("STA")=+$GET(^("STA"))
SET PSOREF("SIG")=$PIECE($GET(^("SIG")),"^")
SET PSOREF("PSODFN")=$PIECE(PSOREF("RX0"),"^",2)
+2 SET PSOREF("DAYS SUPPLY")=$PIECE(PSOREF("RX0"),"^",8)
+3 IF $DATA(PSORX("BAR CODE"))
IF PSODFN'=PSOREF("PSODFN")
DO NEWPT
+4 WRITE !,"Now refilling Rx# ",$PIECE(PSOREF("RX0"),"^")_" Drug: "_$PIECE(^PSDRUG($PIECE(PSOREF("RX0"),"^",6),0),"^")
+5 ;*306
KILL ZD(PSOREF("IRXN"))
+6 ; IHS/MSC/PLS - 01/22/07 - Added next line - Patch 1005
+7 WRITE !,"Patient: "_$$GET1^DIQ(2,PSODFN,.01)_" HRN: "_$$HRN^AUPNPAT(PSODFN,DUZ(2))_" LFDT: "_$$FMTE^XLFDT(+PSOREF("RX3"),"5Z")
+8 ; IHS/CIA/PLS - 01/06/04 - Display appropriate lab results
DO PRINT^APSQLAB
+9 SET PSOREF("DFLG")=0
DO DSPLY
IF PSOREF("DFLG")
GOTO PROCESSX
+10 ;IHS/CIA/PLS - 08/30/205 - Added logic to populate IHS fields
+11 ;IHS/MSC/PLS - 01/25/2007 - Added XFROM condition for AudioCare processing
+12 IF $GET(XFROM)="BATCH"!('$DATA(PSOREF("AWP")))
DO IHSSET^PSOREF1
+13 DO CHECK
IF $GET(PSODF)
GOTO PROCESS
IF PSOREF("DFLG")
GOTO PROCESSX
DO EN^PSOR52(.PSOREF)
+14 ; IHS/CIA/PLS - 02/10/04 - Paperless refill
+15 ; 04/29/05 - PCC logic moved to APSP namespace
+16 ;S X="CIAZPRX1" X ^%ZOSF("TEST") I $T D EN^CIAZPRX1(PSOREF("PSODFN"),PSOREF("IRXN"))
+17 DO EN^APSPPCC1(PSOREF("PSODFN"),PSOREF("IRXN"))
+18 IF $GET(PSOREF("MAIL/WINDOW"))["W"
SET BINGRTE="W"
SET BINGCRT=1
PROCESSX IF $GET(PSOREF("OLD FILL DATE"))]""
DO SUSDATEK^PSOUTIL(.PSOREF)
+1 QUIT
DSPLY ;W !!,$P(PSOREF("RX0"),"^"),?12," ",$P(^PSDRUG($P(PSOREF("RX0"),"^",6),0),"^"),?45," SIG: "_PSOREF("SIG"),?60," QTY: ",$P(PSOREF("RX0"),"^",7)
+1 KILL FSIG,BSIG
IF $PIECE($GET(^PSRX(PSOREF("IRXN"),"SIG")),"^",2)
DO FSIG^PSOUTLA("R",PSOREF("IRXN"),54)
FOR PSREV=1:1
IF '$DATA(FSIG(PSREV))
QUIT
SET BSIG(PSREV)=FSIG(PSREV)
+2 KILL FSIG,PSREV
IF '$PIECE($GET(^PSRX(PSOREF("IRXN"),"SIG")),"^",2)
DO EN2^PSOUTLA1(PSOREF("IRXN"),54)
+3 WRITE !!,"Qty: ",$PIECE(PSOREF("RX0"),"^",7),?19,"Sig: ",$GET(BSIG(1))
+4 IF $ORDER(BSIG(1))
FOR PSREV=1:0
SET PSREV=$ORDER(BSIG(PSREV))
IF 'PSREV
QUIT
WRITE !?24,$GET(BSIG(PSREV))
+5 KILL BSIG,PSREV
DSPLYX QUIT
CHECK ;
+1 IF '$PIECE(PSOPAR,"^",11)
IF $GET(^PSDRUG($PIECE(PSOREF("RX0"),"^",6),"I"))]""
IF DT>$GET(^("I"))
Begin DoDot:1
+2 WRITE $CHAR(7),!!," *** Drug is inactive for Rx # "_$PIECE(PSOREF("RX0"),"^")_" cannot be refilled ***",!
End DoDot:1
GOTO CKQ
+3 ;IHS/MSC/JDS - 11/20/10
IF '$$SCREEN^APSPMULT(+$PIECE(PSOREF("RX0"),"^",6),,1)
WRITE $CHAR(7),!!,"** Drug is not selectable for Rx # "_$PIECE(PSOREF("RX0"),"^")_" cannot be refilled ***",!
GOTO CKQ
+4 IF '$DATA(PSORX("BAR CODE"))
IF PSOREF("PSODFN")'=PSODFN
WRITE !!,?5,$CHAR(7),"Can't refill Rx # "_$PIECE(PSOREF("RX0"),"^")_", it is not for this patient."
GOTO CKQ
+5 SET (PSOX,PSOY,STA)=""
+6 IF $GET(PSOSD)
FOR
SET STA=$ORDER(PSOSD(STA))
IF STA=""
QUIT
FOR
SET PSOX=$ORDER(PSOSD(STA,PSOX))
IF PSOX']""!(PSOREF("DFLG"))
QUIT
IF PSOREF("IRXN")=+PSOSD(STA,PSOX)
SET PSOY=PSOSD(STA,PSOX)
IF $PIECE(PSOY,"^",4)]""
Begin DoDot:1
+7 SET PSOREF("DFLG")=1
IF '$GET(PSOERR)
WRITE !,$CHAR(7),"Cannot refill Rx # "_$PIECE(PSOREF("RX0"),"^")
SET PSOREA=$PIECE(PSOY,"^",4)
SET PSOSTAT=PSOREF("STA")
+8 DO STATUS^PSOUTIL(PSOREA,PSOSTAT)
KILL PSOREA,PSOSTAT
+9 QUIT
End DoDot:1
+10 IF PSOY=""
WRITE !,$CHAR(7),"Cannot refill, Rx is discontinued or expired. Later Rx may exist.",!
Begin DoDot:1
+11 DO LOOK^PSOREF2
IF $GET(PSODF)
QUIT
+12 SET PSOREF("DFLG")=1
End DoDot:1
IF $GET(PSODF)
QUIT
+13 KILL PSOX,PSOY
IF PSOREF("DFLG")
GOTO CHECKX
+14 IF $ORDER(^PS(52.5,"B",PSOREF("IRXN"),0))
IF '$GET(^PS(52.5,+$ORDER(^PS(52.5,"B",PSOREF("IRXN"),0)),"P"))
WRITE !,$CHAR(7),"Rx is in suspense and cannot be refilled"
SET PSOREF("DFLG")=1
GOTO CHECKX
+15 ;
+16 SET PSOREF("RXSTATUS")=PSOREF("STA")
+17 IF PSOREF("RXSTATUS")
IF PSOREF("RXSTATUS")'=6
Begin DoDot:1
+18 SET PSOY=";"_PSOREF("RXSTATUS")
SET PSOX=$PIECE(^DD(52,100,0),"^",3)
SET PSOY=$FIND(PSOX,PSOY)
SET PSOY=$PIECE($EXTRACT(PSOX,PSOY,999),";",1)
+19 WRITE !,$CHAR(7),"Rx is in "_PSOY_" status, cannot be refilled"
SET PSOREF("DFLG")=1
End DoDot:1
GOTO CHECKX
+20 DO CHKDIV
IF PSOREF("DFLG")
GOTO CHECKX
+21 DO NUMBER
IF PSOREF("NUMBER")>$PIECE(PSOREF("RX0"),"^",9)
WRITE !?5,"Can't refill, no refills remaining."
SET PSOREF("DFLG")=1
GOTO CHECKX
+22 ;
+23 ;PSO*7*186 check DEA, SPEC HNDLG field, in case changed, and apply
+24 NEW PSODRG,PSODEA,PSODAY
+25 SET PSODRG=$GET(^PSDRUG($PIECE(PSOREF("RX0"),U,6),0))
SET PSODEA=$PIECE(PSODRG,U,3)
+26 SET PSODAY=$PIECE(PSOREF("RX0"),U,8)
+27 IF $$DEACHK^PSOUTLA1(PSOREF("IRXN"),PSODEA,PSODAY)
Begin DoDot:1
+28 WRITE $CHAR(7),!!,"This drug has been changed, No refills allowed",!
+29 SET PSOREF("DFLG")=1
End DoDot:1
GOTO CHECKX
+30 ;
+31 DO DATES
CHECKX QUIT
CKQ ;
+1 SET PSOREF("DFLG")=1
DO PAUSE^VALM1
GOTO CHECKX
+2 QUIT
+3 ;
CHKDIV IF $PIECE(PSOREF("RX2"),"^",9)=+PSOSITE
GOTO CHKDIVX
+1 WRITE !?5,$CHAR(7),"RX # ",$PIECE(PSOREF("RX0"),"^")," is for (",$PIECE(^PS(59,$PIECE(PSOREF("RX2"),"^",9),0),"^"),") division."
+2 IF '$PIECE($GET(PSOSYS),"^",2)
SET (PSOREF("DFLG"),PSOMHV)=1
WRITE !,"********* Not Refilled *********"
GOTO CHKDIVX
+3 IF $PIECE($GET(PSOSYS),"^",3)
DO DIR
CHKDIVX QUIT
+1 ;
NUMBER KILL PSOX,PSOY
SET PSOREF("# OF REFILLS")=0
+1 IF $GET(^PSRX(PSOREF("IRXN"),1,0))]""
FOR PSOX=0:0
SET PSOX=$ORDER(^PSRX(PSOREF("IRXN"),1,PSOX))
IF 'PSOX
QUIT
SET PSOREF("# OF REFILLS")=PSOX
+2 SET PSOREF("NUMBER")=PSOREF("# OF REFILLS")+1
+3 QUIT
+4 ;
DATES SET PSOREF("STOP DATE")=$PIECE(PSOREF("RX2"),"^",6)
DO NEXT^PSOUTIL(.PSOREF)
+1 IF $GET(PSOBBC("QFLG"))&($PIECE(PSOPAR,"^",6))
DO EDATE
IF $GET(PSOREF("DFLG"))
QUIT
+2 SET PSOREF("FILL DATE")=$SELECT($GET(PSOREF("FILL DATE")):PSOREF("FILL DATE"),1:DT)
+3 IF $PIECE(PSOPAR,"^",6)
IF PSOREF("FILL DATE")<$PIECE(PSOREF("RX3"),"^",2)
DO SUSDATE^PSOUTIL(.PSOREF)
+4 ;
+5 IF PSOREF("FILL DATE")>PSOREF("STOP DATE")
Begin DoDot:1
+6 WRITE !!?5,$CHAR(7),"Can't refill, Refill Date ",$EXTRACT(PSOREF("FILL DATE"),4,5),"/",$EXTRACT(PSOREF("FILL DATE"),6,7),"/"
+7 WRITE $EXTRACT(PSOREF("FILL DATE"),2,3)," is past Expiration Date ",$EXTRACT(PSOREF("STOP DATE"),4,5),"/",$EXTRACT(PSOREF("STOP DATE"),6,7),"/"
+8 WRITE $EXTRACT(PSOREF("STOP DATE"),2,3)
SET PSOREF("DFLG")=1
End DoDot:1
EDATE SET PSOREF("LAST REFILL DATE")=$PIECE(PSOREF("RX3"),"^",1)
+1 IF PSOREF("LAST REFILL DATE")
IF PSOREF("FILL DATE")=PSOREF("LAST REFILL DATE")
Begin DoDot:1
+2 WRITE !?5,"Can't refill, Fill Date already exists for ",$EXTRACT(PSOREF("FILL DATE"),4,5),"/",$EXTRACT(PSOREF("FILL DATE"),6,7),"/",$EXTRACT(PSOREF("FILL DATE"),2,3)
+3 SET PSOREF("DFLG")=1
End DoDot:1
GOTO DATESX
+4 IF PSOREF("LAST REFILL DATE")
IF PSOREF("FILL DATE")<PSOREF("LAST REFILL DATE")
Begin DoDot:1
+5 WRITE !?5,"Can't refill, later Refill Date already exists for ",$EXTRACT(PSOREF("LAST REFILL DATE"),4,5),"/",$EXTRACT(PSOREF("LAST REFILL DATE"),6,7),"/",$EXTRACT(PSOREF("LAST REFILL DATE"),2,3)
+6 SET PSOREF("DFLG")=1
End DoDot:1
GOTO DATESX
+7 IF '$PIECE(PSOPAR,"^",6)
IF '$DATA(PSOREF("EAOK"))
IF $PIECE(PSOREF("RX3"),"^",2)>PSOREF("FILL DATE")
Begin DoDot:1
+8 SET PSOX1=(PSOREF("NUMBER")+1)*PSOREF("DAYS SUPPLY")-10
+9 WRITE !?5,$CHAR(7),"LESS THAN ",PSOX1," DAYS FOR ",PSOREF("NUMBER")+1," FILLS",!
DO DIR
KILL PSOX1
End DoDot:1
+10 IF '$PIECE(PSOPAR,"^",6)
IF $GET(PSOREF("EAOK"))=0
IF $PIECE(PSOREF("RX3"),"^",2)>PSOREF("FILL DATE")
Begin DoDot:1
+11 SET Y=$PIECE(PSOREF("RX3"),"^",2)
DO DD^%DT
WRITE !!,$CHAR(7),"Cannot be refilled until "_Y_"."
SET (PSOREF("DFLG"),PSOMHV)=1
KILL Y
End DoDot:1
DATESX QUIT
DIR KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("A")="Continue "
SET DIR("B")="N"
SET DIR("?")="Answer YES to Refill, NO to bypass"
+1 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!('Y)
SET (PSOREF("DFLG"),PSOMHV)=1
KILL DIRUT,DTOUT,DUOUT,X,Y
+2 QUIT
NEWPT SET PSOQFLG=0
SET (DFN,PSODFN)=PSOREF("PSODFN")
DO ^PSOPTPST
IF PSOQFLG
SET PSOREF("DFLG")=1
SET PSOQFLG=0
GOTO NEWPTX
+1 DO PROFILE^PSOREF1
NEWPTX QUIT
+1 ;
EN(PSOREF) ; Entry Point for Batch Barcode Option
+1 DO PROCESS
KILL DRUG,PSODF
+2 QUIT
