- PSOVER2 ;BHAM ISC/SAB - edit and/or discontinue unverified rx's ;07/03/95 9:32
- ;;7.0;OUTPATIENT PHARMACY;**131,251**;DEC 1997;Build 202
- ;Reference ^PSDRUG( supported by DBIA 221
- S DIR("B")="C",DIR("A")="Do you want to DELETE or EDIT Rx # "_$P(^PSRX(PSONV,0),"^")_" or Discontinue "_$P(DUPRX0,"^")_" ",DIR("?",1)="This is a duplicate drug. Your options are to :"
- S DIR("?",2)=" (1) - Discontinue the old Rx ("_$P(DUPRX0,"^")_")",DIR("?",3)=" (2) - DELETE this Rx ("_$P(^PSRX(PSONV,0),"^")_")"
- S DIR("?",4)="or (3) - EDIT this Rx ("_$P(^PSRX(PSONV,0),"^")_")",DIR("?")="You MUST select one of the 3 actions!"
- S DIR(0)="SA^1:DISCONTINUE;2:DELETE;3:EDIT" D ^DIR K DIR G CANOLD^PSOVERC:Y=1,DELETE:Y=2,CHANGE:Y=3,QUIT^PSOVER1:"123"'[$E(Y)
- CHANGE S DA=PSONV,PSDOLD=DRGG,GOOF=0,(PSRX1,PSRX2)=$P(^PSRX(PSONV,0),"^",6)
- S DIE="^PSRX(",DR="@1;3;S PSRX1=$P(D,""^"",6);6;S PSRX2=X D:PSRX1=PSRX2 MUST^PSOVER2 D:PSRX1'=PSRX2 NO^PSOVER2;10;7;8;9;4;5;12;1;22;11;"_$S($P(PSOPAR,"^",12):"35;",1:"")_$S($P(PSOPAR,"^",15):"10.6",1:"")_";@2" D ^DIE
- I GOOF=1 S DR="6////"_PSRX1 D ^DIE G PSOVER2
- I GOOF=2 G PSOVER2
- K DIE,DR,DEA1,DEA2,PSRX1,PSRX2,GOOF G REDO^PSOVER1
- ;
- NO ;called by `dr strings' at change+1^psover2 and at change^psover1
- I $P($G(^PSDRUG(PSRX1,2)),"^")'=$P($G(^PSDRUG(PSRX2,2)),"^") D G OITEM
- .W !!,"You MUST select a drug with the same Orderable Item!",! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
- S DEA1=$P(^PSDRUG(PSRX1,0),"^",3)["A",DEA2=$P(^PSDRUG(PSRX2,0),"^",3)["A"
- I DEA1&DEA2!('DEA1&'DEA2) Q
- W !,$C(7),?12,"You CANNOT change a "_$S(DEA1:"",1:"NON-")_"Narcotic Drug to a "_$S(DEA2:"",1:"Non-"),"Narcotic Drug",!?13,"You must discontinue this prescription and enter a new one",!
- W ?5,"Use the DELETE option rather than the EDIT option on this prescription",!!,$C(7) K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
- OITEM S Y="@2",GOOF=1 Q
- ;
- MUST ;called by `dr string' at change+1^psover2
- W !!!,$C(7),"This is a duplicate drug for an existing prescription",!!,"You MUST either CHANGE the drug in this prescription",!,?16,"DELETE this prescription",!,?13,"or DISCONTINUE the existing prescription",!!,$C(7) S Y="@2",GOOF=2 Q
- ;
- DELETE ;
- I '$G(DRG) S DRG=$P(^PSRX(PSONV,0),"^",6)
- D NOOR^PSOCAN4 I $D(DIRUT) D DR Q
- K PSD(DRG_"^"_PSONV) S DA=PSONV I $G(PKI1) D DCV^PSOPKIV1 G:$D(PKIR) KILL D DR Q
- D ENQ^PSORXDL
- KILL S DA=PSONV,DIK="^PS(52.4," D ^DIK K DA,DIK
- K Z,Z1,Z2,PSOKL,PSOKL1,PSOKL2,PSOKL3,PSOKL6,PSOKL7,PSONOOR,DA
- Q
- DR W $C(7)," ACTION NOT TAKEN!",!
- K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
- S UPFLAGX=1 Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOVER2 2649 printed Jan 18, 2025@03:37:29 Page 2
- PSOVER2 ;BHAM ISC/SAB - edit and/or discontinue unverified rx's ;07/03/95 9:32
- +1 ;;7.0;OUTPATIENT PHARMACY;**131,251**;DEC 1997;Build 202
- +2 ;Reference ^PSDRUG( supported by DBIA 221
- +3 SET DIR("B")="C"
- SET DIR("A")="Do you want to DELETE or EDIT Rx # "_$PIECE(^PSRX(PSONV,0),"^")_" or Discontinue "_$PIECE(DUPRX0,"^")_" "
- SET DIR("?",1)="This is a duplicate drug. Your options are to :"
- +4 SET DIR("?",2)=" (1) - Discontinue the old Rx ("_$PIECE(DUPRX0,"^")_")"
- SET DIR("?",3)=" (2) - DELETE this Rx ("_$PIECE(^PSRX(PSONV,0),"^")_")"
- +5 SET DIR("?",4)="or (3) - EDIT this Rx ("_$PIECE(^PSRX(PSONV,0),"^")_")"
- SET DIR("?")="You MUST select one of the 3 actions!"
- +6 SET DIR(0)="SA^1:DISCONTINUE;2:DELETE;3:EDIT"
- DO ^DIR
- KILL DIR
- if Y=1
- GOTO CANOLD^PSOVERC
- if Y=2
- GOTO DELETE
- if Y=3
- GOTO CHANGE
- if "123"'[$EXTRACT(Y)
- GOTO QUIT^PSOVER1
- CHANGE SET DA=PSONV
- SET PSDOLD=DRGG
- SET GOOF=0
- SET (PSRX1,PSRX2)=$PIECE(^PSRX(PSONV,0),"^",6)
- +1 SET DIE="^PSRX("
- SET DR="@1;3;S PSRX1=$P(D,""^"",6);6;S PSRX2=X D:PSRX1=PSRX2 MUST^PSOVER2 D:PSRX1'=PSRX2 NO^PSOVER2;10;7;8;9;4;5;12;1;22;11;"_$SELECT($PIECE(PSOPAR,"^",12):"35;",1:"")_$SELECT($PIECE(PSOPAR,"^",15):"10.6",1:"")_";@2"
- DO ^DIE
- +2 IF GOOF=1
- SET DR="6////"_PSRX1
- DO ^DIE
- GOTO PSOVER2
- +3 IF GOOF=2
- GOTO PSOVER2
- +4 KILL DIE,DR,DEA1,DEA2,PSRX1,PSRX2,GOOF
- GOTO REDO^PSOVER1
- +5 ;
- NO ;called by `dr strings' at change+1^psover2 and at change^psover1
- +1 IF $PIECE($GET(^PSDRUG(PSRX1,2)),"^")'=$PIECE($GET(^PSDRUG(PSRX2,2)),"^")
- Begin DoDot:1
- +2 WRITE !!,"You MUST select a drug with the same Orderable Item!",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- GOTO OITEM
- +3 SET DEA1=$PIECE(^PSDRUG(PSRX1,0),"^",3)["A"
- SET DEA2=$PIECE(^PSDRUG(PSRX2,0),"^",3)["A"
- +4 IF DEA1&DEA2!('DEA1&'DEA2)
- QUIT
- +5 WRITE !,$CHAR(7),?12,"You CANNOT change a "_$SELECT(DEA1:"",1:"NON-")_"Narcotic Drug to a "_$SELECT(DEA2:"",1:"Non-"),"Narcotic Drug",!?13,"You must discontinue this prescription and enter a new one",!
- +6 WRITE ?5,"Use the DELETE option rather than the EDIT option on this prescription",!!,$CHAR(7)
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- KILL DIR
- OITEM SET Y="@2"
- SET GOOF=1
- QUIT
- +1 ;
- MUST ;called by `dr string' at change+1^psover2
- +1 WRITE !!!,$CHAR(7),"This is a duplicate drug for an existing prescription",!!,"You MUST either CHANGE the drug in this prescription",!,?16,"DELETE this prescription",!,?13,"or DISCONTINUE the existing prescription",!!,$CHAR(7)
- SET Y="@2"
- SET GOOF=2
- QUIT
- +2 ;
- DELETE ;
- +1 IF '$GET(DRG)
- SET DRG=$PIECE(^PSRX(PSONV,0),"^",6)
- +2 DO NOOR^PSOCAN4
- IF $DATA(DIRUT)
- DO DR
- QUIT
- +3 KILL PSD(DRG_"^"_PSONV)
- SET DA=PSONV
- IF $GET(PKI1)
- DO DCV^PSOPKIV1
- if $DATA(PKIR)
- GOTO KILL
- DO DR
- QUIT
- +4 DO ENQ^PSORXDL
- KILL SET DA=PSONV
- SET DIK="^PS(52.4,"
- DO ^DIK
- KILL DA,DIK
- +1 KILL Z,Z1,Z2,PSOKL,PSOKL1,PSOKL2,PSOKL3,PSOKL6,PSOKL7,PSONOOR,DA
- +2 QUIT
- DR WRITE $CHAR(7)," ACTION NOT TAKEN!",!
- +1 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR
- +2 SET UPFLAGX=1
- QUIT
- +3 ;