- PSOCPDUP ;BIR/SAB - Dup drug and class checker for copy orders ;1/3/05 11:34am
- ;;7.0;OUTPATIENT PHARMACY;**11,27,32,130,132,192,207,222,243,305,313**;DEC 1997;Build 76
- ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- ;External references to ^ORRDI1 supported by DBIA 4659
- ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- S $P(PSONULN,"-",79)="-",(STA,DNM)=""
- F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" D Q:$G(PSORX("DFLG"))
- .I STA="PENDING" D ^PSODRDU1 Q
- .I STA="ZNONVA" D NVA^PSODRDU1 Q
- .D: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: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),PSODRUG("NAME")'=$P(DNM,"^") S PSOCPCLS=1 D CLS K PSOCPCLS
- K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI")
- D REMOTE
- EXIT D ^PSOBUILD K CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
- Q
- DUP ; Duplicate Drug Check
- 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),"^"),$$TITRX^PSOUTL(+PSOSD(STA,DNM))
- S RXREC=+PSOSD(STA,DNM),MSG="Discontinued During Prescription Entry COPY - Duplicate Drug"
- DATA S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),SIG=$P($G(^PSRX(RXREC,"SIG")),"^"),$P(RX0,"^",15)=+$G(^PSRX(RXREC,"STA"))
- 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)
- D PRSTAT^PSODRDUP(RXREC)
- 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!" Q
- ASKCAN I $P(PSOSD(STA,DNM),"^",2)>10,$P(PSOSD(STA,DNM),"^",2)'=16 Q
- I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)),'$G(CLS) S PSORX("DFLG")=1 K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR Q
- I $P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)),'$G(CLS) S PSORX("DFLG")=1 K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR Q
- I $P(PSOSD(STA,DNM),"^",2)=16,$G(DUP) W !!,"Prescription "_$S(+$G(PSOSD(STA,DNM)):$P($G(^PSRX(+$G(PSOSD(STA,DNM)),0)),"^")_" ",1:"")_"is on Provider Hold, it cannot be discontinued.",! D Q
- .S PSORX("DFLG")=1 K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DUP
- I $G(PSOCPCLS),$G(RXRECCOP) D PSOL^PSSLOCK(RXRECCOP) I '$G(PSOMSG) D K PSOMSG,DIR S DIR(0)="E",DIR("A")="Press Return to Continue" 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(RXRECCOP,0)),"^")
- K PSOMSG S DIR("A")="Discontinue Rx # "_$P(^PSRX(+PSOSD(STA,DNM),0),"^"),DIR(0)="Y",DIR("?")="Enter Y to discontinue this Rx."
- D ^DIR K DIR S DA=RXREC S ACT="Discontinued while entering new Rx"
- I 'Y W $C(7)," -Prescription was not discontinued..." S:'$D(PSOCLC) PSOCLC=DUZ S MSG=ACT,REA="C" S:$G(DUP) PSORX("DFLG")=1 K DUP,CLS D Q
- .I $D(^TMP("PSORXDC",$J,RXREC,0)) K ^TMP("PSORXDC",$J,RXREC,0)
- .D:$G(PSOCPCLS) ULRX
- 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 Entry - DUPLICATE RX"),REA="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 CLS,DUP,PSOCPCLS Q
- ;
- CLS ; - Duplicate Drug Class Check
- K DUP S CLS=1,MSG="Discontinued During New Prescription Entry - 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,RXRECCOP)=+PSOSD(STA,DNM) S PSOELSE=$P(PSOPAR,"^",10) I PSOELSE D DATA
- I 'PSOELSE S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT
- K PSOELSE,RXRECCOP Q
- ULRX ;
- I '$G(RXRECCOP) Q
- D PSOUL^PSSLOCK(RXRECCOP)
- Q
- ;
- REMOTE ;
- Q:$G(PSORX("DFLG"))
- I $T(HAVEHDR^ORRDI1)']"" Q
- I '$$HAVEHDR^ORRDI1 Q
- I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2
- W:$D(IOF) @IOF W !,"Now doing remote order checks. Please wait..."
- D REMOTE^PSOORRDI(PSODFN,PSODRUG("IEN"))
- I $D(^TMP($J,"DD")) D DUP^PSOORRD2
- I $D(^TMP($J,"DC")) D CLS^PSOORRD2
- REMOTE2 ;
- K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCPDUP 5798 printed Jan 18, 2025@03:27:01 Page 2
- PSOCPDUP ;BIR/SAB - Dup drug and class checker for copy orders ;1/3/05 11:34am
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,27,32,130,132,192,207,222,243,305,313**;DEC 1997;Build 76
- +2 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- +3 ;External references to ^ORRDI1 supported by DBIA 4659
- +4 ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- +5 SET $PIECE(PSONULN,"-",79)="-"
- SET (STA,DNM)=""
- +6 FOR
- SET STA=$ORDER(PSOSD(STA))
- if STA=""
- QUIT
- FOR
- SET DNM=$ORDER(PSOSD(STA,DNM))
- if DNM=""
- QUIT
- Begin DoDot:1
- +7 IF STA="PENDING"
- DO ^PSODRDU1
- QUIT
- +8 IF STA="ZNONVA"
- DO NVA^PSODRDU1
- QUIT
- +9 if PSODRUG("NAME")=$PIECE(DNM,"^")&('$DATA(^XUSEC("PSORPH",DUZ)))
- Begin DoDot:2
- +10 IF $PIECE($GET(PSOPAR),"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +11 IF $PIECE(PSOPAR,"^",2)
- IF '$PIECE($GET(PSOPAR),"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +12 IF '$PIECE(PSOPAR,"^",2)
- IF '$PIECE($GET(PSOPAR),"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- End DoDot:2
- if $GET(PSORX("DFLG"))
- QUIT
- +13 if PSODRUG("NAME")=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +14 IF PSODRUG("VA CLASS")]""
- IF $EXTRACT(PSODRUG("VA CLASS"),1,4)=$EXTRACT($PIECE(PSOSD(STA,DNM),"^",5),1,4)
- IF PSODRUG("NAME")'=$PIECE(DNM,"^")
- SET PSOCPCLS=1
- DO CLS
- KILL PSOCPCLS
- End DoDot:1
- if $GET(PSORX("DFLG"))
- QUIT
- +15 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI")
- +16 DO REMOTE
- EXIT DO ^PSOBUILD
- KILL CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
- +1 QUIT
- DUP ; Duplicate Drug Check
- +1 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),"^"),$$TITRX^PSOUTL(+PSOSD(STA,DNM))
- +2 SET RXREC=+PSOSD(STA,DNM)
- SET MSG="Discontinued During Prescription Entry COPY - 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 SIG=$PIECE($GET(^PSRX(RXREC,"SIG")),"^")
- SET $PIECE(RX0,"^",15)=+$GET(^PSRX(RXREC,"STA"))
- +1 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)
- +2 DO PRSTAT^PSODRDUP(RXREC)
- +3 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)
- +4 KILL FSIG,PSREV
- IF '$PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
- DO EN2^PSOUTLA1(RXREC,54)
- +5 WRITE !,$JUSTIFY("SIG: ",24)
- WRITE $GET(BSIG(1))
- +6 IF $ORDER(BSIG(1))
- FOR PSREV=1:0
- SET PSREV=$ORDER(BSIG(PSREV))
- if 'PSREV
- QUIT
- WRITE !?24,$GET(BSIG(PSREV))
- +7 KILL BSIG,PSREV
- +8 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")
- +9 WRITE !,$JUSTIFY("Provider: ",24)_PHYS,?40,$JUSTIFY("Refills remaining: ",24),RFLS-$SELECT($DATA(^PSRX(RXREC,1,0)):$PIECE(^(0),"^",4),1:0)
- +10 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)
- +11 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!"
- QUIT
- ASKCAN IF $PIECE(PSOSD(STA,DNM),"^",2)>10
- IF $PIECE(PSOSD(STA,DNM),"^",2)'=16
- QUIT
- +1 IF '$PIECE(PSOPAR,"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF '$GET(CLS)
- SET PSORX("DFLG")=1
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR
- QUIT
- +2 IF $PIECE(PSOPAR,"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- IF '$DATA(^XUSEC("PSORPH",DUZ))
- IF '$GET(CLS)
- SET PSORX("DFLG")=1
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR
- QUIT
- +3 IF $PIECE(PSOSD(STA,DNM),"^",2)=16
- IF $GET(DUP)
- WRITE !!,"Prescription "_$SELECT(+$GET(PSOSD(STA,DNM)):$PIECE($GET(^PSRX(+$GET(PSOSD(STA,DNM)),0)),"^")_" ",1:"")_"is on Provider Hold, it cannot be discontinued.",!
- Begin DoDot:1
- +4 SET PSORX("DFLG")=1
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DUP
- End DoDot:1
- QUIT
- +5 IF $GET(PSOCPCLS)
- IF $GET(RXRECCOP)
- DO PSOL^PSSLOCK(RXRECCOP)
- IF '$GET(PSOMSG)
- Begin DoDot:1
- +6 IF $PIECE($GET(PSOMSG),"^",2)'=""
- WRITE !!,$PIECE(PSOMSG,"^",2)
- QUIT
- +7 WRITE !!,"Another person is editing Rx "_$PIECE($GET(^PSRX(RXRECCOP,0)),"^")
- End DoDot:1
- KILL PSOMSG,DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR
- SET PSORX("DFLG")=1
- QUIT
- +8 KILL PSOMSG
- SET DIR("A")="Discontinue Rx # "_$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")
- SET DIR(0)="Y"
- SET DIR("?")="Enter Y to discontinue this Rx."
- +9 DO ^DIR
- KILL DIR
- SET DA=RXREC
- SET ACT="Discontinued while entering new Rx"
- +10 IF 'Y
- WRITE $CHAR(7)," -Prescription was not discontinued..."
- if '$DATA(PSOCLC)
- SET PSOCLC=DUZ
- SET MSG=ACT
- SET REA="C"
- if $GET(DUP)
- SET PSORX("DFLG")=1
- KILL DUP,CLS
- Begin DoDot:1
- +11 IF $DATA(^TMP("PSORXDC",$JOB,RXREC,0))
- KILL ^TMP("PSORXDC",$JOB,RXREC,0)
- +12 if $GET(PSOCPCLS)
- DO ULRX
- End DoDot:1
- QUIT
- +13 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
- +14 SET PSOCLC=DUZ
- SET MSG=$SELECT($GET(MSG)]"":MSG,1:ACT_" During New Rx Entry - DUPLICATE RX")
- SET REA="C"
- +15 WRITE !!,"Duplicate "_$SELECT($GET(CLS):"Class",1:"Drug")_" will be discontinued after the acceptance of the new order.",!
- +16 SET ^TMP("PSORXDC",$JOB,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_STA_"^"_DNM
- SET PSONOOR="D"
- +17 KILL CLS,DUP,PSOCPCLS
- QUIT
- +18 ;
- CLS ; - Duplicate Drug Class Check
- +1 KILL DUP
- SET CLS=1
- SET MSG="Discontinued During New Prescription Entry - Duplicate Class"
- WRITE !,PSONULN
- +2 WRITE !?5,$CHAR(7),"*** SAME CLASS *** OF DRUG IN RX #"_$PIECE(^PSRX(+PSOSD(STA,DNM),0),"^")_" FOR "_$PIECE(DNM,"^"),!,"CLASS: "_PSODRUG("VA CLASS")
- +3 SET CAN=$PIECE(PSOSD(STA,DNM),"^",2)'<11!($PIECE(PSOSD(STA,DNM),"^",2)=1)
- SET (RXREC,RXRECCOP)=+PSOSD(STA,DNM)
- SET PSOELSE=$PIECE(PSOPAR,"^",10)
- IF PSOELSE
- DO DATA
- +4 IF 'PSOELSE
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DTOUT,DUOUT,DIRUT
- +5 KILL PSOELSE,RXRECCOP
- QUIT
- ULRX ;
- +1 IF '$GET(RXRECCOP)
- QUIT
- +2 DO PSOUL^PSSLOCK(RXRECCOP)
- +3 QUIT
- +4 ;
- REMOTE ;
- +1 if $GET(PSORX("DFLG"))
- QUIT
- +2 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +3 IF '$$HAVEHDR^ORRDI1
- QUIT
- +4 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
- GOTO REMOTE2
- +5 if $DATA(IOF)
- WRITE @IOF
- WRITE !,"Now doing remote order checks. Please wait..."
- +6 DO REMOTE^PSOORRDI(PSODFN,PSODRUG("IEN"))
- +7 IF $DATA(^TMP($JOB,"DD"))
- DO DUP^PSOORRD2
- +8 IF $DATA(^TMP($JOB,"DC"))
- DO CLS^PSOORRD2
- REMOTE2 ;
- +1 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI")
- +2 QUIT