PSOREF0 ;IHS/JCM - REFILL CON'T ; 1/18/05 8:23am ;;7.0;OUTPATIENT PHARMACY;**14,152,180,186,204**;DEC 1997 ;External reference to ^PSDRUG supported by DBIA 221 ; ;PSO*186 add check for DEA Special handling field refill restrictions 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),"^") S PSOREF("DFLG")=0 D DSPLY G:PSOREF("DFLG") PROCESSX D CHECK G:$G(PSODF) PROCESS G:PSOREF("DFLG") PROCESSX D EN^PSOR52(.PSOREF) 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 '$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("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