PSSLAB ;BIR/JMB,WRT ; 09/02/97 7:57; 5/6/94
;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
EDIT ;Mark/unmark drugs to print on profile
S (IEN50,DA)=DISPDRG
D:LMFLAG=1 UNMRK
Q:NFLAG Q:$D(DTOUT) Q:$D(DIRUT) Q:$D(DUOUT)
I +$P($G(^PSDRUG(IEN50,"I")),"^") S Y=$P($G(^PSDRUG(IEN50,"I")),"^") X ^DD("DD") W !,"** Drug inactivated "_Y_"."
I $P($G(^PSDRUG(IEN50,"CLOZ1")),"^")="PSOCLO1" W $C(7),$C(7),!!,"This drug is marked for Clozapine monitoring. To print the most",!,"recent lab result on the profile, the drug must be unmarked",!,"for Clozapine monitoring." D REASK
ED Q:CLFLAG Q:NFLAG Q:$D(DIRUT) Q:$D(DTOUT) Q:$D(DUOUT) S LIEN=+$P($G(^PSDRUG(IEN50,"CLOZ")),"^")
W !,"** You are NOW editing LAB MONITOR fields. **"
W ! K DIC S DIC(0)="QEAM",DIC("A")="Select LAB TEST MONITOR: ",DIC="^LAB(60,",DIC("B")=$P($G(^LAB(60,LIEN,0)),"^") D ^DIC K DIC
G:(Y<0)!($G(DIRUT)) EXIT S LIEN=+Y
I $S($P($P($G(^LAB(60,LIEN,0)),"^",5),";",2)="":1,1:0) W !!,$C(7),"Missing DATA NAME Probably a panel test. Please select another." G ED
SPEC S DIE="^PSDRUG(",DA=IEN50,DR="17.2////^S X=LIEN" D ^DIE K DIE
W !!,?5,"Now editing:",!
S DIE="^PSDRUG(",DA=IEN50,DR="17.2;17.4;17.3" D ^DIE S $P(^PSDRUG(IEN50,"CLOZ1"),"^",2)=1 S LMFLAG=1,NFLAG=1 K DIE
G:$D(DTOUT)!($D(DUOUT)) EXIT
I $P($G(^PSDRUG(DA,"CLOZ")),"^")=""&($P($G(^("CLOZ")),"^",2)="")&($P($G(^("CLOZ")),"^",3)="") S ^PSDRUG(IEN50,"CLOZ1")="" G EDIT
I $P(^PSDRUG(DA,"CLOZ"),"^")=""!($P(^("CLOZ"),"^",2)="")!($P(^("CLOZ"),"^",3)="") S ^PSDRUG(IEN50,"CLOZ1")="" W !!,$C(7),"Insufficient data.",!,"All fields must have an entry or all fields must be blank.",! S LMFLAG=0 G ED
EXIT K IEN50,LIEN Q
PRINT ;Prints most recent lab test value on profile.
I '$D(^DPT(DFN,"LR")) W !,"*** NO LAB DATA ON FILE ***" Q
S LRDFN=+$P(^DPT(DFN,"LR"),"^") Q:'LRDFN
S MDRUG=+$P(RX0,"^",6),TST=+$P(^PSDRUG(MDRUG,"CLOZ"),"^"),MDAYS=+$P(^("CLOZ"),"^",2),TSTSP=+$P(^("CLOZ"),"^",3)
G:'TST!('MDAYS)!('TSTSP) CLEAN
S TSTN=$P($G(^LAB(60,TST,0)),"^"),LDN=$S($D(^(.2)):+^(.2),1:+$P($P($G(^(0)),"^",5),";",2))
I $G(^LAB(60,TST,.2))=""&($P($P($G(^LAB(60,TST,0)),"^",5),";",2)="") W !,"*** RESULTS FOR A PANEL CANNOT BE PRINTED! ONLY A LAB TEST RESULT CAN BE PRINTED FOR MARKED DRUGS." G CLEAN
EDATE S X="T-"_MDAYS K %DT D ^%DT S EDT=Y,EDL=(9999999-EDT)_".999999",INDIC=0
BEG F BDL=0:0 S BDL=$O(^LR(LRDFN,"CH",BDL)) Q:BDL=""!(BDL>EDL) D Q:INDIC=1
.Q:'$D(^LR(LRDFN,"CH",BDL,LDN))!('$D(^(0)))
.Q:$P(^LR(LRDFN,"CH",BDL,0),"^",3)=""!($P(^(0),"^",5)'=TSTSP)
.S Y=$S(+$P($P(^LR(LRDFN,"CH",BDL,0),"^"),"."):+$P($P(^(0),"^"),"."),1:$P(^(0),"^",3))
.W !,"*** MOST RECENT "_$G(TSTN)_" PERFORMED "_$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_$E(Y,2,3)_" = "_+$P($G(^LR(LRDFN,"CH",BDL,LDN)),"^")_" "_$P($G(^LAB(60,TST,1,TSTSP,0)),"^",7) S INDIC=1
W:INDIC=0 !,"*** NO RESULTS FOR "_TSTN_" SINCE "_$E(EDT,4,5)_"-"_$E(EDT,6,7)_"-"_$E(EDT,2,3)
CLEAN K BDL,EDL,EDT,INDIC,LDN,LRDFN,MDAYS,MDRUG,TST,TSTN,TSTSP,X,Y
Q
UNMRK I $P($G(^PSDRUG(IEN50,"CLOZ1")),"^",2)=1 S DIR(0)="Y",DIR("A",1)="",DIR("A",2)="Are you sure you want to unmark "_$P(^PSDRUG(IEN50,0),"^"),DIR("A")="as a Lab Monitor drug",DIR("B")="N" D UNMRK0
Q
UNMRK0 D ^DIR Q:$D(DIRUT) Q:$D(DTOUT) Q:$D(DUOUT) D UNMRK1
Q
UNMRK1 I "Yy"[X S LMFLAG=0,DR="17.6///@",DIE="^PSDRUG(" D ^DIE W:LMFLAG=0 !!,$P(^PSDRUG(IEN50,0),"^")_" is now unmarked as a Lab Monitor drug" D ASKEM
Q
REASK G MONCLOZ^PSSDEE
ASKEM K DIR,X,Y,DIRUT,DTOUT,DUOUT W !!,"Do you wish to mark this drug as a Clozapine drug?" S DIR(0)="Y" D ^DIR
Q:$D(DTOUT) Q:$D(DUOUT) Q:$D(DIRUT)
I "Nn"[X S NFLAG=1 K DIR,X,Y Q
I "Yy"[X D CLOZ^PSSDEE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSLAB 3607 printed Dec 13, 2024@02:32:53 Page 2
PSSLAB ;BIR/JMB,WRT ; 09/02/97 7:57; 5/6/94
+1 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
EDIT ;Mark/unmark drugs to print on profile
+1 SET (IEN50,DA)=DISPDRG
+2 if LMFLAG=1
DO UNMRK
+3 if NFLAG
QUIT
if $DATA(DTOUT)
QUIT
if $DATA(DIRUT)
QUIT
if $DATA(DUOUT)
QUIT
+4 IF +$PIECE($GET(^PSDRUG(IEN50,"I")),"^")
SET Y=$PIECE($GET(^PSDRUG(IEN50,"I")),"^")
XECUTE ^DD("DD")
WRITE !,"** Drug inactivated "_Y_"."
+5 IF $PIECE($GET(^PSDRUG(IEN50,"CLOZ1")),"^")="PSOCLO1"
WRITE $CHAR(7),$CHAR(7),!!,"This drug is marked for Clozapine monitoring. To print the most",!,"recent lab result on the profile, the drug must be unmarked",!,"for Clozapine monitoring."
DO REASK
ED if CLFLAG
QUIT
if NFLAG
QUIT
if $DATA(DIRUT)
QUIT
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
SET LIEN=+$PIECE($GET(^PSDRUG(IEN50,"CLOZ")),"^")
+1 WRITE !,"** You are NOW editing LAB MONITOR fields. **"
+2 WRITE !
KILL DIC
SET DIC(0)="QEAM"
SET DIC("A")="Select LAB TEST MONITOR: "
SET DIC="^LAB(60,"
SET DIC("B")=$PIECE($GET(^LAB(60,LIEN,0)),"^")
DO ^DIC
KILL DIC
+3 if (Y<0)!($GET(DIRUT))
GOTO EXIT
SET LIEN=+Y
+4 IF $SELECT($PIECE($PIECE($GET(^LAB(60,LIEN,0)),"^",5),";",2)="":1,1:0)
WRITE !!,$CHAR(7),"Missing DATA NAME Probably a panel test. Please select another."
GOTO ED
SPEC SET DIE="^PSDRUG("
SET DA=IEN50
SET DR="17.2////^S X=LIEN"
DO ^DIE
KILL DIE
+1 WRITE !!,?5,"Now editing:",!
+2 SET DIE="^PSDRUG("
SET DA=IEN50
SET DR="17.2;17.4;17.3"
DO ^DIE
SET $PIECE(^PSDRUG(IEN50,"CLOZ1"),"^",2)=1
SET LMFLAG=1
SET NFLAG=1
KILL DIE
+3 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+4 IF $PIECE($GET(^PSDRUG(DA,"CLOZ")),"^")=""&($PIECE($GET(^("CLOZ")),"^",2)="")&($PIECE($GET(^("CLOZ")),"^",3)="")
SET ^PSDRUG(IEN50,"CLOZ1")=""
GOTO EDIT
+5 IF $PIECE(^PSDRUG(DA,"CLOZ"),"^")=""!($PIECE(^("CLOZ"),"^",2)="")!($PIECE(^("CLOZ"),"^",3)="")
SET ^PSDRUG(IEN50,"CLOZ1")=""
WRITE !!,$CHAR(7),"Insufficient data.",!,"All fields must have an entry or all fields must be blank.",!
SET LMFLAG=0
GOTO ED
EXIT KILL IEN50,LIEN
QUIT
PRINT ;Prints most recent lab test value on profile.
+1 IF '$DATA(^DPT(DFN,"LR"))
WRITE !,"*** NO LAB DATA ON FILE ***"
QUIT
+2 SET LRDFN=+$PIECE(^DPT(DFN,"LR"),"^")
if 'LRDFN
QUIT
+3 SET MDRUG=+$PIECE(RX0,"^",6)
SET TST=+$PIECE(^PSDRUG(MDRUG,"CLOZ"),"^")
SET MDAYS=+$PIECE(^("CLOZ"),"^",2)
SET TSTSP=+$PIECE(^("CLOZ"),"^",3)
+4 if 'TST!('MDAYS)!('TSTSP)
GOTO CLEAN
+5 SET TSTN=$PIECE($GET(^LAB(60,TST,0)),"^")
SET LDN=$SELECT($DATA(^(.2)):+^(.2),1:+$PIECE($PIECE($GET(^(0)),"^",5),";",2))
+6 IF $GET(^LAB(60,TST,.2))=""&($PIECE($PIECE($GET(^LAB(60,TST,0)),"^",5),";",2)="")
WRITE !,"*** RESULTS FOR A PANEL CANNOT BE PRINTED! ONLY A LAB TEST RESULT CAN BE PRINTED FOR MARKED DRUGS."
GOTO CLEAN
EDATE SET X="T-"_MDAYS
KILL %DT
DO ^%DT
SET EDT=Y
SET EDL=(9999999-EDT)_".999999"
SET INDIC=0
BEG FOR BDL=0:0
SET BDL=$ORDER(^LR(LRDFN,"CH",BDL))
if BDL=""!(BDL>EDL)
QUIT
Begin DoDot:1
+1 if '$DATA(^LR(LRDFN,"CH",BDL,LDN))!('$DATA(^(0)))
QUIT
+2 if $PIECE(^LR(LRDFN,"CH",BDL,0),"^",3)=""!($PIECE(^(0),"^",5)'=TSTSP)
QUIT
+3 SET Y=$SELECT(+$PIECE($PIECE(^LR(LRDFN,"CH",BDL,0),"^"),"."):+$PIECE($PIECE(^(0),"^"),"."),1:$PIECE(^(0),"^",3))
+4 WRITE !,"*** MOST RECENT "_$GET(TSTN)_" PERFORMED "_$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,7)_"-"_$EXTRACT(Y,2,3)_" = "_+$PIECE($GET(^LR(LRDFN,"CH",BDL,LDN)),"^")_" "_$PIECE($GET(^LAB(60,TST,1,TSTSP,0)),"^",7)
SET INDIC=1
End DoDot:1
if INDIC=1
QUIT
+5 if INDIC=0
WRITE !,"*** NO RESULTS FOR "_TSTN_" SINCE "_$EXTRACT(EDT,4,5)_"-"_$EXTRACT(EDT,6,7)_"-"_$EXTRACT(EDT,2,3)
CLEAN KILL BDL,EDL,EDT,INDIC,LDN,LRDFN,MDAYS,MDRUG,TST,TSTN,TSTSP,X,Y
+1 QUIT
UNMRK IF $PIECE($GET(^PSDRUG(IEN50,"CLOZ1")),"^",2)=1
SET DIR(0)="Y"
SET DIR("A",1)=""
SET DIR("A",2)="Are you sure you want to unmark "_$PIECE(^PSDRUG(IEN50,0),"^")
SET DIR("A")="as a Lab Monitor drug"
SET DIR("B")="N"
DO UNMRK0
+1 QUIT
UNMRK0 DO ^DIR
if $DATA(DIRUT)
QUIT
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
DO UNMRK1
+1 QUIT
UNMRK1 IF "Yy"[X
SET LMFLAG=0
SET DR="17.6///@"
SET DIE="^PSDRUG("
DO ^DIE
if LMFLAG=0
WRITE !!,$PIECE(^PSDRUG(IEN50,0),"^")_" is now unmarked as a Lab Monitor drug"
DO ASKEM
+1 QUIT
REASK GOTO MONCLOZ^PSSDEE
ASKEM KILL DIR,X,Y,DIRUT,DTOUT,DUOUT
WRITE !!,"Do you wish to mark this drug as a Clozapine drug?"
SET DIR(0)="Y"
DO ^DIR
+1 if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
if $DATA(DIRUT)
QUIT
+2 IF "Nn"[X
SET NFLAG=1
KILL DIR,X,Y
QUIT
+3 IF "Yy"[X
DO CLOZ^PSSDEE
