- PSODRDU1 ;BIR/SAB - dup drug class checker for pending orders ;08/23/17 19:51
- ;;7.0;OUTPATIENT PHARMACY;**4,27,32,56,63,130,132,192,441,651**;DEC 1997;Build 30
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^PS(50.606 supported by DBIA 2174
- ;External reference to ^PS(51.2 supported by DBIA 2226
- ;External reference to ^PS(50.7 supported by DBIA 2223
- ;External reference to ^SC supported by DBIA 10040
- ;External reference to ^PS(56 supported by DBIA 2229
- ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- S RXREC=$P(PSOSD(STA,DNM),"^",10)
- Q:'$D(^PS(52.41,RXREC,0))
- Q:$P($G(^PS(52.41,RXREC,0)),"^",3)="RF"
- I $G(ORD) D K FSIG Q
- .D:ORD'=RXREC&($G(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($G(PSOPAR),"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
- ..I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
- .I $D(^XUSEC("PSORPH",DUZ)) D:ORD'=RXREC&($G(PSODRUG("NAME"))=$P(DNM,"^")) DUP Q:$G(PSORX("DFLG"))
- .I $G(PSODRUG("VA CLASS"))]"",$E($G(PSODRUG("VA CLASS")),1,4)=$E($P($G(PSOSD(STA,DNM)),"^",5),1,4),$G(PSODRUG("NAME"))'=$P(DNM,"^"),ORD'=RXREC D CLS
- ;backdoor orders
- Q:'$P($G(^PS(52.41,RXREC,0)),"^",9)
- D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) I $G(PSORX("DFLG")) K FSIG Q
- .I $P($G(PSOPAR),"^",16) D DUP Q:$G(PSORX("DFLG"))
- .I $P($G(PSOPAR),"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
- .I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP Q:$G(PSORX("DFLG"))
- D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP Q:$G(PSORX("DFLG"))
- I $G(PSODRUG("VA CLASS"))]"",$E($G(PSODRUG("VA CLASS")),1,4)=$E($P($G(PSOSD(STA,DNM)),"^",5),1,4),$G(PSODRUG("NAME"))'=$P(DNM,"^") D CLS
- K FSIG Q
- DUP S DUP=1 W !,PSONULN,!,$C(7),"DUPLICATE DRUG "_$P(DNM,"^")_" in a Pending Order"
- S MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug."
- DATA S DUPRX0=^PS(52.41,RXREC,0),RFLS=$P(DUPRX0,"^",11),ISSD=$P(DUPRX0,"^",6)
- S RXRECLOD=RXREC
- W !,"Orderable Item: "_$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
- W !,"Drug: "_$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
- W !,$S($$ERXIEN^PSOERXUT(RXREC_"P"):"eRx ",1:"")_"Instructions: " S TY=2 D INST
- D FSIG^PSOUTLA("P",RXREC,IOM-6)
- W !,"SIG: " F I=0:0 S I=$O(FSIG(I)) Q:'I W FSIG(I),!?5
- W !,"Routing: "_$S($P(DUPRX0,"^",17)="W":"WINDOW",$P(DUPRX0,"^",17)="P":"PARK",1:"MAIL"),?30,"Quantity: "_$P(DUPRX0,"^",10),!,"# of Refills: "_$P(DUPRX0,"^",11) ;441 PAPI
- W ?30,"Patient Status: SC",!,"Patient Location: "_$S($P(DUPRX0,"^",13):$P($G(^SC($P(DUPRX0,"^",13),0)),"^"),1:""),!,"Med Route: "_$P($G(^PS(51.2,+$P(DUPRX0,"^",15),0)),"^"),?30,"Provider: "_$P(^VA(200,$P(DUPRX0,"^",5),0),"^")
- S Y=$P(DUPRX0,"^",6) X ^DD("DD") W !,"Issue Date: "_Y
- W !,"Provider Comments: " S TY=3 D INST
- 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 RXRECLOD Q
- ASKCAN D PSOL^PSSLOCK(RXRECLOD_"S") I '$G(PSOMSG) D K PSOMSG,DIR,DUP,RXRECLOD 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 this pending order.",!
- K PSOMSG S DIR("A")="Discontinue Pending Order",DIR(0)="Y",DIR("?")="Enter Y to Discontinue this pending order."
- D ^DIR K DIR
- I 'Y W $C(7)," -Pending Order was not discontinued..." S:$G(DUP) PSORX("DFLG")=1 K DUP,CLS D ULPN Q
- S ACT="Discontinued while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX"
- W !!,"Duplicate "_$S($G(CLS):"Class",1:"Drug")_" will be discontinued after the acceptance of the new order.",! H 2
- S ^TMP("PSORXDC",$J,RXREC,0)="P^"_RXREC_"^"_MSG
- K CLS,DUP,PSOSD(STA,DNM) Q
- CLS K DUP
- I $E($G(PSODRUG("VA CLASS")),1,2)="HA",$E($P($G(PSOSD(STA,DNM)),"^",5),1,2)="HA" K CLS,DUP,PSOELSE Q
- S MSG=" Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class." W !,PSONULN
- W !,$C(7),"*** SAME CLASS *** of drug in a Pending Order for "_$P(DNM,"^"),!,"Class: "_$G(PSODRUG("VA CLASS"))
- S CLS=1 I $P($G(PSOPAR),"^",10) D DATA Q
- E S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT
- K CLS,DUP,PSOELSE Q
- INST ;displays instruction and/or comments
- S INST=0 F S INST=$O(^PS(52.41,RXREC,TY,INST)) Q:'INST S MIG=^PS(52.41,RXREC,TY,INST,0) D
- .F SG=1:1:$L(MIG," ") W:$X+$L($P(MIG," ",SG)_" ")>IOM @$S(TY=3:"!?14",1:"!?19") W $P(MIG," ",SG)_" "
- K INST,TY,MIG,SG
- Q
- ULPN ;
- I '$G(RXRECLOD) Q
- D PSOUL^PSSLOCK(RXRECLOD_"S") K RXRECLOD
- Q
- NVA ;displays duplicate drugs and classes for non-va meds
- I $G(IT) D Q
- .S SER=$P($G(^PS(56,IT,0)),"^",4)
- .W "***"_$S(SER=1:"Critical",1:"Significant")_"*** Drug Interaction with a Non-VA Med Order.",!,"Drug: "_$P(DNM,"^")
- .K DIR,DIRUT,DTOUT,DUOUT S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DIRUT,DTOUT,DUOUT
- Q:'$D(^PS(55,PSODFN,"NVA",$P(PSOSD(STA,DNM),"^",10),0))
- S IFN=$P(PSOSD(STA,DNM),"^",10),RXREC=IFN
- I '$G(IT),$G(PSODRUG("NAME"))=$P(DNM,"^") D DSP Q
- I '$G(IT),$G(PSODRUG("VA CLASS"))]"",$E($G(PSODRUG("VA CLASS")),1,4)=$E($P($G(PSOSD(STA,DNM)),"^",5),1,4),$G(PSODRUG("NAME"))'=$P(DNM,"^") D DSP
- Q
- DSP S $P(PSONULN,"-",79)="-"
- W !,PSONULN,!,$C(7),"Duplicate Drug "_$S($G(PSODRUG("NAME"))=$P(DNM,"^"):$P(DNM,"^"),1:"Class "_$G(PSODRUG("VA CLASS")))_" in a Non-VA Med Order.",!
- S DUPRX0=^PS(55,PSODFN,"NVA",RXREC,0)
- W !,"Orderable Item: "_$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
- W !,"Drug: "_$S($P(DUPRX0,"^",2):$P(^PSDRUG($P(DUPRX0,"^",2),0),"^"),1:"No Dispense Drug Selected")
- W !,"Drug Class: "_$G(PSODRUG("VA CLASS"))
- W !,"Dosage: "_$P(DUPRX0,"^",3)
- W !,"Schedule: "_$P(DUPRX0,"^",5),?40,"Medication Route: "_$P(DUPRX0,"^",4)
- W !,"Start Date: "_$$FMTE^XLFDT($P(DUPRX0,"^",9)),?40,"CPRS Order #: "_$P(DUPRX0,"^",8)
- W !,"Documented By: "_$P(^VA(200,$P(DUPRX0,"^",11),0),"^")_" on "_$$FMTE^XLFDT($P(DUPRX0,"^",10))
- F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",IFN,"OCK",I)) Q:'I D W !
- .S ORD1=$P(^PS(55,PSODFN,"NVA",IFN,"OCK",I,0),"^"),ORP=$P(^(0),"^",2)
- .W !,"Order Check #"_I_": "
- .K OCK,LEN I $L(ORD1)>70 S (LEN,IEN)=1 D
- ..F SG=1:1:$L(ORD1) S:$L($G(OCK(IEN))_" "_$P(ORD1," ",SG))>75&($P(ORD1," ",SG)]"") IEN=IEN+1 S:$P(ORD1," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(ORD1," ",SG)
- ..F II=0:0 S II=$O(OCK(II)) Q:'II W !?5,OCK(II)
- .W:'$G(LEN) ORD1 K LEN,SG,IEN,II,OCK,ORD1
- .W !,"Overriding Provider: "_$S($G(ORP):$P(^VA(200,ORP,0),"^"),1:"")
- .K ORP,OCK,REA W !,"Reason:" F SS=0:0 S SS=$O(^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS)) Q:'SS S REA(SS)=^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS,0)
- .S IEN=1 F II=0:0 S II=$O(REA(II)) Q:'II D
- ..F SG=1:1:$L(REA(II)) S:$L($G(OCK(IEN))_" "_$P(REA(II)," ",SG))>70&($P(REA(II)," ",SG)]"") IEN=IEN+1 S:$P(REA(II)," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(REA(II)," ",SG)
- ..K REA,IEN,SG F II=0:0 S II=$O(OCK(II)) Q:'II W OCK(II) I $O(OCK(II)) W !?5
- .K OCK W !,"Statement/Explanation/Comments:" F SS=0:0 S SS=$O(^PS(55,PSODFN,"NVA",IFN,"DSC",SS)) Q:'SS S DSC(SS)=^PS(55,PSODFN,"NVA",IFN,"DSC",SS,0)
- .S IEN=1 F II=0:0 S II=$O(DSC(II)) Q:'II D
- ..F SG=1:1:$L(DSC(II)) S:$L($G(OCK(IEN))_" "_$P(DSC(II)," ",SG))>70&($P(DSC(II)," ",SG)]"") IEN=IEN+1 S:$P(DSC(II)," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(DSC(II)," ",SG)
- ..K IEN,DSC,SG F II=0:0 S II=$O(OCK(II)) Q:'II W !?5,OCK(II)
- W !,PSONULN,!
- K RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y,IEN,DSC,REA,OCK,ORD1
- K DIR,DIRUT,DTOUT,DUOUT S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,DIRUT,DTOUT,DUOUT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODRDU1 7876 printed Jan 18, 2025@03:28:29 Page 2
- PSODRDU1 ;BIR/SAB - dup drug class checker for pending orders ;08/23/17 19:51
- +1 ;;7.0;OUTPATIENT PHARMACY;**4,27,32,56,63,130,132,192,441,651**;DEC 1997;Build 30
- +2 ;External reference to ^PSDRUG supported by DBIA 221
- +3 ;External reference to ^PS(50.606 supported by DBIA 2174
- +4 ;External reference to ^PS(51.2 supported by DBIA 2226
- +5 ;External reference to ^PS(50.7 supported by DBIA 2223
- +6 ;External reference to ^SC supported by DBIA 10040
- +7 ;External reference to ^PS(56 supported by DBIA 2229
- +8 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
- +9 SET RXREC=$PIECE(PSOSD(STA,DNM),"^",10)
- +10 if '$DATA(^PS(52.41,RXREC,0))
- QUIT
- +11 if $PIECE($GET(^PS(52.41,RXREC,0)),"^",3)="RF"
- QUIT
- +12 IF $GET(ORD)
- Begin DoDot:1
- +13 if ORD'=RXREC&($GET(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($GET(PSOPAR),"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +16 IF '$PIECE(PSOPAR,"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- End DoDot:2
- if $GET(PSORX("DFLG"))
- QUIT
- +17 IF $DATA(^XUSEC("PSORPH",DUZ))
- if ORD'=RXREC&($GET(PSODRUG("NAME"))=$PIECE(DNM,"^"))
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +18 IF $GET(PSODRUG("VA CLASS"))]""
- IF $EXTRACT($GET(PSODRUG("VA CLASS")),1,4)=$EXTRACT($PIECE($GET(PSOSD(STA,DNM)),"^",5),1,4)
- IF $GET(PSODRUG("NAME"))'=$PIECE(DNM,"^")
- IF ORD'=RXREC
- DO CLS
- End DoDot:1
- KILL FSIG
- QUIT
- +19 ;backdoor orders
- +20 if '$PIECE($GET(^PS(52.41,RXREC,0)),"^",9)
- QUIT
- +21 if PSODRUG("NAME")=$PIECE(DNM,"^")&('$DATA(^XUSEC("PSORPH",DUZ)))
- Begin DoDot:1
- +22 IF $PIECE($GET(PSOPAR),"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +23 IF $PIECE($GET(PSOPAR),"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +24 IF '$PIECE(PSOPAR,"^",2)
- IF '$PIECE(PSOPAR,"^",16)
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- End DoDot:1
- IF $GET(PSORX("DFLG"))
- KILL FSIG
- QUIT
- +25 if PSODRUG("NAME")=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
- DO DUP
- if $GET(PSORX("DFLG"))
- QUIT
- +26 IF $GET(PSODRUG("VA CLASS"))]""
- IF $EXTRACT($GET(PSODRUG("VA CLASS")),1,4)=$EXTRACT($PIECE($GET(PSOSD(STA,DNM)),"^",5),1,4)
- IF $GET(PSODRUG("NAME"))'=$PIECE(DNM,"^")
- DO CLS
- +27 KILL FSIG
- QUIT
- DUP SET DUP=1
- WRITE !,PSONULN,!,$CHAR(7),"DUPLICATE DRUG "_$PIECE(DNM,"^")_" in a Pending Order"
- +1 SET MSG="Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug."
- DATA SET DUPRX0=^PS(52.41,RXREC,0)
- SET RFLS=$PIECE(DUPRX0,"^",11)
- SET ISSD=$PIECE(DUPRX0,"^",6)
- +1 SET RXRECLOD=RXREC
- +2 WRITE !,"Orderable Item: "_$PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
- +3 WRITE !,"Drug: "_$SELECT($PIECE(DUPRX0,"^",9):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
- +4 WRITE !,$SELECT($$ERXIEN^PSOERXUT(RXREC_"P"):"eRx ",1:"")_"Instructions: "
- SET TY=2
- DO INST
- +5 DO FSIG^PSOUTLA("P",RXREC,IOM-6)
- +6 WRITE !,"SIG: "
- FOR I=0:0
- SET I=$ORDER(FSIG(I))
- if 'I
- QUIT
- WRITE FSIG(I),!?5
- +7 ;441 PAPI
- WRITE !,"Routing: "_$SELECT($PIECE(DUPRX0,"^",17)="W":"WINDOW",$PIECE(DUPRX0,"^",17)="P":"PARK",1:"MAIL"),?30,"Quantity: "_$PIECE(DUPRX0,"^",10),!,"# of Refills: "_$PIECE(DUPRX0,"^",11)
- +8 WRITE ?30,"Patient Status: SC",!,"Patient Location: "_$SELECT($PIECE(DUPRX0,"^",13):$PIECE($GET(^SC($PIECE(DUPRX0,"^",13),0)),"^"),1:""),!,"Med Route: "_$PIECE(...
- ... $GET(^PS(51.2,+$PIECE(DUPRX0,"^",15),0)),"^"),?30,"Provider: "_$PIECE(^VA(200,$PIECE(DUPRX0,"^",5),0),"^")
- +9 SET Y=$PIECE(DUPRX0,"^",6)
- XECUTE ^DD("DD")
- WRITE !,"Issue Date: "_Y
- +10 WRITE !,"Provider Comments: "
- SET TY=3
- DO INST
- +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!"
- KILL RXRECLOD
- QUIT
- ASKCAN DO PSOL^PSSLOCK(RXRECLOD_"S")
- IF '$GET(PSOMSG)
- Begin DoDot:1
- +1 IF $PIECE($GET(PSOMSG),"^",2)'=""
- WRITE !!,$PIECE(PSOMSG,"^",2),!
- QUIT
- +2 WRITE !!,"Another person is editing this pending order.",!
- End DoDot:1
- KILL PSOMSG,DIR,DUP,RXRECLOD
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- SET PSORX("DFLG")=1
- QUIT
- +3 KILL PSOMSG
- SET DIR("A")="Discontinue Pending Order"
- SET DIR(0)="Y"
- SET DIR("?")="Enter Y to Discontinue this pending order."
- +4 DO ^DIR
- KILL DIR
- +5 IF 'Y
- WRITE $CHAR(7)," -Pending Order was not discontinued..."
- if $GET(DUP)
- SET PSORX("DFLG")=1
- KILL DUP,CLS
- DO ULPN
- QUIT
- +6 SET ACT="Discontinued while "_$SELECT('$GET(PSONV):"entering",1:"verifying")_" new RX"
- +7 WRITE !!,"Duplicate "_$SELECT($GET(CLS):"Class",1:"Drug")_" will be discontinued after the acceptance of the new order.",!
- HANG 2
- +8 SET ^TMP("PSORXDC",$JOB,RXREC,0)="P^"_RXREC_"^"_MSG
- +9 KILL CLS,DUP,PSOSD(STA,DNM)
- 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 CLS,DUP,PSOELSE
- QUIT
- +2 SET MSG=" Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Class."
- WRITE !,PSONULN
- +3 WRITE !,$CHAR(7),"*** SAME CLASS *** of drug in a Pending Order for "_$PIECE(DNM,"^"),!,"Class: "_$GET(PSODRUG("VA CLASS"))
- +4 SET CLS=1
- IF $PIECE($GET(PSOPAR),"^",10)
- DO DATA
- QUIT
- +5 IF '$TEST
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DTOUT,DUOUT,DIRUT
- +6 KILL CLS,DUP,PSOELSE
- QUIT
- INST ;displays instruction and/or comments
- +1 SET INST=0
- FOR
- SET INST=$ORDER(^PS(52.41,RXREC,TY,INST))
- if 'INST
- QUIT
- SET MIG=^PS(52.41,RXREC,TY,INST,0)
- Begin DoDot:1
- +2 FOR SG=1:1:$LENGTH(MIG," ")
- if $X+$LENGTH($PIECE(MIG," ",SG)_" ")>IOM
- WRITE @$SELECT(TY=3:"!?14",1:"!?19")
- WRITE $PIECE(MIG," ",SG)_" "
- End DoDot:1
- +3 KILL INST,TY,MIG,SG
- +4 QUIT
- ULPN ;
- +1 IF '$GET(RXRECLOD)
- QUIT
- +2 DO PSOUL^PSSLOCK(RXRECLOD_"S")
- KILL RXRECLOD
- +3 QUIT
- NVA ;displays duplicate drugs and classes for non-va meds
- +1 IF $GET(IT)
- Begin DoDot:1
- +2 SET SER=$PIECE($GET(^PS(56,IT,0)),"^",4)
- +3 WRITE "***"_$SELECT(SER=1:"Critical",1:"Significant")_"*** Drug Interaction with a Non-VA Med Order.",!,"Drug: "_$PIECE(DNM,"^")
- +4 KILL DIR,DIRUT,DTOUT,DUOUT
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DIRUT,DTOUT,DUOUT
- End DoDot:1
- QUIT
- +5 if '$DATA(^PS(55,PSODFN,"NVA",$PIECE(PSOSD(STA,DNM),"^",10),0))
- QUIT
- +6 SET IFN=$PIECE(PSOSD(STA,DNM),"^",10)
- SET RXREC=IFN
- +7 IF '$GET(IT)
- IF $GET(PSODRUG("NAME"))=$PIECE(DNM,"^")
- DO DSP
- QUIT
- +8 IF '$GET(IT)
- IF $GET(PSODRUG("VA CLASS"))]""
- IF $EXTRACT($GET(PSODRUG("VA CLASS")),1,4)=$EXTRACT($PIECE($GET(PSOSD(STA,DNM)),"^",5),1,4)
- IF $GET(PSODRUG("NAME"))'=$PIECE(DNM,"^")
- DO DSP
- +9 QUIT
- DSP SET $PIECE(PSONULN,"-",79)="-"
- +1 WRITE !,PSONULN,!,$CHAR(7),"Duplicate Drug "_$SELECT($GET(PSODRUG("NAME"))=$PIECE(DNM,"^"):$PIECE(DNM,"^"),1:"Class "_$GET(PSODRUG("VA CLASS")))_" in a Non-VA Med Order.",!
- +2 SET DUPRX0=^PS(55,PSODFN,"NVA",RXREC,0)
- +3 WRITE !,"Orderable Item: "_$PIECE(^PS(50.7,$PIECE(DUPRX0,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
- +4 WRITE !,"Drug: "_$SELECT($PIECE(DUPRX0,"^",2):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",2),0),"^"),1:"No Dispense Drug Selected")
- +5 WRITE !,"Drug Class: "_$GET(PSODRUG("VA CLASS"))
- +6 WRITE !,"Dosage: "_$PIECE(DUPRX0,"^",3)
- +7 WRITE !,"Schedule: "_$PIECE(DUPRX0,"^",5),?40,"Medication Route: "_$PIECE(DUPRX0,"^",4)
- +8 WRITE !,"Start Date: "_$$FMTE^XLFDT($PIECE(DUPRX0,"^",9)),?40,"CPRS Order #: "_$PIECE(DUPRX0,"^",8)
- +9 WRITE !,"Documented By: "_$PIECE(^VA(200,$PIECE(DUPRX0,"^",11),0),"^")_" on "_$$FMTE^XLFDT($PIECE(DUPRX0,"^",10))
- +10 FOR I=0:0
- SET I=$ORDER(^PS(55,PSODFN,"NVA",IFN,"OCK",I))
- if 'I
- QUIT
- Begin DoDot:1
- +11 SET ORD1=$PIECE(^PS(55,PSODFN,"NVA",IFN,"OCK",I,0),"^")
- SET ORP=$PIECE(^(0),"^",2)
- +12 WRITE !,"Order Check #"_I_": "
- +13 KILL OCK,LEN
- IF $LENGTH(ORD1)>70
- SET (LEN,IEN)=1
- Begin DoDot:2
- +14 FOR SG=1:1:$LENGTH(ORD1)
- if $LENGTH($GET(OCK(IEN))_" "_$PIECE(ORD1," ",SG))>75&($PIECE(ORD1," ",SG)]"")
- SET IEN=IEN+1
- if $PIECE(ORD1," ",SG)'=""
- SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(ORD1," ",SG)
- +15 FOR II=0:0
- SET II=$ORDER(OCK(II))
- if 'II
- QUIT
- WRITE !?5,OCK(II)
- End DoDot:2
- +16 if '$GET(LEN)
- WRITE ORD1
- KILL LEN,SG,IEN,II,OCK,ORD1
- +17 WRITE !,"Overriding Provider: "_$SELECT($GET(ORP):$PIECE(^VA(200,ORP,0),"^"),1:"")
- +18 KILL ORP,OCK,REA
- WRITE !,"Reason:"
- FOR SS=0:0
- SET SS=$ORDER(^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS))
- if 'SS
- QUIT
- SET REA(SS)=^PS(55,PSODFN,"NVA",IFN,"OCK",I,"OVR",SS,0)
- +19 SET IEN=1
- FOR II=0:0
- SET II=$ORDER(REA(II))
- if 'II
- QUIT
- Begin DoDot:2
- +20 FOR SG=1:1:$LENGTH(REA(II))
- if $LENGTH($GET(OCK(IEN))_" "_$PIECE(REA(II)," ",SG))>70&($PIECE(REA(II)," ",SG)]"")
- SET IEN=IEN+1
- if $PIECE(REA(II)," ",SG)'=""
- SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(REA(II)," ",SG)
- +21 KILL REA,IEN,SG
- FOR II=0:0
- SET II=$ORDER(OCK(II))
- if 'II
- QUIT
- WRITE OCK(II)
- IF $ORDER(OCK(II))
- WRITE !?5
- End DoDot:2
- +22 KILL OCK
- WRITE !,"Statement/Explanation/Comments:"
- FOR SS=0:0
- SET SS=$ORDER(^PS(55,PSODFN,"NVA",IFN,"DSC",SS))
- if 'SS
- QUIT
- SET DSC(SS)=^PS(55,PSODFN,"NVA",IFN,"DSC",SS,0)
- +23 SET IEN=1
- FOR II=0:0
- SET II=$ORDER(DSC(II))
- if 'II
- QUIT
- Begin DoDot:2
- +24 FOR SG=1:1:$LENGTH(DSC(II))
- if $LENGTH($GET(OCK(IEN))_" "_$PIECE(DSC(II)," ",SG))>70&($PIECE(DSC(II)," ",SG)]"")
- SET IEN=IEN+1
- if $PIECE(DSC(II)," ",SG)'=""
- SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(DSC(II)," ",SG)
- +25 KILL IEN,DSC,SG
- FOR II=0:0
- SET II=$ORDER(OCK(II))
- if 'II
- QUIT
- WRITE !?5,OCK(II)
- End DoDot:2
- End DoDot:1
- WRITE !
- +26 WRITE !,PSONULN,!
- +27 KILL RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y,IEN,DSC,REA,OCK,ORD1
- +28 KILL DIR,DIRUT,DTOUT,DUOUT
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,DIRUT,DTOUT,DUOUT
- +29 QUIT