PSOVER2.m

PSOVER2 ;BHAM ISC/SAB - edit and/or discontinue unverified rx's ; 07/03/95 9:32

 ;;7.0;OUTPATIENT PHARMACY;**131**;DEC 1997

 ;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 ;

 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

PSOVER2   ;BHAM ISC/SAB - edit and/or discontinue unverified rx's ; 07/03/95 9:32

 +1       ;;7.0;OUTPATIENT PHARMACY;**131**;DEC 1997

 +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        DO NOOR^PSOCAN4

           IF $DATA(DIRUT)

               DO DR

               QUIT 

 +2        KILL PSD(DRG_"^"_PSONV)

           SET DA=PSONV

           IF $GET(PKI1)

               DO DCV^PSOPKIV1

               IF $DATA(PKIR)

                   GOTO KILL

               DO DR

               QUIT 

 +3        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