PSXEDRG.m

PSXEDRG ;BIR/BAB-Drug Enter/Edit for HOST ; 30 Oct 95 / 3:16 PM [ 04/08/97   2:06 PM ]

 ;;2.0;CMOP;;11 Apr 97

 S PSXJ=1

 W ! S DIC="^PSDRUG(",DIC(0)="QEALMO",DLAYGO=50 D ^DIC G END:Y<0!($D(DTOUT))!($D(DUOUT)) S DA=+Y

 L +^PSDRUG(DA):1 I '$T W !!,"Drug is being edited by another process, try again later...",!! G PSXEDRG

 S PSIUX="O^Outpatient Pharmacy" D PSIU I PSIUA["^" G PSXEDRG

 S DR=$S('$G(^PSDRUG(+Y,"I"))!(+$G(^("I"))>DT):"[PSX DRUG]",1:"D CHECK^PSXEDRG;100///@;W !,""Drug is now re-activated"" S Y=""@2"";@1;W !!,""No change"";@2") S DA=+Y,DIE=DIC D ^DIE L -^PSDRUG(DA) K DA G PSXEDRG

CHECK N DP,DQ S DIR("A")="THIS DRUG IS INACTIVE - DO YOU WISH TO REACTIVATE IT",DIR("B")="N",DIR(0)="Y" D ^DIR K DIR I "^N"[X S Y="@1" Q

 S Y=100

 Q

 ;

PSIU ;

 Q:$S('$D(DA):1,'$D(PSIUX):1,PSIUX'?1E1"^"1.E:1,1:'$D(^PSDRUG(DA,0)))  S PSIUO=$S($D(^(2)):$P(^(2),"^",3),1:"") S PSIUT=$P(PSIUX,"^",2),PSIUT=$E("N","AEIOU"[$E(PSIUT))_" "_PSIUT,(%,PSIUQ)=PSIUO'[$E(PSIUX)+1

 F PSIU=0:0 W !!,"DO YOU WANT TO MARK THIS DRUG AS A"_PSIUT_" ITEM" D YN^DICN Q:%  D MQ S %=PSIUQ

 I %<0 S PSIUA="^" G DONE

 S PSIUA=$E("YN",%) G:%=PSIUQ DONE I %=1 S PSIUY=PSIUO_$P(PSIUX,"^"),$P(^PSDRUG(DA,2),"^",3)=PSIUY I $P(^(0),"^")]"" S ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),DA)=""

 I %=2 S PSIUY=$P(PSIUO,$P(PSIUX,"^"))_$P(PSIUO,$P(PSIUX,"^"),2),$P(^PSDRUG(DA,2),"^",3)=PSIUY I $P(^(0),"^")]"" K ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),DA)

 K:PSIUO]"" ^PSDRUG("IU",PSIUO,DA) S:PSIUY]"" ^PSDRUG("IU",PSIUY,DA)=""

 W ! Q

DONE ;

 K PSIU,PSIUQ,PSIUT,PSIUY Q

 ;

MQ ;

 W !!,"  Enter `Y' to mark this drug as a"_$S($E(PSIUT)="N":"n"_$E(PSIUT,2,99),1:PSIUT)_" item.",!,"  or `N' to unmark as a"_$S($E(PSIUT)="N":"n"_$E(PSIUT,2,99),1:PSIUT)_" item." Q

 ;

END K X,Y,DIR,DR,DIC,DIE,PSIUA,PSIUX,%,D0,D1,DA,DQ,I,Z,DTOUT,DUOUT,DIRUT,DIROUT,PSXJ Q

PSXEDRG   ;BIR/BAB-Drug Enter/Edit for HOST ; 30 Oct 95 / 3:16 PM [ 04/08/97   2:06 PM ]

 +1       ;;2.0;CMOP;;11 Apr 97

 +2        SET PSXJ=1

 +3        WRITE !

           SET DIC="^PSDRUG("

           SET DIC(0)="QEALMO"

           SET DLAYGO=50

           DO ^DIC

           IF Y<0!($DATA(DTOUT))!($DATA(DUOUT))

               GOTO END

           SET DA=+Y

 +4        LOCK +^PSDRUG(DA):1

           IF '$TEST

               WRITE !!,"Drug is being edited by another process, try again later...",!!

               GOTO PSXEDRG

 +5        SET PSIUX="O^Outpatient Pharmacy"

           DO PSIU

           IF PSIUA["^"

               GOTO PSXEDRG

 +6        SET DR=$SELECT('$GET(^PSDRUG(+Y,"I"))!(+$GET(^("I"))>DT):"[PSX DRUG]",1:"D CHECK^PSXEDRG;100///@;W !,""Drug is now re-activated"" S Y=""@2"";@1;W !!,""No change"";@2")

           SET DA=+Y

           SET DIE=DIC

           DO ^DIE

           LOCK -^PSDRUG(DA)

           KILL DA

           GOTO PSXEDRG

CHECK      NEW DP,DQ

           SET DIR("A")="THIS DRUG IS INACTIVE - DO YOU WISH TO REACTIVATE IT"

           SET DIR("B")="N"

           SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           IF "^N"[X

               SET Y="@1"

               QUIT 

 +1        SET Y=100

 +2        QUIT 

 +3       ;

PSIU      ;

 +1        IF $SELECT('$DATA(DA)

               QUIT 

           SET PSIUO=$SELECT($DATA(^(2)):$PIECE(^(2),"^",3),1:"")

           SET PSIUT=$PIECE(PSIUX,"^",2)

           SET PSIUT=$EXTRACT("N","AEIOU"[$EXTRACT(PSIUT))_" "_PSIUT

           SET (%,PSIUQ)=PSIUO'[$EXTRACT(PSIUX)+1

 +2        FOR PSIU=0:0

               WRITE !!,"DO YOU WANT TO MARK THIS DRUG AS A"_PSIUT_" ITEM"

               DO YN^DICN

               IF %

                   QUIT 

               DO MQ

               SET %=PSIUQ

 +3        IF %<0

               SET PSIUA="^"

               GOTO DONE

 +4        SET PSIUA=$EXTRACT("YN",%)

           IF %=PSIUQ

               GOTO DONE

           IF %=1

               SET PSIUY=PSIUO_$PIECE(PSIUX,"^")

               SET $PIECE(^PSDRUG(DA,2),"^",3)=PSIUY

               IF $PIECE(^(0),"^")]""

                   SET ^PSDRUG("AIU"_$PIECE(PSIUX,"^"),$PIECE(^(0),"^"),DA)=""

 +5        IF %=2

               SET PSIUY=$PIECE(PSIUO,$PIECE(PSIUX,"^"))_$PIECE(PSIUO,$PIECE(PSIUX,"^"),2)

               SET $PIECE(^PSDRUG(DA,2),"^",3)=PSIUY

               IF $PIECE(^(0),"^")]""

                   KILL ^PSDRUG("AIU"_$PIECE(PSIUX,"^"),$PIECE(^(0),"^"),DA)

 +6        IF PSIUO]""

               KILL ^PSDRUG("IU",PSIUO,DA)

           IF PSIUY]""

               SET ^PSDRUG("IU",PSIUY,DA)=""

 +7        WRITE !

           QUIT 

DONE      ;

 +1        KILL PSIU,PSIUQ,PSIUT,PSIUY

           QUIT 

 +2       ;

MQ        ;

 +1        WRITE !!,"  Enter `Y' to mark this drug as a"_$SELECT($EXTRACT(PSIUT)="N":"n"_$EXTRACT(PSIUT,2,99),1:PSIUT)_" item.",!,"  or `N' to unmark as a"_$SELECT($EXTRACT(PSIUT)="N":"n"_$EXTRACT(PSIUT,2,99),1:PSIUT)_" item."

           QUIT 

 +2       ;

END        KILL X,Y,DIR,DR,DIC,DIE,PSIUA,PSIUX,%,D0,D1,DA,DQ,I,Z,DTOUT,DUOUT,DIRUT,DIROUT,PSXJ

           QUIT