- APSQDRDU ;BHAM/ISC/SAB/ENM/POC - DUPLICATE DRUG AND CLASS CHECKER
- ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
- ;;6.0;OUTPATIENT PHARMACY;**4,15,58,84,135,137,144**;09/03/97
- S EN="INVEN" D ^APSQSHOW ;ADDED NEXT 4 LINES IHS/OKCAO/POC
- D EN^APSQDRDU
- K AZOSD
- Q
- EN S $P(PSONULN,"-",79)="-",DNM=""
- ;F S DNM=$O(AZOSD(DNM)) Q:DNM="" I $P(AZOSD(DNM),"^")'=$G(PSORENW("OIRXN")) D Q:$G(PSORX("DFLG"))
- F S DNM=$O(AZOSD(DNM)) Q:DNM="" D Q:$G(PSORX("DFLG"))
- .D:PSODRUG("NAME")=$P(DNM,"^")&('$P($G(PSOPAR),"^",2))&($P($G(PSOPAR),"^",16))&('$D(^XUSEC("PSORPH",DUZ))) 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(AZOSD(DNM),"^",5),1,4),PSODRUG("NAME")'=$P(DNM,"^") D CLS
- G EXIT
- DOSE ;I '$D(PSOCLOZ) G EXIT
- S DIR(0)="N^12.5:3000:1",DIR("A")="CLOZAPINE dosage (mg/day) ? " D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) G EXIT
- S PSOCD=X
- I PSOCD#25=0,PSOCD'<12.5,PSOCD<900 S PSONEW("SAND")=PSOCD_"^"_$G(PSOLR)_"^"_$G(PSOLDT) G EXIT
- I PSOCD#12.5 S DIR(0)="Y",DIR("B")="NO",DIR("A")=PSOCD_" is an unusual dose. Are you sure " D ^DIR K DIR G EXIT:$D(DTOUT),EXIT:$D(DUOUT) I X'="Y" G DOSE
- I PSOCD>900 S DIR(0)="Y",DIR("A")="Recommended maximum daily dose is 900. Are you sure " D ^DIR K DIR G EXIT:$D(DTOUT),EXIT:$D(DUOUT) I X'="Y" G DOSE
- S PSONEW("SAND")=PSOCD_"^"_$G(PSOLR)_"^"_$G(PSOLDT)
- EXIT 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
- Q
- DUP S:$P(AZOSD(DNM),"^",2)<10 DUP=1 W !,PSONULN,!,*7,"DUPLICATE DRUG "_$P(DNM,"^")_" in Prescription: ",$P(^PSRX(+AZOSD(DNM),0),"^")
- S RXREC=+AZOSD(DNM),MSG="Cancelled 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)
- 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)
- W !,$J("SIG: ",24),$P(DUPRX0,"^",10),!,$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)
- W !,PSONULN,! I $P($G(^PS(53,+$P($G(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS",'$P(PSOPAR,"^",5) W !,"PATIENT ON AUTHORIZED ABSENSE!" Q
- ASKCAN Q:$P(AZOSD(DNM),"^",2)>10
- S DIR("A")=$S($P(AZOSD(DNM),"^",2)=12:"REINSTATE",1:"CANCEL")_" RX # "_$P(^PSRX(+AZOSD(DNM),0),"^"),DIR(0)="Y",DIR("?")="Enter Y to "_$S($P(AZOSD(DNM),"^",2)=12:"reinstate",1:"cancel")_" this RX."
- D ^DIR K DIR S DA=RXREC S ACT=$S($D(SPCANC):"Reinstated during Rx cancel.",1:$S($P(AZOSD(DNM),"^",2)=12:"Reinstated",1:"Cancelled")_" while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX")
- I 'Y W *7," -Prescription was not "_$S($P(AZOSD(DNM),"^",2)=12:"reinstated",1:"cancelled")_"..." S:'$D(PSOCLC) PSOCLC=DUZ S MSG=ACT,REA=$S($P(AZOSD(DNM),"^",2)=12:"R",1:"C") S:$G(DUP) PSORX("DFLG")=1 K DUP 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(AZOSD(DNM),"^",2)=12:"R",1:"C")
- S PSCAN($P(^PSRX(DA,0),"^"))=DA_"^"_REA D CAN^PSOCAN W " RX has been "_ACT_"." S $P(AZOSD(DNM),"^",2)=$S($P(AZOSD(DNM),"^",2)=12:0,1:12)
- K DUP Q
- CLS S MSG="Cancelled During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class" W !,PSONULN
- W !?5,*7,"*** SAME CLASS *** OF DRUG FOR "_$P(DNM,"^"),!,"CLASS: "_$P(AZOSD(DNM),"^",5) S CAN=$P(AZOSD(DNM),"^",2)'<11!($P(AZOSD(DNM),"^",2)=1) S RXREC=+AZOSD(DNM) Q
- ;WE DON'T CARE ABOUT THIS FOR OUTSIDE DRUGS IHS/OKCAO/POC D:$P(PSOPAR,"^",10) DATA
- Q
- APSQDRDU ;BHAM/ISC/SAB/ENM/POC - DUPLICATE DRUG AND CLASS CHECKER
- +1 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
- +2 ;;6.0;OUTPATIENT PHARMACY;**4,15,58,84,135,137,144**;09/03/97
- +3 ;ADDED NEXT 4 LINES IHS/OKCAO/POC
- SET EN="INVEN"
- DO ^APSQSHOW
- +4 DO EN^APSQDRDU
- +5 KILL AZOSD
- +6 QUIT
- EN SET $PIECE(PSONULN,"-",79)="-"
- SET DNM=""
- +1 ;F S DNM=$O(AZOSD(DNM)) Q:DNM="" I $P(AZOSD(DNM),"^")'=$G(PSORENW("OIRXN")) D Q:$G(PSORX("DFLG"))
- +2 FOR
- SET DNM=$ORDER(AZOSD(DNM))
- IF DNM=""
- QUIT
- Begin DoDot:1
- +3 IF PSODRUG("NAME")=$PIECE(DNM,"^")&('$PIECE($GET(PSOPAR),"^",2))&($PIECE($GET(PSOPAR),"^",16))&('$DATA(^XUSEC("PSORPH",DUZ)))
- DO DUP
- IF $GET(PSORX("DFLG"))
- QUIT
- +4 IF PSODRUG("NAME")=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
- DO DUP
- IF $GET(PSORX("DFLG"))
- QUIT
- +5 IF PSODRUG("VA CLASS")]""
- IF $EXTRACT(PSODRUG("VA CLASS"),1,4)=$EXTRACT($PIECE(AZOSD(DNM),"^",5),1,4)
- IF PSODRUG("NAME")'=$PIECE(DNM,"^")
- DO CLS
- End DoDot:1
- IF $GET(PSORX("DFLG"))
- QUIT
- +6 GOTO EXIT
- DOSE ;I '$D(PSOCLOZ) G EXIT
- +1 SET DIR(0)="N^12.5:3000:1"
- SET DIR("A")="CLOZAPINE dosage (mg/day) ? "
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- GOTO EXIT
- +2 SET PSOCD=X
- +3 IF PSOCD#25=0
- IF PSOCD'<12.5
- IF PSOCD<900
- SET PSONEW("SAND")=PSOCD_"^"_$GET(PSOLR)_"^"_$GET(PSOLDT)
- GOTO EXIT
- +4 IF PSOCD#12.5
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")=PSOCD_" is an unusual dose. Are you sure "
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)
- GOTO EXIT
- IF $DATA(DUOUT)
- GOTO EXIT
- IF X'="Y"
- GOTO DOSE
- +5 IF PSOCD>900
- SET DIR(0)="Y"
- SET DIR("A")="Recommended maximum daily dose is 900. Are you sure "
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)
- GOTO EXIT
- IF $DATA(DUOUT)
- GOTO EXIT
- IF X'="Y"
- GOTO DOSE
- +6 SET PSONEW("SAND")=PSOCD_"^"_$GET(PSOLR)_"^"_$GET(PSOLDT)
- EXIT 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
- +1 QUIT
- DUP IF $PIECE(AZOSD(DNM),"^",2)<10
- SET DUP=1
- WRITE !,PSONULN,!,*7,"DUPLICATE DRUG "_$PIECE(DNM,"^")_" in Prescription: ",$PIECE(^PSRX(+AZOSD(DNM),0),"^")
- +1 SET RXREC=+AZOSD(DNM)
- SET MSG="Cancelled 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)
- +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 WRITE !,$JUSTIFY("SIG: ",24),$PIECE(DUPRX0,"^",10),!,$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")
- +3 WRITE !,$JUSTIFY("Provider: ",24),PHYS,?40,$JUSTIFY("Refills remaining: ",24),RFLS-$SELECT($DATA(^PSRX(RXREC,1,0)):$PIECE(^(0),"^",4),1:0)
- +4 SET LSTFL=+^PSRX(RXREC,3)
- WRITE !?40,$JUSTIFY("Last filled on: ",24),$EXTRACT(LSTFL,4,5),"/",$EXTRACT(LSTFL,6,7),"/",$EXTRACT(LSTFL,2,3)
- +5 WRITE !,PSONULN,!
- IF $PIECE($GET(^PS(53,+$PIECE($GET(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS"
- IF '$PIECE(PSOPAR,"^",5)
- WRITE !,"PATIENT ON AUTHORIZED ABSENSE!"
- QUIT
- ASKCAN IF $PIECE(AZOSD(DNM),"^",2)>10
- QUIT
- +1 SET DIR("A")=$SELECT($PIECE(AZOSD(DNM),"^",2)=12:"REINSTATE",1:"CANCEL")_" RX # "_$PIECE(^PSRX(+AZOSD(DNM),0),"^")
- SET DIR(0)="Y"
- SET DIR("?")="Enter Y to "_$SELECT($PIECE(AZOSD(DNM),"^",2)=12:"reinstate",1:"cancel")_" this RX."
- +2 DO ^DIR
- KILL DIR
- SET DA=RXREC
- SET ACT=$SELECT($DATA(SPCANC):"Reinstated during Rx cancel.",1:$SELECT($PIECE(AZOSD(DNM),"^",2)=12:"Reinstated",1:"Cancelled")_" while "_$SELECT('$GET(PSONV):"entering",1:"verifying")_" new RX")
- +3 IF 'Y
- WRITE *7," -Prescription was not "_$SELECT($PIECE(AZOSD(DNM),"^",2)=12:"reinstated",1:"cancelled")_"..."
- IF '$DATA(PSOCLC)
- SET PSOCLC=DUZ
- SET MSG=ACT
- SET REA=$SELECT($PIECE(AZOSD(DNM),"^",2)=12:"R",1:"C")
- IF $GET(DUP)
- SET PSORX("DFLG")=1
- KILL DUP
- QUIT
- +4 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(AZOSD(DNM),"^",2)=12:"R",1:"C")
- +5 SET PSCAN($PIECE(^PSRX(DA,0),"^"))=DA_"^"_REA
- DO CAN^PSOCAN
- WRITE " RX has been "_ACT_"."
- SET $PIECE(AZOSD(DNM),"^",2)=$SELECT($PIECE(AZOSD(DNM),"^",2)=12:0,1:12)
- +6 KILL DUP
- QUIT
- CLS SET MSG="Cancelled During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class"
- WRITE !,PSONULN
- +1 WRITE !?5,*7,"*** SAME CLASS *** OF DRUG FOR "_$PIECE(DNM,"^"),!,"CLASS: "_$PIECE(AZOSD(DNM),"^",5)
- SET CAN=$PIECE(AZOSD(DNM),"^",2)'<11!($PIECE(AZOSD(DNM),"^",2)=1)
- SET RXREC=+AZOSD(DNM)
- QUIT
- +2 ;WE DON'T CARE ABOUT THIS FOR OUTSIDE DRUGS IHS/OKCAO/POC D:$P(PSOPAR,"^",10) DATA
- +3 QUIT
