PSSCLOZ ;BIR/TTH-CLOZAPINE DRUG ENTER/EDIT CLOZAPINE ; 01/25/99
;;1.0;PHARMACY DATA MANAGEMENT;**19,90,232**;9/30/97;Build 1
;
;Reference to ^LAB(60 supported by DBIA #10054
;Reference to ^LAB(61 supported by DBIA #10055
;
Q:'$D(DISPDRG)
N DA,DIC,DIE,DIK,DINUM,DIR,DR,PSSANS,PSSANS2,PSSCIM,PSSCLO,PSSCNT,PSSCRN,PSSIEN,PSSLAB1,PSSLAB2,PSSLT,PSSLTN,PSSNN,PSSNUM,PSSOPP,PSSPTY,PSSPTYN,PSSSUB,PSSTOT,PSSTUFF,PSSTYP0,PSSXX,X,Y
K DIRUT,DUOUT
;Mark drug for Clozapine and create "ACLOZ" cross-reference.
S DA=DISPDRG,DIE=50,DR="17.5///^S X=""PSOCLO1""" D ^DIE K DA,DIE
;
CLOZBEG I $D(DIRUT)!($D(DUOUT)) Q
S (PSSIEN,PSSCNT)=0
I $O(^PSDRUG(DISPDRG,"CLOZ2",0)) F PSSIEN=0:0 S PSSIEN=$O(^PSDRUG(DISPDRG,"CLOZ2",PSSIEN)) Q:'PSSIEN D
.S PSSSUB=$P($G(^PSDRUG(DISPDRG,"CLOZ2",PSSIEN,0)),U),PSSTYP0=$P($G(^(0)),U,4),PSSCIM=$P($G(^(0)),U,3)
.K PSSLAB1,PSSLAB2 S PSSLAB1=$$GET1^DIQ(60,PSSSUB,.01,"I"),PSSLAB2=$$GET1^DIQ(61,PSSCIM,.01,"I")
.S PSSCNT=PSSCNT+1,PSSCLO(PSSCNT)=$S($D(PSSLAB1):PSSLAB1,1:"**Unknown Lab Test**")_"^"_PSSSUB_"^"_PSSIEN_"^"_PSSTYP0_"^"_$S($D(PSSLAB2):PSSLAB2,1:"**Unknown Lab Test**")
W !!,"Prescription of Clozapine requires identification of two",!,"laboratory tests, WBC and Absolute Neutrophil Count (ANC).",!!
I PSSCNT=0 W "You do not have any laboratory tests identified." W !! S DIR(0)="SOA^WBC:WBC;ANC:ANC",DIR("B")="WBC" S DIR("A")="Select Laboratory Test Type: " D ^DIR Q:$D(DIRUT) S PSSTUFF=Y K DIR,X,Y G CLOZBG2
I PSSCNT=1 W "You have one laboratory type of "_$S(PSSTYP0=1:"WBC",PSSTYP0=2:"ANC",1:"**Unknown**")_" test identified." S PSSTUFF=$S(PSSTYP0=2:1,1:2)
I PSSCNT>1 W "You currently have both laboratory tests identified."
;
D DISPLAY
;
CLOZBG2 I PSSCNT=0 S PSSANS="A" D CLOZSEL Q
S DIR("?")="Enter the letter that correspond with the function."
I PSSCNT=1 D Q:$D(DIRUT)
.S PSSOPP=$S(PSSTYP0=2:"WBC",PSSTYP0=1:"ANC",1:"**Data Missing**")
.W !!,"A second laboratory type of "_PSSOPP_" test should be added.",! S DIR(0)="SOA^A:ADD;E:EDIT;D:DELETE",DIR("A")="(A)dd, (E)dit, or (D)elete entry? " D ^DIR Q:$D(DIRUT)
I PSSCNT>1 W !! S DIR(0)="SOA^E:EDIT;D:DELETE",DIR("A")="(E)dit or (D)elete entry? " D ^DIR Q:$D(DIRUT)
S PSSANS=Y D CLOZSEL Q:$D(DIRUT)
;
END ;Kill variables.
K DIC,DIE,DIK,DIR,DR,PSSANS,PSSANS2,PSSCNT,PSSSUB,PSSXX,X,Y
Q
;
DISPLAY ;Display lab test.
W !!!,?2,"Type of",!,?2,"Test",?12,"Lab Test Monitor",?55,"Specimen Type",!,?2,"-------",?12,"----------------",?55,"-------------"
Q:'$O(PSSCLO(0)) W ! F PSSXX=0:0 S PSSXX=$O(PSSCLO(PSSXX)) Q:'PSSXX D
.S PSSTOT=$P($G(PSSCLO(PSSXX)),U,4)
.W !,?2,PSSXX_". "_$S(PSSTOT=1:"WBC",PSSTOT=2:"ANC",1:"**Unknown**"),?12,$P(PSSCLO(PSSXX),U),?55,$E($P(PSSCLO(PSSXX),U,5),1,20)
Q
;
CLOZSEL ;Execute add, edit or delete submodule.
I PSSCNT>1,($G(PSSANS)'="A") D CLOZASK Q:$D(DIRUT)
I PSSANS="D" D:PSSCNT=1 CLOZASK D CLOZDEL Q
I PSSANS="E" D:PSSCNT=1 CLOZASK D CLOZEDT Q
;
CLOZADD ;Add Clozapine sub-entry
Q:$D(DIRUT)
D DISPLY2 Q:$D(DIRUT) I Y=0 D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
CLOZAD2 K DIC,DD,DO S X=PSSLTN,DA(1)=DISPDRG,DIC="^PSDRUG("_DA(1)_",""CLOZ2"","
S DIC(0)="L",DIC("P")="50.02P"
S DIC("DR")="2////"_PSSPTYN_";3///"_PSSTUFF
D FILE^DICN K DD,DO I Y=-1 S (DUOUT,DIRUT)=1 K DIC,DA,X,Y Q
D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
Q
;
CLOZEDT ;Edit Clozapine sub-entry
Q:$D(DIRUT) K DIE,DR,X,Y S DA=PSSANS2
S DIE="^PSDRUG(DISPDRG,""CLOZ2"","
S DR=".01;2;3///"_PSSTUFF D ^DIE I $D(Y) S (DUOUT,DIRUT)=1 D CLOZDXX K ^PSDRUG(DISPDRG,"CLOZ2"),DIE,DR,X,Y Q
D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
Q
;
CLOZDEL ;Delete Clozapine sub-entry
Q:$D(DIRUT) I PSSCNT<3 W !,"You must have a test defined for WBC and ANC to dispense Clozapine.",!
S DIR("A")="Are you sure that you want to delete this test",DIR("?")="Enter YES to delete the laboratory test, NO to return to selection.",DIR(0)="Y",DIR("B")="NO" D ^DIR Q:$D(DIRUT) I +Y=0 D END W !! K PSSCLO G CLOZBEG
;
CLOZDXX K DIK,X,Y
S DA(1)=DISPDRG,DA=PSSANS2,DIK="^PSDRUG(DISPDRG,""CLOZ2"","
D ^DIK K DIK,X,Y
I PSSANS="E",PSSCNT>1 Q
Q:PSSANS="A" W !!,"Deleting "_$P(PSSCLO(PSSNUM),U)_"...."
D END Q:$G(DIRUT) W !! K PSSCLO G CLOZBEG
Q
CLOZASK ;Select LAB Test number.
I $D(DIRUT)!($D(DUOUT)) Q
W ! K DIR,Y S DIR(0)="NA^1:"_PSSCNT_":1",DIR("A")="Select the Number of the test you want to "_$S(PSSANS="D":"delete",1:"edit")_" (1 or "_PSSCNT_"): "
S DIR("?")="Enter the number you want to delete or edit." D ^DIR Q:$D(DIRUT)
S PSSNUM=+Y,PSSANS2=$P(PSSCLO(PSSNUM),U,3) I PSSANS="E" S PSSTUFF=$P(PSSCLO(PSSNUM),U,4) I PSSCNT>1 D Q:$D(DIRUT) I Y=0 D END W !! K PSSCLO G CLOZBEG
.S PSSNN=$S(PSSNUM=1:2,1:1),PSSCRN=$P(PSSCLO(PSSNN),U,2)
.D DISPLY3 Q:$D(DIRUT)!(Y=0)
.D CLOZDXX ;Delete selected entry.
.D CLOZAD2 ;Add entry with new changes.
Q
;
DISPLY2 ;Display selection before adding to file.
Q:$D(DIRUT) S PSSCRN=$P($G(PSSCLO(1)),U,2)
DISPLY3 K DIR,X,Y W ! S DIR(0)="P^60:EMAQZ",DIR("S")="I PSSCRN'=+Y" D ^DIR Q:$D(DIRUT) S PSSLTN=+Y,PSSLT=$P(Y,U,2)
K DIR,X,Y S DIR(0)="P^61:EMAQZ",DIR("A")="Select SPECIMEN TYPE" D ^DIR Q:$D(DIRUT) S PSSPTYN=+Y,PSSPTY=$P(Y,U,2) K DIR,X,Y
W !!,"You have selected the following information for",!,"a Laboratory Type of "_$S(PSSTUFF=2:"ANC",1:"WBC")_" test."
W !!,?2,"Lab Test Monitor: "_PSSLT,!,?2,"Specimen Type : "_PSSPTY
K DIR,X,Y W !! S DIR("A")="Is this correct",DIR("?")="Enter YES to accept, NO to reject.",DIR(0)="Y",DIR("B")="YES" D ^DIR
Q
;
CLOZMOV ;In File #50, move data CLOZ node to CLOZ2 node.
N PSSIEN,PSSGLO
S (PSSIEN,PSSGLO)=0
F PSSIEN=0:0 S PSSIEN=$O(^PSDRUG(PSSIEN)) Q:'PSSIEN I $P($G(^PSDRUG(PSSIEN,"CLOZ1")),"^")="PSOCLO1" D
.S ^PSDRUG("ACLOZ",PSSIEN)="",PSSGLO=^PSDRUG(PSSIEN,"CLOZ")
.K DIC,DD,DO,X S (DA,DINUM)=1,DA(1)=PSSIEN,X=$P(PSSGLO,"^") Q:'X
.S DIC("P")="50.02P",DIC(0)="L"
.S DIC="^PSDRUG("_DA(1)_",""CLOZ2"","
.S DIC("DR")="1////"_$P(PSSGLO,"^",2)_";2////"_$P(PSSGLO,"^",3)_";3///1"
.D FILE^DICN K DIC,DA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSCLOZ 6018 printed Sep 23, 2025@20:06:11 Page 2
PSSCLOZ ;BIR/TTH-CLOZAPINE DRUG ENTER/EDIT CLOZAPINE ; 01/25/99
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**19,90,232**;9/30/97;Build 1
+2 ;
+3 ;Reference to ^LAB(60 supported by DBIA #10054
+4 ;Reference to ^LAB(61 supported by DBIA #10055
+5 ;
+6 if '$DATA(DISPDRG)
QUIT
+7 NEW DA,DIC,DIE,DIK,DINUM,DIR,DR,PSSANS,PSSANS2,PSSCIM,PSSCLO,PSSCNT,PSSCRN,PSSIEN,PSSLAB1,PSSLAB2,PSSLT,PSSLTN,PSSNN,PSSNUM,PSSOPP,PSSPTY,PSSPTYN,PSSSUB,PSSTOT,PSSTUFF,PSSTYP0,PSSXX,X,Y
+8 KILL DIRUT,DUOUT
+9 ;Mark drug for Clozapine and create "ACLOZ" cross-reference.
+10 SET DA=DISPDRG
SET DIE=50
SET DR="17.5///^S X=""PSOCLO1"""
DO ^DIE
KILL DA,DIE
+11 ;
CLOZBEG IF $DATA(DIRUT)!($DATA(DUOUT))
QUIT
+1 SET (PSSIEN,PSSCNT)=0
+2 IF $ORDER(^PSDRUG(DISPDRG,"CLOZ2",0))
FOR PSSIEN=0:0
SET PSSIEN=$ORDER(^PSDRUG(DISPDRG,"CLOZ2",PSSIEN))
if 'PSSIEN
QUIT
Begin DoDot:1
+3 SET PSSSUB=$PIECE($GET(^PSDRUG(DISPDRG,"CLOZ2",PSSIEN,0)),U)
SET PSSTYP0=$PIECE($GET(^(0)),U,4)
SET PSSCIM=$PIECE($GET(^(0)),U,3)
+4 KILL PSSLAB1,PSSLAB2
SET PSSLAB1=$$GET1^DIQ(60,PSSSUB,.01,"I")
SET PSSLAB2=$$GET1^DIQ(61,PSSCIM,.01,"I")
+5 SET PSSCNT=PSSCNT+1
SET PSSCLO(PSSCNT)=$SELECT($DATA(PSSLAB1):PSSLAB1,1:"**Unknown Lab Test**")_"^"_PSSSUB_"^"_PSSIEN_"^"_PSSTYP0_"^"_$SELECT($DATA(PSSLAB2):PSSLAB2,1:"**Unknown Lab Test**")
End DoDot:1
+6 WRITE !!,"Prescription of Clozapine requires identification of two",!,"laboratory tests, WBC and Absolute Neutrophil Count (ANC).",!!
+7 IF PSSCNT=0
WRITE "You do not have any laboratory tests identified."
WRITE !!
SET DIR(0)="SOA^WBC:WBC;ANC:ANC"
SET DIR("B")="WBC"
SET DIR("A")="Select Laboratory Test Type: "
DO ^DIR
if $DATA(DIRUT)
QUIT
SET PSSTUFF=Y
KILL DIR,X,Y
GOTO CLOZBG2
+8 IF PSSCNT=1
WRITE "You have one laboratory type of "_$SELECT(PSSTYP0=1:"WBC",PSSTYP0=2:"ANC",1:"**Unknown**")_" test identified."
SET PSSTUFF=$SELECT(PSSTYP0=2:1,1:2)
+9 IF PSSCNT>1
WRITE "You currently have both laboratory tests identified."
+10 ;
+11 DO DISPLAY
+12 ;
CLOZBG2 IF PSSCNT=0
SET PSSANS="A"
DO CLOZSEL
QUIT
+1 SET DIR("?")="Enter the letter that correspond with the function."
+2 IF PSSCNT=1
Begin DoDot:1
+3 SET PSSOPP=$SELECT(PSSTYP0=2:"WBC",PSSTYP0=1:"ANC",1:"**Data Missing**")
+4 WRITE !!,"A second laboratory type of "_PSSOPP_" test should be added.",!
SET DIR(0)="SOA^A:ADD;E:EDIT;D:DELETE"
SET DIR("A")="(A)dd, (E)dit, or (D)elete entry? "
DO ^DIR
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+5 IF PSSCNT>1
WRITE !!
SET DIR(0)="SOA^E:EDIT;D:DELETE"
SET DIR("A")="(E)dit or (D)elete entry? "
DO ^DIR
if $DATA(DIRUT)
QUIT
+6 SET PSSANS=Y
DO CLOZSEL
if $DATA(DIRUT)
QUIT
+7 ;
END ;Kill variables.
+1 KILL DIC,DIE,DIK,DIR,DR,PSSANS,PSSANS2,PSSCNT,PSSSUB,PSSXX,X,Y
+2 QUIT
+3 ;
DISPLAY ;Display lab test.
+1 WRITE !!!,?2,"Type of",!,?2,"Test",?12,"Lab Test Monitor",?55,"Specimen Type",!,?2,"-------",?12,"----------------",?55,"-------------"
+2 if '$ORDER(PSSCLO(0))
QUIT
WRITE !
FOR PSSXX=0:0
SET PSSXX=$ORDER(PSSCLO(PSSXX))
if 'PSSXX
QUIT
Begin DoDot:1
+3 SET PSSTOT=$PIECE($GET(PSSCLO(PSSXX)),U,4)
+4 WRITE !,?2,PSSXX_". "_$SELECT(PSSTOT=1:"WBC",PSSTOT=2:"ANC",1:"**Unknown**"),?12,$PIECE(PSSCLO(PSSXX),U),?55,$EXTRACT($PIECE(PSSCLO(PSSXX),U,5),1,20)
End DoDot:1
+5 QUIT
+6 ;
CLOZSEL ;Execute add, edit or delete submodule.
+1 IF PSSCNT>1
IF ($GET(PSSANS)'="A")
DO CLOZASK
if $DATA(DIRUT)
QUIT
+2 IF PSSANS="D"
if PSSCNT=1
DO CLOZASK
DO CLOZDEL
QUIT
+3 IF PSSANS="E"
if PSSCNT=1
DO CLOZASK
DO CLOZEDT
QUIT
+4 ;
CLOZADD ;Add Clozapine sub-entry
+1 if $DATA(DIRUT)
QUIT
+2 DO DISPLY2
if $DATA(DIRUT)
QUIT
IF Y=0
DO END
if $GET(DIRUT)
QUIT
WRITE !!
KILL PSSCLO
GOTO CLOZBEG
CLOZAD2 KILL DIC,DD,DO
SET X=PSSLTN
SET DA(1)=DISPDRG
SET DIC="^PSDRUG("_DA(1)_",""CLOZ2"","
+1 SET DIC(0)="L"
SET DIC("P")="50.02P"
+2 SET DIC("DR")="2////"_PSSPTYN_";3///"_PSSTUFF
+3 DO FILE^DICN
KILL DD,DO
IF Y=-1
SET (DUOUT,DIRUT)=1
KILL DIC,DA,X,Y
QUIT
+4 DO END
if $GET(DIRUT)
QUIT
WRITE !!
KILL PSSCLO
GOTO CLOZBEG
+5 QUIT
+6 ;
CLOZEDT ;Edit Clozapine sub-entry
+1 if $DATA(DIRUT)
QUIT
KILL DIE,DR,X,Y
SET DA=PSSANS2
+2 SET DIE="^PSDRUG(DISPDRG,""CLOZ2"","
+3 SET DR=".01;2;3///"_PSSTUFF
DO ^DIE
IF $DATA(Y)
SET (DUOUT,DIRUT)=1
DO CLOZDXX
KILL ^PSDRUG(DISPDRG,"CLOZ2"),DIE,DR,X,Y
QUIT
+4 DO END
if $GET(DIRUT)
QUIT
WRITE !!
KILL PSSCLO
GOTO CLOZBEG
+5 QUIT
+6 ;
CLOZDEL ;Delete Clozapine sub-entry
+1 if $DATA(DIRUT)
QUIT
IF PSSCNT<3
WRITE !,"You must have a test defined for WBC and ANC to dispense Clozapine.",!
+2 SET DIR("A")="Are you sure that you want to delete this test"
SET DIR("?")="Enter YES to delete the laboratory test, NO to return to selection."
SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
if $DATA(DIRUT)
QUIT
IF +Y=0
DO END
WRITE !!
KILL PSSCLO
GOTO CLOZBEG
+3 ;
CLOZDXX KILL DIK,X,Y
+1 SET DA(1)=DISPDRG
SET DA=PSSANS2
SET DIK="^PSDRUG(DISPDRG,""CLOZ2"","
+2 DO ^DIK
KILL DIK,X,Y
+3 IF PSSANS="E"
IF PSSCNT>1
QUIT
+4 if PSSANS="A"
QUIT
WRITE !!,"Deleting "_$PIECE(PSSCLO(PSSNUM),U)_"...."
+5 DO END
if $GET(DIRUT)
QUIT
WRITE !!
KILL PSSCLO
GOTO CLOZBEG
+6 QUIT
CLOZASK ;Select LAB Test number.
+1 IF $DATA(DIRUT)!($DATA(DUOUT))
QUIT
+2 WRITE !
KILL DIR,Y
SET DIR(0)="NA^1:"_PSSCNT_":1"
SET DIR("A")="Select the Number of the test you want to "_$SELECT(PSSANS="D":"delete",1:"edit")_" (1 or "_PSSCNT_"): "
+3 SET DIR("?")="Enter the number you want to delete or edit."
DO ^DIR
if $DATA(DIRUT)
QUIT
+4 SET PSSNUM=+Y
SET PSSANS2=$PIECE(PSSCLO(PSSNUM),U,3)
IF PSSANS="E"
SET PSSTUFF=$PIECE(PSSCLO(PSSNUM),U,4)
IF PSSCNT>1
Begin DoDot:1
+5 SET PSSNN=$SELECT(PSSNUM=1:2,1:1)
SET PSSCRN=$PIECE(PSSCLO(PSSNN),U,2)
+6 DO DISPLY3
if $DATA(DIRUT)!(Y=0)
QUIT
+7 ;Delete selected entry.
DO CLOZDXX
+8 ;Add entry with new changes.
DO CLOZAD2
End DoDot:1
if $DATA(DIRUT)
QUIT
IF Y=0
DO END
WRITE !!
KILL PSSCLO
GOTO CLOZBEG
+9 QUIT
+10 ;
DISPLY2 ;Display selection before adding to file.
+1 if $DATA(DIRUT)
QUIT
SET PSSCRN=$PIECE($GET(PSSCLO(1)),U,2)
DISPLY3 KILL DIR,X,Y
WRITE !
SET DIR(0)="P^60:EMAQZ"
SET DIR("S")="I PSSCRN'=+Y"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET PSSLTN=+Y
SET PSSLT=$PIECE(Y,U,2)
+1 KILL DIR,X,Y
SET DIR(0)="P^61:EMAQZ"
SET DIR("A")="Select SPECIMEN TYPE"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET PSSPTYN=+Y
SET PSSPTY=$PIECE(Y,U,2)
KILL DIR,X,Y
+2 WRITE !!,"You have selected the following information for",!,"a Laboratory Type of "_$SELECT(PSSTUFF=2:"ANC",1:"WBC")_" test."
+3 WRITE !!,?2,"Lab Test Monitor: "_PSSLT,!,?2,"Specimen Type : "_PSSPTY
+4 KILL DIR,X,Y
WRITE !!
SET DIR("A")="Is this correct"
SET DIR("?")="Enter YES to accept, NO to reject."
SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
+5 QUIT
+6 ;
CLOZMOV ;In File #50, move data CLOZ node to CLOZ2 node.
+1 NEW PSSIEN,PSSGLO
+2 SET (PSSIEN,PSSGLO)=0
+3 FOR PSSIEN=0:0
SET PSSIEN=$ORDER(^PSDRUG(PSSIEN))
if 'PSSIEN
QUIT
IF $PIECE($GET(^PSDRUG(PSSIEN,"CLOZ1")),"^")="PSOCLO1"
Begin DoDot:1
+4 SET ^PSDRUG("ACLOZ",PSSIEN)=""
SET PSSGLO=^PSDRUG(PSSIEN,"CLOZ")
+5 KILL DIC,DD,DO,X
SET (DA,DINUM)=1
SET DA(1)=PSSIEN
SET X=$PIECE(PSSGLO,"^")
if 'X
QUIT
+6 SET DIC("P")="50.02P"
SET DIC(0)="L"
+7 SET DIC="^PSDRUG("_DA(1)_",""CLOZ2"","
+8 SET DIC("DR")="1////"_$PIECE(PSSGLO,"^",2)_";2////"_$PIECE(PSSGLO,"^",3)_";3///1"
+9 DO FILE^DICN
KILL DIC,DA
End DoDot:1
+10 QUIT
