source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSCLDRG.m@ 841

Last change on this file since 841 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PSSCLDRG ;BIR/SAB,WRT-CLOZAPINE DRUG ENTER AND EDIT ; 09/05/97 14:30
2 ;;1.0;PHARMACY DATA MANAGEMENT;**16,19**;9/30/97
3 I $P($G(^PSDRUG(DISPDRG,"CLOZ1")),"^",2)=1 W $C(7),$C(7),!!,"This drug is marked for Lab Monitor purposes. You must unmark it as a",!,"Lab Monitor before you can mark it as a Clozapine drug." G MONCLOZ^PSSDEE
4ASK W ! S DA=DISPDRG I $D(^PSDRUG("ACLOZ",DISPDRG)) D:CLFLAG UNMARK^PSSCLDRG
5 Q:LMFLAG Q:NFLAG Q:$D(DIRUT) Q:$D(DUOUT) Q:$D(DTOUT)
6 N PSSFLG
7 I '$G(^PSDRUG(DISPDRG,"I"))!(+$G(^("I"))>DT) S PSSFLG=1 D ^PSSCLOZ
8 I '$D(PSSFLG) S DR="D CHECK^PSSCLDRG;100///@;W !,""Drug is now re-activated"" S Y=""@2"";@1;W !!,""No change"";@2" S DA=DISPDRG,DIE=DIC D ^DIE S:$G(Y)=1 DUOUT=1
9 I '$D(DUOUT),('$D(DIRUT)),('$D(DTOUT)) D PSIU W !,$P(^PSDRUG(DA,0),"^")_" is now marked as a Clozapine drug",! S CLFLAG=1,NFLAG=1
10END K X,Y,DIR,DR,DIC,DIE,PSIUA,PSIUX,%,D0,D1,DQ,I,Z,DTOUT,DUOUT,DIROUT,DIROUT
11 Q
12CHECK N DP,DQ S DIR("A")="THIS DRUG IS INACTIVE - DO YOU WISH TO REACTIVATE IT",DIR("B")="N",DIR(0)="Y" D ^DIR I "^N"[X S Y="@1" Q
13 S Y=100
14 Q
15PSIU ;
16 S PSIUO=$P($G(^PSDRUG(DA,2)),"^",3),PSIUY=$S("O"[PSIUO:PSIUO,1:PSIUO_"O"),$P(^PSDRUG(DA,2),"^",3)=PSIUY
17 I $P(^PSDRUG(DA,0),"^")]"" S ^PSDRUG("AIUO",$P(^(0),"^"),DA)=""
18 K:PSIUO]"" ^PSDRUG("IU",PSIUO,DA) S:$G(PSIUY)]"" ^PSDRUG("IU",PSIUY,DA)=""
19 K PSIUO,PSIUY W !
20 Q
21UNMARK I $D(^PSDRUG("ACLOZ",DISPDRG)) S DA=DISPDRG
22 I DA S DIR(0)="Y",DIR("A",1)="",DIR("A",2)="Are you sure you want to unmark "_$P(^PSDRUG(DISPDRG,0),"^"),DIR("A")="as a Clozapine drug",DIR("B")="N" D ^DIR
23 I "Yy"[X S CLFLAG=0 S DR="17.5///@",DIE=DIC D ^DIE W:CLFLAG=0 !!,$P(^PSDRUG(DA,0),"^")_" is now unmarked as a Clozapine drug",! D ASKIT
24 W !
25 Q
26ASKIT K DIR W !,"Do you wish to mark this drug as a Lab Monitor drug?" S DIR(0)="Y" D ^DIR
27 Q:$D(DIRUT) Q:$D(DTOUT) Q:$D(DUOUT)
28 I "Nn"[X S NFLAG=1 K X,Y,DIR Q
29 I "Yy"[X D ^PSSLAB
30 Q
Note: See TracBrowser for help on using the repository browser.