- 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
