- 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 Feb 18, 2025@23:58:56 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