- PSODRDUP ;BIR/SAB - Dup drug class checker ;29-May-2012 14:45;PLS
- ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,39,56,130,132,1006,1009,1011,1013,192,207,222,243,305,1015**;DEC 1997;Build 62
- ;
- ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- ; Modified - IHS/MSC/PLS - 10/05/07 - Added auto RTS/Delete feature
- ; 09/27/10 - Added Expired med to ASKCAN1+8
- ; 10/19/10 - Added EXPCMF API
- ; 03/28/11 - Added ASKCAN+12
- ; 03/20/12 - Added $$UP to PSODRUG("NAME") +13,+17,+18
- S $P(PSONULN,"-",79)="-",(STA,DNM)="" K CLS
- F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM=""!$G(PSORX("DFLG")) I $P(PSOSD(STA,DNM),"^")'=$G(PSORENW("OIRXN")) D Q:$G(PSORX("DFLG"))
- .I STA="PENDING" D ^PSODRDU1 Q
- .I STA="ZNONVA" D NVA^PSODRDU1 Q
- .D:$$UP^XLFSTR(PSODRUG("NAME"))=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG"))
- ..I $P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
- ..I $P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
- ..I '$P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
- .D:$$UP^XLFSTR(PSODRUG("NAME"))=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP Q:$G(PSORX("DFLG"))
- .I PSODRUG("VA CLASS")]"",$E(PSODRUG("VA CLASS"),1,4)=$E($P(PSOSD(STA,DNM),"^",5),1,4),$$UP^XLFSTR(PSODRUG("NAME"))'=$P(DNM,"^") D CLS
- K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI")
- D REMOTE^PSOCPDUP
- EXIT D ^PSOBUILD K CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
- Q
- DUP S:$P(PSOSD(STA,DNM),"^",2)<10!($P(PSOSD(STA,DNM),"^",2)=16) DUP=1 W !,PSONULN,!,$C(7),"Duplicate Drug "_$P(DNM,"^")_" in Prescription: ",$P(^PSRX(+PSOSD(STA,DNM),0),"^")
- S RXREC=+PSOSD(STA,DNM),MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug"
- DATA S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),$P(RX0,"^",15)=+$G(^PSRX(RXREC,"STA"))
- S RXRECLOC=$G(RXREC)
- W !!,$J("Status: ",24) S J=RXREC D STAT^PSOFUNC W ST K RX0,RX2 W ?40,$J("Issued: ",24),$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3)
- S DA=RXREC D PRSTAT(DA)
- K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,54) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
- K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,54)
- W !,$J("SIG: ",24) W $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
- W !,$J("QTY: ",24)_$P(DUPRX0,"^",7),?40,$J("# of refills: ",24)_RFLS S PHYS=$S($D(^VA(200,+$P(DUPRX0,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN")
- W !,$J("Provider: ",24)_PHYS,?40,$J("Refills remaining: ",24),RFLS-$S($D(^PSRX(RXREC,1,0)):$P(^(0),"^",4),1:0)
- S LSTFL=+^PSRX(RXREC,3) W !?40,$J("Last filled on: ",24)_$E(LSTFL,4,5)_"/"_$E(LSTFL,6,7)_"/"_$E(LSTFL,2,3),!?40,$J("Days Supply: ",24)_$P(DUPRX0,"^",8)
- W !,PSONULN,! I $P($G(^PS(53,+$P($G(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS"!($G(PSORX("PATIENT STATUS"))["AUTH ABS")&'$P(PSOPAR,"^",5) W !,"PATIENT ON AUTHORIZED ABSENCE!" K RXRECLOC Q
- ASKCAN ;IHS/MSC/PLS - 09/27/10
- N APSPCMF
- ;I $P(PSOSD(STA,DNM),"^",2)>10,$P(PSOSD(STA,DNM),"^",2)'=16 K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT,RXRECLOC Q
- I $P(PSOSD(STA,DNM),"^",2)>10,$P(PSOSD(STA,DNM),"^",2)'=16 S:$P(PSOSD(STA,DNM),U,2)=11 APSPCMF=1 D:$G(APSPCMF) EXPCMF K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT,RXRECLOC Q
- I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)),'$G(CLS) S PSORX("DFLG")=1 K RXRECLOC Q
- I $P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)),'$G(CLS) S PSORX("DFLG")=1 K RXRECLOC Q
- I $P(PSOSD(STA,DNM),"^",2)=16,$G(DUP) W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! K DUP,RXRECLOC S PSORX("DFLG")=1 Q
- D PSOL^PSSLOCK(RXRECLOC) I '$G(PSOMSG) D K PSOMSG,DIR,DUP,RXRECLOC S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR K DIR S PSORX("DFLG")=1 Q
- .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q
- .W !!,"Another person is editing Rx "_$P($G(^PSRX(RXRECLOC,0)),"^"),!
- ; IHS/MSC/PLS - 10/05/07 - added next two lines
- ;N APSPRTS,APSPQ S:$P(^PSRX(RXREC,2),U,2)=DT&('($P(PSOSD(STA,DNM),"^",2)=12)) APSPRTS=$$DIRYN^APSPUTIL("Return Rx # "_$P(^PSRX(+PSOSD(STA,DNM),0),U)_" to stock and mark it for deletion?","YES",,.APSPQ)
- ; IHS/MSC/PLS - 03/28/2011 - removed default and set to required
- N APSPRTS,APSPQ S:$P(^PSRX(RXREC,2),U,2)=DT&('($P(PSOSD(STA,DNM),"^",2)=12)) APSPRTS=$$DIRYN^APSPUTIL("Return Rx # "_$P(^PSRX(+PSOSD(STA,DNM),0),U)_" to stock and mark it for deletion?","Yes",,.APSPQ)
- I '$G(APSPQ),$G(APSPRTS),$$CHK(.APSPRTS,RXREC) S Y=1 G ASKCAN1
- K PSOMSG S DIR("A")=$S($P(PSOSD(STA,DNM),"^",2)=12:"Reinstate",1:"Discontinue")_" RX # "_$P(^PSRX(+PSOSD(STA,DNM),0),"^"),DIR(0)="Y",DIR("?")="Enter Y to "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstate",1:"discontinue")_" this RX."
- D ^DIR K DIR
- ASKCAN1 S DA=RXREC S ACT=$S($D(SPCANC):"Reinstated during Rx cancel.",1:$S($P(PSOSD(STA,DNM),"^",2)=12:"Reinstated",1:"Discontinued")_" while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX")
- D CMOP^PSOUTL I $G(CMOP("S"))="L" W !,"A CMOP Rx cannot be discontinued during transmission!",! S Y=0 K CMOP
- I 'Y W $C(7)," -Prescription was not "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstated",1:"discontinued")_"..." D Q
- .S:'$D(PSOCLC) PSOCLC=DUZ S MSG=ACT,REA=$S($P(PSOSD(STA,DNM),"^",2)=12:"R",1:"C") S:$G(DUP) PSORX("DFLG")=1 K DUP D ULRX K RXRECLOC
- .I $D(^TMP("PSORXDC",$J,RXREC,0)) K ^TMP("PSORXDC",$J,RXREC,0)
- I $P(PSOSD(STA,DNM),"^",2)=16,$G(CLS) W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! D ULRX K CLS,DUP,RXRECLOC S PSORX("DFLG")=1 H 2 Q
- S PSOCLC=DUZ,MSG=$S($G(MSG)]"":MSG,1:ACT_" During New RX "_$S('$G(PSONV):"Entry",1:"Verification")_" - Duplicate Rx"),REA=$S($P(PSOSD(STA,DNM),"^",2)=12:"R",1:"C")
- W !!,"Duplicate "_$S($G(CLS):"Class",1:"Drug")_" will be discontinued after the acceptance of the new order.",!
- S ^TMP("PSORXDC",$J,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_STA_"^"_DNM,PSONOOR="D"
- K RXRECLOC,DUP,CLS,PSONOOR Q
- CLS K DUP
- I $E($G(PSODRUG("VA CLASS")),1,2)="HA",$E($P($G(PSOSD(STA,DNM)),"^",5),1,2)="HA" K PSOELSE Q
- S CLS=1,MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class" W !,PSONULN
- W !?5,$C(7),"*** SAME CLASS *** OF DRUG IN RX #"_$P(^PSRX(+PSOSD(STA,DNM),0),"^")_" FOR "_$P(DNM,"^"),!,"CLASS: "_PSODRUG("VA CLASS")
- S CAN=$P(PSOSD(STA,DNM),"^",2)'<11!($P(PSOSD(STA,DNM),"^",2)=1) S RXREC=+PSOSD(STA,DNM) I $P($G(PSOPAR),"^",10) D DATA Q
- E W !,PSONULN K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT
- K PSOELSE Q
- ULRX ;
- I '$G(RXRECLOC) Q
- D PSOUL^PSSLOCK(RXRECLOC)
- Q
- ;
- PRSTAT(DA) ;Displays the prescription's status
- N PSOTRANS,PSOREL,CMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS
- S RXPSTA="Processing Status: ",PSOLRD=$P($G(^PSRX(RXREC,2)),"^",13)
- D ^PSOCMOPA I $G(PSOCMOP)]"" D K CMOP,PSOTRANS,PSOREL
- .S PSOTRANS=$E($P(PSOCMOP,"^",2),4,5)_"/"_$E($P(PSOCMOP,"^",2),6,7)_"/"_$E($P(PSOCMOP,"^",2),2,3)
- .S PSOREL=$S(CMOP("L")=0:$P($G(^PSRX(DA,2)),"^",13),1:$P(^PSRX(DA,1,CMOP("L"),0),"^",18))
- .S PSOREL=$E(PSOREL,4,5)_"/"_$E(PSOREL,6,7)_"/"_$E(PSOREL,2,3)_"@"_$E($P(PSOREL,".",2),1,4)
- .W !,$J(RXPSTA,24)_$S($P(PSOCMOP,"^")=0!($P(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$P(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed")
- I $G(PSOCMOP)']"" D
- .F PSOX=0:0 S PSOX=$O(^PSRX(RXREC,1,PSOX)) Q:'PSOX D
- ..S RFLZRO=$G(^PSRX(RXREC,1,PSOX,0))
- ..S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R",PSORTS=$P(RFLZRO,"^",16)
- .I '$O(^PSRX(RXREC,1,0)),$P(^PSRX(RXREC,2),"^",15) S PSOLRD=PSOLRD_"^R",PSORTS=$P(^PSRX(RXREC,2),"^",15)
- .W !,$J(RXPSTA,24) I +$G(PSORTS) W "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2) Q
- .W $S(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($P(PSOLRD,"^"),2)_" "_$P(PSOLRD,"^",2))_$S($P(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
- Q
- ; Apply additional auto RTS/Delete business rules
- ; Input: FLG - pass by reference
- ; RX - Prescription IEN
- ; Return: Boolean flag - 1: auto RS/Delete 0: normal process
- CHK(FLG,RX) ; EP - IHS/MSC/PLS - 10/05/07 - New API for auto RTS/delete feature
- ;Only allow auto RTS/Delete on original prescriptions
- I $O(^PSRX(RX,1,0))!$O(^PSRX(RX,"P",0)) D Q FLG
- .S FLG=0
- .W !,"The auto RTS/Delete feature is only available for original prescriptions."
- .W !,"This prescription has a refill and/or partial fill."
- ; Apply business rules for controlled substances
- N NAR,NMSG
- S NAR=$P($G(^PSDRUG(+$G(PSODRUG("IEN")),2)),U,3)["N"
- S NMSG="An Electronic Signature is required to auto RTS/Delete a controlled drug."
- I NAR,'$D(^XUSEC("PSDMGR",DUZ)) D Q FLG
- .W !,"You must possess the PSDMGR security key to RTS controlled substance."
- .S FLG=0
- I NAR D
- .N X,X1,EXIT
- .S EXIT=0
- .F Q:EXIT D
- ..D SIG^XUSESIG
- ..I X[U S FLG=0,EXIT=1 W !,NMSG,!,"Bypassing auto RTS/Delete feature." Q
- ..I X1'="" S EXIT=1 Q
- ..W !,NMSG
- ..W !,"Please try again...Enter '^' to bypass."
- Q FLG
- EXPCMF ; EP - Set flag to remove CMF flag on expired duplicate meds
- S ^TMP("PSORXDC",$J,RXREC,0)="52^"_RXREC_"^^^^"_STA_"^"_DNM_U_$G(APSPRTS)_U_$G(APSPCMF)
- Q
- PSODRDUP ;BIR/SAB - Dup drug class checker ;29-May-2012 14:45;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,39,56,130,132,1006,1009,1011,1013,192,207,222,243,305,1015**;DEC 1997;Build 62
- +2 ;
- +3 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- +4 ; Modified - IHS/MSC/PLS - 10/05/07 - Added auto RTS/Delete feature
- +5 ; 09/27/10 - Added Expired med to ASKCAN1+8
- +6 ; 10/19/10 - Added EXPCMF API
- +7 ; 03/28/11 - Added ASKCAN+12
- +8 ; 03/20/12 - Added $$UP to PSODRUG("NAME") +13,+17,+18
- +9 SET $PIECE(PSONULN,"-",79)="-"
- SET (STA,DNM)=""
- KILL CLS
- +10 FOR
- SET STA=$ORDER(PSOSD(STA))
- IF STA=""
- QUIT
- FOR
- SET DNM=$ORDER(PSOSD(STA,DNM))
- IF DNM=""!$GET(PSORX("DFLG"))
- QUIT
- IF $PIECE(PSOSD(STA,DNM),"^")'=$GET(PSORENW("OIRXN"))
- Begin DoDot:1
- +11 IF STA="PENDING"
- DO ^PSODRDU1
- QUIT
- +12 IF STA="ZNONVA"
- DO NVA^PSODRDU1
- QUIT
- +13 IF $$UP^XLFSTR(PSODRUG("NAME"))=$PIECE(DNM,"^")&('$DATA(^XUSEC("PSORPH",DUZ)))
- Begin DoDot:2
- +14 IF $PIECE($GET(PSOPAR),"^",16)
- DO DUP
- IF $GET(PSORX("DFLG"))
- QUIT
- +15 IF $PIECE(PSOPAR,"^",2)
- IF '$PIECE($GET(PSOPAR),"^",16)
- DO DUP
- IF $GET(PSORX("DFLG"))
- QUIT
- +16 IF '$PIECE(PSOPAR,"^",2)
- IF '$PIECE($GET(PSOPAR),"^",16)
- DO DUP
- IF $GET(PSORX("DFLG"))
- QUIT
- End DoDot:2
- IF $GET(PSORX("DFLG"))
- QUIT
- +17 IF $$UP^XLFSTR(PSODRUG("NAME"))=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
- DO DUP
- IF $GET(PSORX("DFLG"))
- QUIT
- +18 IF PSODRUG("VA CLASS")]""
- IF $EXTRACT(PSODRUG("VA CLASS"),1,4)=$EXTRACT($PIECE(PSOSD(STA,DNM),"^",5),1,4)
- IF $$UP^XLFSTR(PSODRUG("NAME"))'=$PIECE(DNM,"^")
- DO CLS
- End DoDot:1
- IF $GET(PSORX("DFLG"))
- QUIT
- +19 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI")
- +20 DO REMOTE^PSOCPDUP
- EXIT DO ^PSOBUILD
- KILL CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
- +1 QUIT
- DUP IF $PIECE(PSOSD(STA,DNM),"^",2)<10!($PIECE(PSOSD(STA,DNM),"^",2)=16)
- SET DUP=1
- WRITE !,PSONULN,!,$CHAR(7),"Duplicate Drug "_$PIECE(DNM,"^")_" in Prescription: ",$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")
- +1 SET RXREC=+PSOSD(STA,DNM)
- SET MSG="Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug"
- DATA SET DUPRX0=^PSRX(RXREC,0)
- SET RFLS=$PIECE(DUPRX0,"^",9)
- SET ISSD=$PIECE(^PSRX(RXREC,0),"^",13)
- SET RX0=DUPRX0
- SET RX2=^PSRX(RXREC,2)
- SET $PIECE(RX0,"^",15)=+$GET(^PSRX(RXREC,"STA"))
- +1 SET RXRECLOC=$GET(RXREC)
- +2 WRITE !!,$JUSTIFY("Status: ",24)
- SET J=RXREC
- DO STAT^PSOFUNC
- WRITE ST
- KILL RX0,RX2
- WRITE ?40,$JUSTIFY("Issued: ",24),$EXTRACT(ISSD,4,5)_"/"_$EXTRACT(ISSD,6,7)_"/"_$EXTRACT(ISSD,2,3)
- +3 SET DA=RXREC
- DO PRSTAT(DA)
- +4 KILL FSIG,BSIG
- IF $PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
- DO FSIG^PSOUTLA("R",RXREC,54)
- FOR PSREV=1:1
- IF '$DATA(FSIG(PSREV))
- QUIT
- SET BSIG(PSREV)=FSIG(PSREV)
- +5 KILL FSIG,PSREV
- IF '$PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
- DO EN2^PSOUTLA1(RXREC,54)
- +6 WRITE !,$JUSTIFY("SIG: ",24)
- WRITE $GET(BSIG(1))
- +7 IF $ORDER(BSIG(1))
- FOR PSREV=1:0
- SET PSREV=$ORDER(BSIG(PSREV))
- IF 'PSREV
- QUIT
- WRITE !?24,$GET(BSIG(PSREV))
- +8 KILL BSIG,PSREV
- +9 WRITE !,$JUSTIFY("QTY: ",24)_$PIECE(DUPRX0,"^",7),?40,$JUSTIFY("# of refills: ",24)_RFLS
- SET PHYS=$SELECT($DATA(^VA(200,+$PIECE(DUPRX0,"^",4),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- +10 WRITE !,$JUSTIFY("Provider: ",24)_PHYS,?40,$JUSTIFY("Refills remaining: ",24),RFLS-$SELECT($DATA(^PSRX(RXREC,1,0)):$PIECE(^(0),"^",4),1:0)
- +11 SET LSTFL=+^PSRX(RXREC,3)
- WRITE !?40,$JUSTIFY("Last filled on: ",24)_$EXTRACT(LSTFL,4,5)_"/"_$EXTRACT(LSTFL,6,7)_"/"_$EXTRACT(LSTFL,2,3),!?40,$JUSTIFY("Days Supply: ",24)_$PIECE(DUPRX0,"^",8)
- +12 WRITE !,PSONULN,!
- IF $PIECE($GET(^PS(53,+$PIECE($GET(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS"!($GET(PSORX("PATIENT STATUS"))["AUTH ABS")&'$PIECE(PSOPAR,"^",5)
- WRITE !,"PATIENT ON AUTHORIZED ABSENCE!"
- KILL RXRECLOC
- QUIT
- ASKCAN ;IHS/MSC/PLS - 09/27/10
- +1 NEW APSPCMF
- +2 ;I $P(PSOSD(STA,DNM),"^",2)>10,$P(PSOSD(STA,DNM),"^",2)'=16 K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT,RXRECLOC Q
- +3 IF $PIECE(PSOSD(STA,DNM),"^",2)>10
- IF $PIECE(PSOSD(STA,DNM),"^",2)'=16
- IF $PIECE(PSOSD(STA,DNM),U,2)=11
- SET APSPCMF=1
- IF $GET(APSPCMF)
- DO EXPCMF
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DTOUT,DUOUT,DIRUT,RXRECLOC
- QUIT
- +4 IF '$PIECE(PSOPAR,"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF '$GET(CLS)
- SET PSORX("DFLG")=1
- KILL RXRECLOC
- QUIT
- +5 IF $PIECE(PSOPAR,"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF '$GET(CLS)
- SET PSORX("DFLG")=1
- KILL RXRECLOC
- QUIT
- +6 IF $PIECE(PSOSD(STA,DNM),"^",2)=16
- IF $GET(DUP)
- WRITE !!,"Prescription "_$PIECE($GET(^PSRX(+$GET(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",!
- KILL DUP,RXRECLOC
- SET PSORX("DFLG")=1
- QUIT
- +7 DO PSOL^PSSLOCK(RXRECLOC)
- IF '$GET(PSOMSG)
- Begin DoDot:1
- +8 IF $PIECE($GET(PSOMSG),"^",2)'=""
- WRITE !!,$PIECE(PSOMSG,"^",2),!
- QUIT
- +9 WRITE !!,"Another person is editing Rx "_$PIECE($GET(^PSRX(RXRECLOC,0)),"^"),!
- End DoDot:1
- KILL PSOMSG,DIR,DUP,RXRECLOC
- SET DIR("A")="Press Return to continue"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- SET PSORX("DFLG")=1
- QUIT
- +10 ; IHS/MSC/PLS - 10/05/07 - added next two lines
- +11 ;N APSPRTS,APSPQ S:$P(^PSRX(RXREC,2),U,2)=DT&('($P(PSOSD(STA,DNM),"^",2)=12)) APSPRTS=$$DIRYN^APSPUTIL("Return Rx # "_$P(^PSRX(+PSOSD(STA,DNM),0),U)_" to stock and mark it for deletion?","YES",,.APSPQ)
- +12 ; IHS/MSC/PLS - 03/28/2011 - removed default and set to required
- +13 NEW APSPRTS,APSPQ
- IF $PIECE(^PSRX(RXREC,2),U,2)=DT&('($PIECE(PSOSD(STA,DNM),"^",2)=12))
- SET APSPRTS=$$DIRYN^APSPUTIL("Return Rx # "_$PIECE(^PSRX(+PSOSD(STA,DNM),0),U)_" to stock and mark it for deletion?","Yes",,.APSPQ)
- +14 IF '$GET(APSPQ)
- IF $GET(APSPRTS)
- IF $$CHK(.APSPRTS,RXREC)
- SET Y=1
- GOTO ASKCAN1
- +15 KILL PSOMSG
- SET DIR("A")=$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"Reinstate",1:"Discontinue")_" RX # "_$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")
- SET DIR(0)="Y"
- SET DIR("?")="Enter Y to "_$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"reinstate",1:"discontinue")_" this RX."
- +16 DO ^DIR
- KILL DIR
- ASKCAN1 SET DA=RXREC
- SET ACT=$SELECT($DATA(SPCANC):"Reinstated during Rx cancel.",1:$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"Reinstated",1:"Discontinued")_" while "_$SELECT('$GET(PSONV):"entering",1:"verifying")_" new RX")
- +1 DO CMOP^PSOUTL
- IF $GET(CMOP("S"))="L"
- WRITE !,"A CMOP Rx cannot be discontinued during transmission!",!
- SET Y=0
- KILL CMOP
- +2 IF 'Y
- WRITE $CHAR(7)," -Prescription was not "_$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"reinstated",1:"discontinued")_"..."
- Begin DoDot:1
- +3 IF '$DATA(PSOCLC)
- SET PSOCLC=DUZ
- SET MSG=ACT
- SET REA=$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"R",1:"C")
- IF $GET(DUP)
- SET PSORX("DFLG")=1
- KILL DUP
- DO ULRX
- KILL RXRECLOC
- +4 IF $DATA(^TMP("PSORXDC",$JOB,RXREC,0))
- KILL ^TMP("PSORXDC",$JOB,RXREC,0)
- End DoDot:1
- QUIT
- +5 IF $PIECE(PSOSD(STA,DNM),"^",2)=16
- IF $GET(CLS)
- WRITE !!,"Prescription "_$PIECE($GET(^PSRX(+$GET(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",!
- DO ULRX
- KILL CLS,DUP,RXRECLOC
- SET PSORX("DFLG")=1
- HANG 2
- QUIT
- +6 SET PSOCLC=DUZ
- SET MSG=$SELECT($GET(MSG)]"":MSG,1:ACT_" During New RX "_$SELECT('$GET(PSONV):"Entry",1:"Verification")_" - Duplicate Rx")
- SET REA=$SELECT($PIECE(PSOSD(STA,DNM),"^",2)=12:"R",1:"C")
- +7 WRITE !!,"Duplicate "_$SELECT($GET(CLS):"Class",1:"Drug")_" will be discontinued after the acceptance of the new order.",!
- +8 SET ^TMP("PSORXDC",$JOB,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_STA_"^"_DNM
- SET PSONOOR="D"
- +9 KILL RXRECLOC,DUP,CLS,PSONOOR
- QUIT
- CLS KILL DUP
- +1 IF $EXTRACT($GET(PSODRUG("VA CLASS")),1,2)="HA"
- IF $EXTRACT($PIECE($GET(PSOSD(STA,DNM)),"^",5),1,2)="HA"
- KILL PSOELSE
- QUIT
- +2 SET CLS=1
- SET MSG="Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class"
- WRITE !,PSONULN
- +3 WRITE !?5,$CHAR(7),"*** SAME CLASS *** OF DRUG IN RX #"_$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")_" FOR "_$PIECE(DNM,"^"),!,"CLASS: "_PSODRUG("VA CLASS")
- +4 SET CAN=$PIECE(PSOSD(STA,DNM),"^",2)'<11!($PIECE(PSOSD(STA,DNM),"^",2)=1)
- SET RXREC=+PSOSD(STA,DNM)
- IF $PIECE($GET(PSOPAR),"^",10)
- DO DATA
- QUIT
- +5 IF '$TEST
- WRITE !,PSONULN
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DTOUT,DUOUT,DIRUT
- +6 KILL PSOELSE
- QUIT
- ULRX ;
- +1 IF '$GET(RXRECLOC)
- QUIT
- +2 DO PSOUL^PSSLOCK(RXRECLOC)
- +3 QUIT
- +4 ;
- PRSTAT(DA) ;Displays the prescription's status
- +1 NEW PSOTRANS,PSOREL,CMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS
- +2 SET RXPSTA="Processing Status: "
- SET PSOLRD=$PIECE($GET(^PSRX(RXREC,2)),"^",13)
- +3 DO ^PSOCMOPA
- IF $GET(PSOCMOP)]""
- Begin DoDot:1
- +4 SET PSOTRANS=$EXTRACT($PIECE(PSOCMOP,"^",2),4,5)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),6,7)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),2,3)
- +5 SET PSOREL=$SELECT(CMOP("L")=0:$PIECE($GET(^PSRX(DA,2)),"^",13),1:$PIECE(^PSRX(DA,1,CMOP("L"),0),"^",18))
- +6 SET PSOREL=$EXTRACT(PSOREL,4,5)_"/"_$EXTRACT(PSOREL,6,7)_"/"_$EXTRACT(PSOREL,2,3)_"@"_$EXTRACT($PIECE(PSOREL,".",2),1,4)
- +7 WRITE !,$JUSTIFY(RXPSTA,24)_$SELECT($PIECE(PSOCMOP,"^")=0!($PIECE(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$PIECE(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed")
- End DoDot:1
- KILL CMOP,PSOTRANS,PSOREL
- +8 IF $GET(PSOCMOP)']""
- Begin DoDot:1
- +9 FOR PSOX=0:0
- SET PSOX=$ORDER(^PSRX(RXREC,1,PSOX))
- IF 'PSOX
- QUIT
- Begin DoDot:2
- +10 SET RFLZRO=$GET(^PSRX(RXREC,1,PSOX,0))
- +11 IF $PIECE(RFLZRO,"^",18)'=""
- SET PSOLRD=$PIECE(RFLZRO,"^",18)
- IF $PIECE(RFLZRO,"^",16)
- SET PSOLRD=PSOLRD_"^R"
- SET PSORTS=$PIECE(RFLZRO,"^",16)
- End DoDot:2
- +12 IF '$ORDER(^PSRX(RXREC,1,0))
- IF $PIECE(^PSRX(RXREC,2),"^",15)
- SET PSOLRD=PSOLRD_"^R"
- SET PSORTS=$PIECE(^PSRX(RXREC,2),"^",15)
- +13 WRITE !,$JUSTIFY(RXPSTA,24)
- IF +$GET(PSORTS)
- WRITE "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2)
- QUIT
- +14 WRITE $SELECT(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($PIECE(PSOLRD,"^"),2)_" "_$PIECE(PSOLRD,"^",2))_$SELECT($PIECE(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
- End DoDot:1
- +15 QUIT
- +16 ; Apply additional auto RTS/Delete business rules
- +17 ; Input: FLG - pass by reference
- +18 ; RX - Prescription IEN
- +19 ; Return: Boolean flag - 1: auto RS/Delete 0: normal process
- CHK(FLG,RX) ; EP - IHS/MSC/PLS - 10/05/07 - New API for auto RTS/delete feature
- +1 ;Only allow auto RTS/Delete on original prescriptions
- +2 IF $ORDER(^PSRX(RX,1,0))!$ORDER(^PSRX(RX,"P",0))
- Begin DoDot:1
- +3 SET FLG=0
- +4 WRITE !,"The auto RTS/Delete feature is only available for original prescriptions."
- +5 WRITE !,"This prescription has a refill and/or partial fill."
- End DoDot:1
- QUIT FLG
- +6 ; Apply business rules for controlled substances
- +7 NEW NAR,NMSG
- +8 SET NAR=$PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),2)),U,3)["N"
- +9 SET NMSG="An Electronic Signature is required to auto RTS/Delete a controlled drug."
- +10 IF NAR
- IF '$DATA(^XUSEC("PSDMGR",DUZ))
- Begin DoDot:1
- +11 WRITE !,"You must possess the PSDMGR security key to RTS controlled substance."
- +12 SET FLG=0
- End DoDot:1
- QUIT FLG
- +13 IF NAR
- Begin DoDot:1
- +14 NEW X,X1,EXIT
- +15 SET EXIT=0
- +16 FOR
- IF EXIT
- QUIT
- Begin DoDot:2
- +17 DO SIG^XUSESIG
- +18 IF X[U
- SET FLG=0
- SET EXIT=1
- WRITE !,NMSG,!,"Bypassing auto RTS/Delete feature."
- QUIT
- +19 IF X1'=""
- SET EXIT=1
- QUIT
- +20 WRITE !,NMSG
- +21 WRITE !,"Please try again...Enter '^' to bypass."
- End DoDot:2
- End DoDot:1
- +22 QUIT FLG
- EXPCMF ; EP - Set flag to remove CMF flag on expired duplicate meds
- +1 SET ^TMP("PSORXDC",$JOB,RXREC,0)="52^"_RXREC_"^^^^"_STA_"^"_DNM_U_$GET(APSPRTS)_U_$GET(APSPCMF)
- +2 QUIT
