PSOCLUTL ;BHAM ISC/DMA - utilities for clozapine reporting system ; 12/22/92
;;7.0;OUTPATIENT PHARMACY;**28,56,122,222,268**;DEC 1997;Build 9
;External reference ^YSCL(603.01 supported by DBIA 2697
;External reference ^PS(55 supported by DBIA 2228
;
REG ; register patient
S DIC=55,DLAYGO=55,DIC(0)="AEQL",DIC("A")="Select patient to register: " D ^DIC K DIC G END:Y<0 S PSO1=+Y,PSONAME=$P(^DPT(PSO1,0),"^") K DLAYGO
D:$P($G(^PS(55,PSO1,0)),"^",6)'=2 EN^PSOHLUP(PSO1)
I '$D(^YSCL(603.01,"C",PSO1)) W !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) REG S JADOVER=""
I $P($G(^PS(55,PSO1,"SAND")),"^")]"" S PSO4=^("SAND") W !!,PSONAME_" is already registered with number "_$P(PSO4,"^"),!!,"Use the edit option to change registration data, or",!,"contact your supervisor",! G REG
NUMBER S DIR(0)="55,53" D ^DIR S PSO2=Y K DIR I $D(DIRUT) W !,"Not registered",! D END G REG
I $D(^PS(55,"ASAND1",PSO2)),$O(^(PSO2,0))'=PSO1 W !,PSO2," is already assigned to ",$P(^DPT(+$O(^(0)),0),"^") W !,"Please contact your supervisor" D END G REG
I '$D(JADOVER),'$D(^YSCL(603.01,"B",PSO2)) W !!,"The NCCC in Dallas has not authorized "_PSO2_" for useage",!,"at this facility. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) END
S DIR("A")="Pre-treatment or Active treatment? ",DIR(0)="S^P:PRE-TREATMENT;A:ACTIVE TREATMENT;",DIR("?")="Is this patient new to the Clozapine program, or has s/he been receiving treatment?" D ^DIR K DIR S PSO3=Y
I $D(DIRUT) W !!,"Not registered" R X:10 K X G END
PHY S DIC="^VA(200,",DIC(0)="AEQMZ",DIC("A")="Provider responsible: ",DIC("S")="I $G(^VA(200,+Y,""PS""))]""""" D ^DIC K DIC I Y<0 W !!,"Not registered",!! R X:10 K X G END
I $P($G(^VA(200,+Y,"PS")),"^",2)']"" W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!! G PHY
S PSO4=+Y K DIR,DIRUT,DUOUT,DTOUT
S DIR("A",1)="OK to register "_PSONAME_" with number "_PSO2,DIR("A")="as a"_$S('PSO3:" new",1:"n ongoing")_" patient in this program "
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I Y=0 G END
SAVE S DA=PSO1,DIE=55,DR="53////"_PSO2_";54////"_PSO3_";57////"_PSO4_";56////0;58////"_DT L +^PS(55,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !!,$C(7),"Patient "_PSONAME_" is being edited by another user! Try Later." G END
D ^DIE L -^PS(55,DA)
END K %,%Y,C,D,D0,DA,DI,DQ,DFN,DIC,DIE,DR,PSO,PSO1,PSO2,PSO3,PSO4,PSOC,PSOLN,PSONAME,PSONO,PSOT,R,VAERR,XMDUZ,XMSUB,XMTEXT,Y,^TMP($J),^TMP("PSO",$J) Q
Q
;
FACILITY ;Enter facility DEA number to set up clozapine system
;this entry point is no longer used. this functionality was taken over
;by the mental health package with the release of YS*5.01*18
;W ! S DIC=59,DIC(0)="AEQM",DIC("A")="Select site to participate in clozapine program : " D ^DIC G END:Y<0
;S DIE=DIC,DA=+Y,DR="1R;2R;" L +^PS(59,DA) D ^DIE L -^PS(59,DA) G FACILITY
Q
;
;
AGAIN ; re-enter patient - new number, status and provider
S DIC=55,DIC(0)="AEQM",DIC("A")="Select clozapine patient : " D ^DIC K DIC G END:Y<0 S DA=+Y,PSO1=DA,PSONAME=$P(^DPT(DA,0),"^")
I $P($G(^PS(55,DA,"SAND")),"^")="" W !,PSONAME_" is not registered. Use the register option." G AGAIN
I '$D(^YSCL(603.01,"C",PSO1)) W !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) AGAIN S JADOVER=""
S DIR(0)="55,53" D ^DIR G END:$D(DIRUT) S PSO2=Y I $D(^PS(55,"ASAND1",PSO2)),$O(^(PSO2,0))'=PSO1 W !,PSO2," already assigned to ",$P(^DPT($O(^(0)),0),"^") G END
I '$D(JADOVER),'$D(^YSCL(603.01,"B",PSO2)) W !!,"The NCCC in Dallas has not authorized "_PSO2_" for usage",!,"at this facility. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) END
;S DIR(0)="55,54" D ^DIR G END:$D(DIRUT) S PSO3=Y
S PSO3=$P(^PS(55,DA,"SAND"),"^",2)
W !,$P(^DD(55,54,0),"^")_": "_$S(PSO3="A":"ACTIVE TREATMENT",PSO3="D":"DISCONTINUED",PSO3="H":"TREATMENT ON HOLD",1:"PRE-TREATMENT")
PHY1 ;
S PSO4=$P(^PS(55,DA,"SAND"),"^",5),DIR(0)="55,57" D ^DIR G END:$D(DIRUT) I Y S PSO4=+Y
I $P($G(^VA(200,PSO4,"PS")),"^",2)="" W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!! G PHY1
G SAVE
;
OVER ;allow registration of patients and clozapine numbers not yet authorized by the NCCC.
K DIR W ! S DIR("A")="Do you want to over-ride this warning",DIR(0)="Y",DIR("B")="No" D ^DIR
I Y D S %=1
.Q S YSCLDATA(1)="An over-ride was authorize at "_$G(DUZ(2))_" for "_$S($D(PSONAME):PSONAME,1:$G(PSO2))_" by "_$P($G(^VA(200,DUZ,0)),"^")
.S %H=$H D YMD^%DTC S XMDUN="NCC LOGGER",XMDUZ=.5,XMSUB=$G(DUZ(2))_" NCC ENROLLER ("_X_%_")",XMTEXT="YSCLDATA(",XMY("G.CLOZAPINE ROLL-UP@FORUM.VA.GOV")=""
.D ^XMD K XMDUN,XMDUZ,XMER,XMREC,XRG,XMSUB,XMTEXT,XMY,XMZ,YSCLDATA
K DIR,DIRUT,DUOUT Q
PSOCLUTL ;BHAM ISC/DMA - utilities for clozapine reporting system ; 12/22/92
+1 ;;7.0;OUTPATIENT PHARMACY;**28,56,122,222,268**;DEC 1997;Build 9
+2 ;External reference ^YSCL(603.01 supported by DBIA 2697
+3 ;External reference ^PS(55 supported by DBIA 2228
+4 ;
REG ; register patient
+1 SET DIC=55
SET DLAYGO=55
SET DIC(0)="AEQL"
SET DIC("A")="Select patient to register: "
DO ^DIC
KILL DIC
IF Y<0
GOTO END
SET PSO1=+Y
SET PSONAME=$PIECE(^DPT(PSO1,0),"^")
KILL DLAYGO
+2 IF $PIECE($GET(^PS(55,PSO1,0)),"^",6)'=2
DO EN^PSOHLUP(PSO1)
+3 IF '$DATA(^YSCL(603.01,"C",PSO1))
WRITE !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization."
DO OVER
IF '$GET(%)
GOTO REG
SET JADOVER=""
+4 IF $PIECE($GET(^PS(55,PSO1,"SAND")),"^")]""
SET PSO4=^("SAND")
WRITE !!,PSONAME_" is already registered with number "_$PIECE(PSO4,"^"),!!,"Use the edit option to change registration data, or",!,"contact your supervisor",!
GOTO REG
NUMBER SET DIR(0)="55,53"
DO ^DIR
SET PSO2=Y
KILL DIR
IF $DATA(DIRUT)
WRITE !,"Not registered",!
DO END
GOTO REG
+1 IF $DATA(^PS(55,"ASAND1",PSO2))
IF $ORDER(^(PSO2,0))'=PSO1
WRITE !,PSO2," is already assigned to ",$PIECE(^DPT(+$ORDER(^(0)),0),"^")
WRITE !,"Please contact your supervisor"
DO END
GOTO REG
+2 IF '$DATA(JADOVER)
IF '$DATA(^YSCL(603.01,"B",PSO2))
WRITE !!,"The NCCC in Dallas has not authorized "_PSO2_" for useage",!,"at this facility. Contact the NCCC in Dallas for authorization."
DO OVER
IF '$GET(%)
GOTO END
+3 SET DIR("A")="Pre-treatment or Active treatment? "
SET DIR(0)="S^P:PRE-TREATMENT;A:ACTIVE TREATMENT;"
SET DIR("?")="Is this patient new to the Clozapine program, or has s/he been receiving treatment?"
DO ^DIR
KILL DIR
SET PSO3=Y
+4 IF $DATA(DIRUT)
WRITE !!,"Not registered"
READ X:10
KILL X
GOTO END
PHY SET DIC="^VA(200,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Provider responsible: "
SET DIC("S")="I $G(^VA(200,+Y,""PS""))]"""""
DO ^DIC
KILL DIC
IF Y<0
WRITE !!,"Not registered",!!
READ X:10
KILL X
GOTO END
+1 IF $PIECE($GET(^VA(200,+Y,"PS")),"^",2)']""
WRITE !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
GOTO PHY
+2 SET PSO4=+Y
KILL DIR,DIRUT,DUOUT,DTOUT
+3 SET DIR("A",1)="OK to register "_PSONAME_" with number "_PSO2
SET DIR("A")="as a"_$SELECT('PSO3:" new",1:"n ongoing")_" patient in this program "
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y=0
GOTO END
SAVE SET DA=PSO1
SET DIE=55
SET DR="53////"_PSO2_";54////"_PSO3_";57////"_PSO4_";56////0;58////"_DT
LOCK +^PS(55,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
WRITE !!,$CHAR(7),"Patient "_PSONAME_" is being edited by another user! Try Later."
GOTO END
+1 DO ^DIE
LOCK -^PS(55,DA)
END KILL %,%Y,C,D,D0,DA,DI,DQ,DFN,DIC,DIE,DR,PSO,PSO1,PSO2,PSO3,PSO4,PSOC,PSOLN,PSONAME,PSONO,PSOT,R,VAERR,XMDUZ,XMSUB,XMTEXT,Y,^TMP($JOB),^TMP("PSO",$JOB)
QUIT
+1 QUIT
+2 ;
FACILITY ;Enter facility DEA number to set up clozapine system
+1 ;this entry point is no longer used. this functionality was taken over
+2 ;by the mental health package with the release of YS*5.01*18
+3 ;W ! S DIC=59,DIC(0)="AEQM",DIC("A")="Select site to participate in clozapine program : " D ^DIC G END:Y<0
+4 ;S DIE=DIC,DA=+Y,DR="1R;2R;" L +^PS(59,DA) D ^DIE L -^PS(59,DA) G FACILITY
+5 QUIT
+6 ;
+7 ;
AGAIN ; re-enter patient - new number, status and provider
+1 SET DIC=55
SET DIC(0)="AEQM"
SET DIC("A")="Select clozapine patient : "
DO ^DIC
KILL DIC
IF Y<0
GOTO END
SET DA=+Y
SET PSO1=DA
SET PSONAME=$PIECE(^DPT(DA,0),"^")
+2 IF $PIECE($GET(^PS(55,DA,"SAND")),"^")=""
WRITE !,PSONAME_" is not registered. Use the register option."
GOTO AGAIN
+3 IF '$DATA(^YSCL(603.01,"C",PSO1))
WRITE !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization."
DO OVER
IF '$GET(%)
GOTO AGAIN
SET JADOVER=""
+4 SET DIR(0)="55,53"
DO ^DIR
IF $DATA(DIRUT)
GOTO END
SET PSO2=Y
IF $DATA(^PS(55,"ASAND1",PSO2))
IF $ORDER(^(PSO2,0))'=PSO1
WRITE !,PSO2," already assigned to ",$PIECE(^DPT($ORDER(^(0)),0),"^")
GOTO END
+5 IF '$DATA(JADOVER)
IF '$DATA(^YSCL(603.01,"B",PSO2))
WRITE !!,"The NCCC in Dallas has not authorized "_PSO2_" for usage",!,"at this facility. Contact the NCCC in Dallas for authorization."
DO OVER
IF '$GET(%)
GOTO END
+6 ;S DIR(0)="55,54" D ^DIR G END:$D(DIRUT) S PSO3=Y
+7 SET PSO3=$PIECE(^PS(55,DA,"SAND"),"^",2)
+8 WRITE !,$PIECE(^DD(55,54,0),"^")_": "_$SELECT(PSO3="A":"ACTIVE TREATMENT",PSO3="D":"DISCONTINUED",PSO3="H":"TREATMENT ON HOLD",1:"PRE-TREATMENT")
PHY1 ;
+1 SET PSO4=$PIECE(^PS(55,DA,"SAND"),"^",5)
SET DIR(0)="55,57"
DO ^DIR
IF $DATA(DIRUT)
GOTO END
IF Y
SET PSO4=+Y
+2 IF $PIECE($GET(^VA(200,PSO4,"PS")),"^",2)=""
WRITE !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
GOTO PHY1
+3 GOTO SAVE
+4 ;
OVER ;allow registration of patients and clozapine numbers not yet authorized by the NCCC.
+1 KILL DIR
WRITE !
SET DIR("A")="Do you want to over-ride this warning"
SET DIR(0)="Y"
SET DIR("B")="No"
DO ^DIR
+2 IF Y
Begin DoDot:1
+3 QUIT
SET YSCLDATA(1)="An over-ride was authorize at "_$GET(DUZ(2))_" for "_$SELECT($DATA(PSONAME):PSONAME,1:$GET(PSO2))_" by "_$PIECE($GET(^VA(200,DUZ,0)),"^")
+4 SET %H=$HOROLOG
DO YMD^%DTC
SET XMDUN="NCC LOGGER"
SET XMDUZ=.5
SET XMSUB=$GET(DUZ(2))_" NCC ENROLLER ("_X_%_")"
SET XMTEXT="YSCLDATA("
SET XMY("G.CLOZAPINE ROLL-UP@FORUM.VA.GOV")=""
+5 DO ^XMD
KILL XMDUN,XMDUZ,XMER,XMREC,XRG,XMSUB,XMTEXT,XMY,XMZ,YSCLDATA
End DoDot:1
SET %=1
+6 KILL DIR,DIRUT,DUOUT
QUIT
