YSCLTST3 ;DALOI/LB/RLM-TRANSMISSION FOR CLOZAPINE REPORTING SYSTEM ; 11/27/18 5:17pm
;;5.01;MENTAL HEALTH;**18,22,25,26,47,61,69,74,90,122**;Dec 30, 1994;Build 112
; Reference to ^DPT supported by IA #10035
; Reference to ^PS(55 supported by IA #787
; Reference to ^PS(59 supported by IA #783
; Reference to ^VA(200 supported by IA #10060
; Reference to ^LAB(60 supported by IA #333
; Reference to ^XMD supported by IA #10070
; Reference to ^DIC supported by DBIA #2051
; Reference to ^DIE supported by DBIA #2053
; Reference to ^DIQ supported by DBIA #2056
; Reference to ^DIR supported by DBIA #10026
; Reference to ^VADPT supported by DBIA #10061
; Reference to $$SITE^VASITE supported by DBIA #10112
; Reference to ^XLFDT supported by DBIA #10103
; Reference to ^%ZTLOAD supported by DBIA #10063
; Reference to ^%DT supported by DBIA #10003
;
DEMOG ; Old entry point to send demographic data for patients from task. Obsolete
Q
DMG ; Called by YSCLTEST
S YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
K ^TMP($J),^TMP("YSCL",$J),^TMP("YSCLL",$J) S YSCLLN=0,YSCLNO=20,DFN=0,YSCLIEN=0
N ARRAY D LIST^DIC(603.01,,1,"I",,,,,,,"ARRAY")
F I=1:1 Q:'$D(ARRAY("DILIST",2,I)) K YSCLA S YSCLIEN=ARRAY("DILIST",2,I) D
.S DFN=ARRAY("DILIST","ID",I,1),$P(YSSTOP,",",8)=8 Q:$$S^%ZTLOAD!'DFN
.I $L($$GET1^DIQ(2,DFN,.01)) S YSCLC=$$GET1^DIQ(603.01,YSCLIEN,.01) D GET
D TRANSMIT:YSCLLN G END
;
GET ;
S $P(YSSTOP,",",9)=9 Q:$$S^%ZTLOAD
Q:'$L($$GET1^DIQ(55,DFN,53)) ;Don't try to transmit if no pharmacy record
Q:$$GET1^DIQ(55,DFN,56,"I") ;Don't retransmit demographics.
Q:$D(^TMP("YSCLL",$J,DFN))
S ^TMP("YSCLL",$J,DFN)=1
S YSCLP=$$GET1^DIQ(55,DFN,57,"I"),YSCLDEA=$$GET1^DIQ(200,YSCLP,53.2),YSCLP=$$GET1^DIQ(200,YSCLP,.01)
D DEM^VADPT,ADD^VADPT S YSCL=YSCLC_"^"_$E($P(VADM(1),",",2))_$E(VADM(1))_"^"_$P(VADM(3),"^")_"^"_$P(VADM(2),"^")_"^"_$P(VADM(5),"^")_"^"_VAPA(6)_"^"_DT
D
.S YSRACE="*"
.S YSRC=0 F S YSRC=$O(VADM(11,YSRC)) Q:'YSRC S YSRACE=YSRACE_+VADM(11,YSRC)_"-"_+VADM(11,YSRC,1)_","
.S YSRACE=YSRACE_"~"
.S YSRC=0 F S YSRC=$O(VADM(12,YSRC)) Q:'YSRC S YSRACE=YSRACE_+VADM(12,YSRC)_"-"_+VADM(12,YSRC,1)_","
S YSCL=YSCL_"^"_YSRACE_"^"_YSCLP_"^"_YSCLDEA
; YSCLJ containing a ZIP code
N ARRAY59 D LIST^DIC(59,,"1;.05",,,,,,,,"ARRAY59")
F YSCLJ=1:1 Q:'$D(ARRAY59("DILIST","ID",YSCLJ)) I ARRAY59("DILIST","ID",YSCLJ,1)'="" S YSCLJ=ARRAY59("DILIST","ID",YSCLJ,.05) Q
S YSCL=YSCL_"^"_YSCLJ
;registration number^initials^dob^ssn^sex^zip^today^race^physician^dea^zip code (hosp)
S YSCLLN=YSCLLN+1,^TMP($J,YSCLLN,0)=YSCL
I VADM(5)=""!(VAPA(6)="")!('VADM(11))!('VADM(12)) D ;RLM RACETEST
.S ^TMP("YSCL",$J,YSCLNO,0)=$P(VADM(2),"^",1)_" "_VADM(1)
.S:VADM(5)="" ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (SEX)"
.S:VAPA(6)="" ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (ZIP)"
.S:'VADM(12) ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (RACE, NEW FORMAT)"
.S:'VADM(11) ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (ETHNICITY)"
.S YSCLNO=YSCLNO+1
.S ^TMP("YSCLL",$J,DFN)=0 ; leave unmarked pending demographic data
.I ('VADM(11))!('VADM(12)) D
..S ^TMP("YSCL",$J,YSCLNO,0)="NOTE: Race and Ethnicity may be entered if permission is obtained in the informed consent",YSCLNO=YSCLNO+1
..S ^TMP("YSCL",$J,YSCLNO,0)="document. See VHA Directive 99-035.",YSCLNO=YSCLNO+1
;
Q
;
TRANSMIT ; remote and local messages
S $P(YSSTOP,",",10)=10 Q:$$S^%ZTLOAD
S YSDEBUG=$$GET1^DIQ(603.03,1,3,"I"),YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
S YSPRODST=$$GET1^DIQ(603.03,1,9) ;S:YSPRODST="" YSPRODST="S.RUCLDEM@FO-HINES.DOMAIN.EXT"
S YSDBGST=$$GET1^DIQ(603.03,1,11) ;S:YSDBGST="" YSDBGST="G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT"
;/RBN - Begin modifications for YS*5.01*122
I YSCLLN D
.I YSPROD D
..I 'YSDEBUG S XMY(YSPRODST)="" ;XMY("G.CLOZAPINE ROLL-UP")="" ;,
..E S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")="",XMY("G.RUCLDEM@FO-DALLAS.DOMAIN.EXT")=""
.E D
..I 'YSDEBUG S XMY(YSDBGST)=""
..E S XMY("G.CLOZAPINE DEBUG")=""
.S XMDUZ="CLOZAPINE MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine demographics" D ^XMD
.N DIE,DA,DR S DIE="^YSCL(603.03,",DA=1,DR="6///"_$$NOW^XLFDT D ^DIE
K XMY
I 'YSDEBUG S XMY("G.PSOCLOZ")="" S:YSPROD XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
E S XMY("G.CLOZAPINE DEBUG")="" S:YSPROD XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
S XMDUZ="CLOZAPINE MONITOR",XMTEXT="^TMP($J,"
S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine demographics",^TMP("YSCL",$J,2,0)=" "
S ^TMP("YSCL",$J,1,0)="Clozapine demographic data was transmitted, "_YSCLLN_" records were sent.",XMTEXT="^TMP(""YSCL"",$J,"
I $O(^TMP("YSCL",$J,10)) S ^TMP("YSCL",$J,3,0)="For the following patients, one or more of the required data",^TMP("YSCL",$J,4,0)="elements (race, sex, ZIP code) were missing.",^TMP("YSCL",$J,5,0)=" "
I S ^TMP("YSCL",$J,6,0)="Please have this information entered.",^TMP("YSCL",$J,7,0)="The available data was transmitted.",^TMP("YSCL",$J,8,0)=" "
D ^XMD
; set transmitted field in 55 from ^TMP("YSCLL",$J)
F DFN=0:0 S DFN=$O(^TMP("YSCLL",$J,DFN)) Q:'DFN I ^TMP("YSCLL",$J,DFN) S DIE="^PS(55,",DA=DFN,DR="56///1" D ^DIE
Q
;
FLERR ;
K XMY
;/RBN - Begin modifications for YS*5.01*122
X ^%ZOSF("UCI") I Y=^%ZOSF("PROD") D
.S XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
.I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
I Y'=^%ZOSF("PROD") D
.S XMY("G.CLOZAPINE ROLL-UP")=""
.I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG")=""
;/RBN - End modifications for YS*5.01*122
S %DT="T",X="NOW" D ^%DT S YSCLNOW=$P(Y,".",2)
S YSCLSITE=$P($$SITE^VASITE,"^",2)
S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data error at "_YSCLSITE_" on "_DT_" at "_YSCLNOW,^TMP("YSCL",$J,1,0)=" "
S ^TMP("YSCL",$J,2,0)="### Clozapine data error at "_YSCLSITE_" on "_DT_" +++"
S ^TMP("YSCL",$J,3,0)=" Clozapine Lab Test file not properly defined."
S ^TMP("YSCL",$J,4,0)=" Data cannot be transmitted!"
S XMTEXT="^TMP(""YSCL"",$J,",XMDUZ="Clozapine MONITOR" D ^XMD
G END^YSCLTST2
Q
TLIST ;
I '$D(^YSCL(603.04)) W !,"Patch YS*5.01*90 not properly installed. Contact IRM" S DIR(0)="E" D ^DIR Q
W !,"Currently linked Tests:" I '$O(^YSCL(603.04,1,1,0)) W !,"No tests linked",!
S YSCLA=0
F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA S YSCLB=^YSCL(603.04,1,1,YSCLA,0) D
. W !,$P(^LAB(60,$P(YSCLB,"^"),0),"^")," represents " S YSCLB=$P(YSCLB,"^",2)
. W $S(YSCLB="W":"WHITE BLOOD COUNT",YSCLB="A":"ABSOLUTE NEUTROPHIL COUNT",YSCLB="N":"NEUTROPHIL PERCENT",YSCLB="S":"SEGS %",YSCLB="B":"BANDS %",YSCLB="T":"BANDS ABSOLUTE",YSCLB="C":"SEGS ABSOLUTE",1:"Bad Record")
F K DIR S DIR(0)="PA^60:EMZ",DIR("A")="Enter the name of the test for Clozapine: " W ! D ^DIR Q:Y="^"!($D(DTOUT))!($D(DUOUT)) S YSCLTST=+Y D Q:Y="^"!($D(DTOUT))!($D(DUOUT))
. I $D(^YSCL(603.04,1,1,"B",YSCLTST)) G TEXIST
. K DIR S DIR(0)="SA^W:WHITE BLOOD COUNT;A:ABSOLUTE NEUTROPHIL COUNT;N:NEUTROPHIL PERCENT;S:SEGS %;B:BANDS %;T:BANDS ABSOLUTE;C:SEGS ABSOLUTE"
. S DIR("A")="Enter the type of the test for Clozapine: " D ^DIR Q:Y["^"!($D(DTOUT))!($D(DUOUT)) S YSCLTS1=Y
. K DIR S DIR(0)="SA^0:uL;1:K/uL;2:Percent"
. S DIR("A")="Enter the reporting method of the test for Clozapine: " D ^DIR Q:Y["^"!($D(DTOUT))!($D(DUOUT)) S YSCLTS2=Y
. K YSCLERR
. D VAL^DIE(603.41,"+1,1,",.01,"F","`"_YSCLTST,.YSCLRES,"FDA","YSCLERR")
. I $D(YSCLERR) W !,"There was a problem with the data, please re-enter it" Q
. D VAL^DIE(603.41,"+1,1,",1,"F",YSCLTS1,.YSCLRES,"FDA","YSCLERR")
. I $D(YSCLERR) W !,"There was a problem with the data, please re-enter it" Q
. D VAL^DIE(603.41,"+1,1,",2,"F",YSCLTS2,.YSCLRES,"FDA","YSCLERR")
. I $D(YSCLERR) W !,"There was a problem with the data, please re-enter it" Q
. D UPDATE^DIE(,"FDA",,"ERROR")
. I $D(YSCLERR) W !,"There was a problem with the data, please re-enter it" Q
Q
TEXIST ;
W !,"This entry already exists. Do you wish to delete it?" K DIR S DIR(0)="Y" D ^DIR Q:'Y!($D(DTOUT))!($D(DUOUT))
S DA(1)=1,DA=$O(^YSCL(603.04,1,1,"B",YSCLTST,"")),DIE="^YSCL(603.04,1,1,",DR=".01////@" D ^DIE W !,"Deleted" S Y="" Q
Q
END K %,C,D,DA,DFN,DISYS,DR,I,R,VADM,VAPA,VAERR,Y,YSCL,YSCL1,YSCL2,YSCLC,YSCLDEA,YSCLJ,YSCLLN,YSCLNAME,YSCLNO,YSCLP,^TMP($J),^TMP("YSCL",$J),^TMP("YSCLL",$J) Q
Q
END1 ;
K ^TMP($J),^TMP("YSCL",$J)
K %,%DT,%H,%T,AGE,C,CNT,D,DA,DFN,DIE,DIK,DIR,DIROUT,DIRUT,DISYS,DOB,DR
K DRG,DTOUT,DUOUT,I,IOF,J,K,LAB,LABT,PNM,POP,R,RESULTS1,SEX,SSN,VADM,VAERR,VAPA
K X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,YSACT,YSCL,YSCL1,YSCL2,YSCL28,YSCLA,YSCLA1,YSCLAB
K YSCLAB1,YSCLAB2,YSCLAB3,YSCLAB4,YSCLC,YSCLD,YSCLD0,YSCLD1,YSCLDAT1
K YSCLDATA,YSCLDEA,YSCLDEMO,YSCLED,YSCLF,YSCLFF,YSCLFRQ,YSCLGL,YSCLGRN,YSCLI
K YSCLID,YSCLIED,YSCLIEN,YSCLIF,YSCLJ,YSCLLAB,YSCLLD,YSCLLDFN,YSCLLDN
K YSCLLDT,YSCLLK,YSCLLLN,YSCLLN,YSCLLO,YSCLM180,YSCLM28,YSCLM56,YSCLM7,YSCLMTCH,YSCLNAME
K YSCLNO,YSCLNOW,YSCLNST1,YSCLNSTE,YSCLOVR,YSCLP,YSCLPHY,YSCLR,YSCLRES,YSCLRET,YSCLRWBC,YSCLRX
K YSCLRX2,YSCLSAND,YSCLSB1,YSCLSD,YSCLSGS,YSCLSITE,YSCLSN,YSCLSP,YSCLT,YSCLTA,YSCLTDT,YSCLTEST
K YSCLTL,YSCLTPT,YSCLTLS,YSCLTLS1,YSCLTS1,YSCLTST,YSCLTYPE,YSCLWBC,YSCLWBCC
K YSCLWBCT,YSCLX,YSCLZ2,YSDEBUG,YSOFF,YSRACE,YSRC,YSSTOP,YSTEXT,ZTDESC
K ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSTOP
Q
ZEOR ;YSCLTST3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLTST3 9372 printed Dec 13, 2024@02:13:55 Page 2
YSCLTST3 ;DALOI/LB/RLM-TRANSMISSION FOR CLOZAPINE REPORTING SYSTEM ; 11/27/18 5:17pm
+1 ;;5.01;MENTAL HEALTH;**18,22,25,26,47,61,69,74,90,122**;Dec 30, 1994;Build 112
+2 ; Reference to ^DPT supported by IA #10035
+3 ; Reference to ^PS(55 supported by IA #787
+4 ; Reference to ^PS(59 supported by IA #783
+5 ; Reference to ^VA(200 supported by IA #10060
+6 ; Reference to ^LAB(60 supported by IA #333
+7 ; Reference to ^XMD supported by IA #10070
+8 ; Reference to ^DIC supported by DBIA #2051
+9 ; Reference to ^DIE supported by DBIA #2053
+10 ; Reference to ^DIQ supported by DBIA #2056
+11 ; Reference to ^DIR supported by DBIA #10026
+12 ; Reference to ^VADPT supported by DBIA #10061
+13 ; Reference to $$SITE^VASITE supported by DBIA #10112
+14 ; Reference to ^XLFDT supported by DBIA #10103
+15 ; Reference to ^%ZTLOAD supported by DBIA #10063
+16 ; Reference to ^%DT supported by DBIA #10003
+17 ;
DEMOG ; Old entry point to send demographic data for patients from task. Obsolete
+1 QUIT
DMG ; Called by YSCLTEST
+1 SET YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
+2 KILL ^TMP($JOB),^TMP("YSCL",$JOB),^TMP("YSCLL",$JOB)
SET YSCLLN=0
SET YSCLNO=20
SET DFN=0
SET YSCLIEN=0
+3 NEW ARRAY
DO LIST^DIC(603.01,,1,"I",,,,,,,"ARRAY")
+4 FOR I=1:1
if '$DATA(ARRAY("DILIST",2,I))
QUIT
KILL YSCLA
SET YSCLIEN=ARRAY("DILIST",2,I)
Begin DoDot:1
+5 SET DFN=ARRAY("DILIST","ID",I,1)
SET $PIECE(YSSTOP,",",8)=8
if $$S^%ZTLOAD!'DFN
QUIT
+6 IF $LENGTH($$GET1^DIQ(2,DFN,.01))
SET YSCLC=$$GET1^DIQ(603.01,YSCLIEN,.01)
DO GET
End DoDot:1
+7 if YSCLLN
DO TRANSMIT
GOTO END
+8 ;
GET ;
+1 SET $PIECE(YSSTOP,",",9)=9
if $$S^%ZTLOAD
QUIT
+2 ;Don't try to transmit if no pharmacy record
if '$LENGTH($$GET1^DIQ(55,DFN,53))
QUIT
+3 ;Don't retransmit demographics.
if $$GET1^DIQ(55,DFN,56,"I")
QUIT
+4 if $DATA(^TMP("YSCLL",$JOB,DFN))
QUIT
+5 SET ^TMP("YSCLL",$JOB,DFN)=1
+6 SET YSCLP=$$GET1^DIQ(55,DFN,57,"I")
SET YSCLDEA=$$GET1^DIQ(200,YSCLP,53.2)
SET YSCLP=$$GET1^DIQ(200,YSCLP,.01)
+7 DO DEM^VADPT
DO ADD^VADPT
SET YSCL=YSCLC_"^"_$EXTRACT($PIECE(VADM(1),",",2))_$EXTRACT(VADM(1))_"^"_$PIECE(VADM(3),"^")_"^"_$PIECE(VADM(2),"^")_"^"_$PIECE(VADM(5),"^")_"^"_VAPA(6)_"^"_DT
+8 Begin DoDot:1
+9 SET YSRACE="*"
+10 SET YSRC=0
FOR
SET YSRC=$ORDER(VADM(11,YSRC))
if 'YSRC
QUIT
SET YSRACE=YSRACE_+VADM(11,YSRC)_"-"_+VADM(11,YSRC,1)_","
+11 SET YSRACE=YSRACE_"~"
+12 SET YSRC=0
FOR
SET YSRC=$ORDER(VADM(12,YSRC))
if 'YSRC
QUIT
SET YSRACE=YSRACE_+VADM(12,YSRC)_"-"_+VADM(12,YSRC,1)_","
End DoDot:1
+13 SET YSCL=YSCL_"^"_YSRACE_"^"_YSCLP_"^"_YSCLDEA
+14 ; YSCLJ containing a ZIP code
+15 NEW ARRAY59
DO LIST^DIC(59,,"1;.05",,,,,,,,"ARRAY59")
+16 FOR YSCLJ=1:1
if '$DATA(ARRAY59("DILIST","ID",YSCLJ))
QUIT
IF ARRAY59("DILIST","ID",YSCLJ,1)'=""
SET YSCLJ=ARRAY59("DILIST","ID",YSCLJ,.05)
QUIT
+17 SET YSCL=YSCL_"^"_YSCLJ
+18 ;registration number^initials^dob^ssn^sex^zip^today^race^physician^dea^zip code (hosp)
+19 SET YSCLLN=YSCLLN+1
SET ^TMP($JOB,YSCLLN,0)=YSCL
+20 ;RLM RACETEST
IF VADM(5)=""!(VAPA(6)="")!('VADM(11))!('VADM(12))
Begin DoDot:1
+21 SET ^TMP("YSCL",$JOB,YSCLNO,0)=$PIECE(VADM(2),"^",1)_" "_VADM(1)
+22 if VADM(5)=""
SET ^TMP("YSCL",$JOB,YSCLNO,0)=^TMP("YSCL",$JOB,YSCLNO,0)_" (SEX)"
+23 if VAPA(6)=""
SET ^TMP("YSCL",$JOB,YSCLNO,0)=^TMP("YSCL",$JOB,YSCLNO,0)_" (ZIP)"
+24 if 'VADM(12)
SET ^TMP("YSCL",$JOB,YSCLNO,0)=^TMP("YSCL",$JOB,YSCLNO,0)_" (RACE, NEW FORMAT)"
+25 if 'VADM(11)
SET ^TMP("YSCL",$JOB,YSCLNO,0)=^TMP("YSCL",$JOB,YSCLNO,0)_" (ETHNICITY)"
+26 SET YSCLNO=YSCLNO+1
+27 ; leave unmarked pending demographic data
SET ^TMP("YSCLL",$JOB,DFN)=0
+28 IF ('VADM(11))!('VADM(12))
Begin DoDot:2
+29 SET ^TMP("YSCL",$JOB,YSCLNO,0)="NOTE: Race and Ethnicity may be entered if permission is obtained in the informed consent"
SET YSCLNO=YSCLNO+1
+30 SET ^TMP("YSCL",$JOB,YSCLNO,0)="document. See VHA Directive 99-035."
SET YSCLNO=YSCLNO+1
End DoDot:2
End DoDot:1
+31 ;
+32 QUIT
+33 ;
TRANSMIT ; remote and local messages
+1 SET $PIECE(YSSTOP,",",10)=10
if $$S^%ZTLOAD
QUIT
+2 SET YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
SET YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
+3 ;S:YSPRODST="" YSPRODST="S.RUCLDEM@FO-HINES.DOMAIN.EXT"
SET YSPRODST=$$GET1^DIQ(603.03,1,9)
+4 ;S:YSDBGST="" YSDBGST="G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT"
SET YSDBGST=$$GET1^DIQ(603.03,1,11)
+5 ;/RBN - Begin modifications for YS*5.01*122
+6 IF YSCLLN
Begin DoDot:1
+7 IF YSPROD
Begin DoDot:2
+8 ;XMY("G.CLOZAPINE ROLL-UP")="" ;,
IF 'YSDEBUG
SET XMY(YSPRODST)=""
+9 IF '$TEST
SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
SET XMY("G.RUCLDEM@FO-DALLAS.DOMAIN.EXT")=""
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 IF 'YSDEBUG
SET XMY(YSDBGST)=""
+12 IF '$TEST
SET XMY("G.CLOZAPINE DEBUG")=""
End DoDot:2
+13 SET XMDUZ="CLOZAPINE MONITOR"
SET XMTEXT="^TMP($J,"
SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",1:"")_"Clozapine demographics"
DO ^XMD
+14 NEW DIE,DA,DR
SET DIE="^YSCL(603.03,"
SET DA=1
SET DR="6///"_$$NOW^XLFDT
DO ^DIE
End DoDot:1
+15 KILL XMY
+16 IF 'YSDEBUG
SET XMY("G.PSOCLOZ")=""
if YSPROD
SET XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
+17 IF '$TEST
SET XMY("G.CLOZAPINE DEBUG")=""
if YSPROD
SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
+18 SET XMDUZ="CLOZAPINE MONITOR"
SET XMTEXT="^TMP($J,"
+19 SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",1:"")_"Clozapine demographics"
SET ^TMP("YSCL",$JOB,2,0)=" "
+20 SET ^TMP("YSCL",$JOB,1,0)="Clozapine demographic data was transmitted, "_YSCLLN_" records were sent."
SET XMTEXT="^TMP(""YSCL"",$J,"
+21 IF $ORDER(^TMP("YSCL",$JOB,10))
SET ^TMP("YSCL",$JOB,3,0)="For the following patients, one or more of the required data"
SET ^TMP("YSCL",$JOB,4,0)="elements (race, sex, ZIP code) were missing."
SET ^TMP("YSCL",$JOB,5,0)=" "
+22 IF $TEST
SET ^TMP("YSCL",$JOB,6,0)="Please have this information entered."
SET ^TMP("YSCL",$JOB,7,0)="The available data was transmitted."
SET ^TMP("YSCL",$JOB,8,0)=" "
+23 DO ^XMD
+24 ; set transmitted field in 55 from ^TMP("YSCLL",$J)
+25 FOR DFN=0:0
SET DFN=$ORDER(^TMP("YSCLL",$JOB,DFN))
if 'DFN
QUIT
IF ^TMP("YSCLL",$JOB,DFN)
SET DIE="^PS(55,"
SET DA=DFN
SET DR="56///1"
DO ^DIE
+26 QUIT
+27 ;
FLERR ;
+1 KILL XMY
+2 ;/RBN - Begin modifications for YS*5.01*122
+3 XECUTE ^%ZOSF("UCI")
IF Y=^%ZOSF("PROD")
Begin DoDot:1
+4 SET XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
+5 IF YSDEBUG
KILL XMY
SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
End DoDot:1
+6 IF Y'=^%ZOSF("PROD")
Begin DoDot:1
+7 SET XMY("G.CLOZAPINE ROLL-UP")=""
+8 IF YSDEBUG
KILL XMY
SET XMY("G.CLOZAPINE DEBUG")=""
End DoDot:1
+9 ;/RBN - End modifications for YS*5.01*122
+10 SET %DT="T"
SET X="NOW"
DO ^%DT
SET YSCLNOW=$PIECE(Y,".",2)
+11 SET YSCLSITE=$PIECE($$SITE^VASITE,"^",2)
+12 SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data error at "_YSCLSITE_" on "_DT_" at "_YSCLNOW
SET ^TMP("YSCL",$JOB,1,0)=" "
+13 SET ^TMP("YSCL",$JOB,2,0)="### Clozapine data error at "_YSCLSITE_" on "_DT_" +++"
+14 SET ^TMP("YSCL",$JOB,3,0)=" Clozapine Lab Test file not properly defined."
+15 SET ^TMP("YSCL",$JOB,4,0)=" Data cannot be transmitted!"
+16 SET XMTEXT="^TMP(""YSCL"",$J,"
SET XMDUZ="Clozapine MONITOR"
DO ^XMD
+17 GOTO END^YSCLTST2
+18 QUIT
TLIST ;
+1 IF '$DATA(^YSCL(603.04))
WRITE !,"Patch YS*5.01*90 not properly installed. Contact IRM"
SET DIR(0)="E"
DO ^DIR
QUIT
+2 WRITE !,"Currently linked Tests:"
IF '$ORDER(^YSCL(603.04,1,1,0))
WRITE !,"No tests linked",!
+3 SET YSCLA=0
+4 FOR
SET YSCLA=$ORDER(^YSCL(603.04,1,1,YSCLA))
if 'YSCLA
QUIT
SET YSCLB=^YSCL(603.04,1,1,YSCLA,0)
Begin DoDot:1
+5 WRITE !,$PIECE(^LAB(60,$PIECE(YSCLB,"^"),0),"^")," represents "
SET YSCLB=$PIECE(YSCLB,"^",2)
+6 WRITE $SELECT(YSCLB="W":"WHITE BLOOD COUNT",YSCLB="A":"ABSOLUTE NEUTROPHIL COUNT",YSCLB="N":"NEUTROPHIL PERCENT",YSCLB="S":"SEGS %",YSCLB="B":"BANDS %",YSCLB="T":"BANDS ABSOLUTE",YSCLB="C":"SEGS ABSOLUTE",1:"Bad Record")
End DoDot:1
+7 FOR
KILL DIR
SET DIR(0)="PA^60:EMZ"
SET DIR("A")="Enter the name of the test for Clozapine: "
WRITE !
DO ^DIR
if Y="^"!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
SET YSCLTST=+Y
Begin DoDot:1
+8 IF $DATA(^YSCL(603.04,1,1,"B",YSCLTST))
GOTO TEXIST
+9 KILL DIR
SET DIR(0)="SA^W:WHITE BLOOD COUNT;A:ABSOLUTE NEUTROPHIL COUNT;N:NEUTROPHIL PERCENT;S:SEGS %;B:BANDS %;T:BANDS ABSOLUTE;C:SEGS ABSOLUTE"
+10 SET DIR("A")="Enter the type of the test for Clozapine: "
DO ^DIR
if Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
SET YSCLTS1=Y
+11 KILL DIR
SET DIR(0)="SA^0:uL;1:K/uL;2:Percent"
+12 SET DIR("A")="Enter the reporting method of the test for Clozapine: "
DO ^DIR
if Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
SET YSCLTS2=Y
+13 KILL YSCLERR
+14 DO VAL^DIE(603.41,"+1,1,",.01,"F","`"_YSCLTST,.YSCLRES,"FDA","YSCLERR")
+15 IF $DATA(YSCLERR)
WRITE !,"There was a problem with the data, please re-enter it"
QUIT
+16 DO VAL^DIE(603.41,"+1,1,",1,"F",YSCLTS1,.YSCLRES,"FDA","YSCLERR")
+17 IF $DATA(YSCLERR)
WRITE !,"There was a problem with the data, please re-enter it"
QUIT
+18 DO VAL^DIE(603.41,"+1,1,",2,"F",YSCLTS2,.YSCLRES,"FDA","YSCLERR")
+19 IF $DATA(YSCLERR)
WRITE !,"There was a problem with the data, please re-enter it"
QUIT
+20 DO UPDATE^DIE(,"FDA",,"ERROR")
+21 IF $DATA(YSCLERR)
WRITE !,"There was a problem with the data, please re-enter it"
QUIT
End DoDot:1
if Y="^"!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+22 QUIT
TEXIST ;
+1 WRITE !,"This entry already exists. Do you wish to delete it?"
KILL DIR
SET DIR(0)="Y"
DO ^DIR
if 'Y!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+2 SET DA(1)=1
SET DA=$ORDER(^YSCL(603.04,1,1,"B",YSCLTST,""))
SET DIE="^YSCL(603.04,1,1,"
SET DR=".01////@"
DO ^DIE
WRITE !,"Deleted"
SET Y=""
QUIT
+3 QUIT
END KILL %,C,D,DA,DFN,DISYS,DR,I,R,VADM,VAPA,VAERR,Y,YSCL,YSCL1,YSCL2,YSCLC,YSCLDEA,YSCLJ,YSCLLN,YSCLNAME,YSCLNO,YSCLP,^TMP($JOB),^TMP("YSCL",$JOB),^TMP("YSCLL",$JOB)
QUIT
+1 QUIT
END1 ;
+1 KILL ^TMP($JOB),^TMP("YSCL",$JOB)
+2 KILL %,%DT,%H,%T,AGE,C,CNT,D,DA,DFN,DIE,DIK,DIR,DIROUT,DIRUT,DISYS,DOB,DR
+3 KILL DRG,DTOUT,DUOUT,I,IOF,J,K,LAB,LABT,PNM,POP,R,RESULTS1,SEX,SSN,VADM,VAERR,VAPA
+4 KILL X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,YSACT,YSCL,YSCL1,YSCL2,YSCL28,YSCLA,YSCLA1,YSCLAB
+5 KILL YSCLAB1,YSCLAB2,YSCLAB3,YSCLAB4,YSCLC,YSCLD,YSCLD0,YSCLD1,YSCLDAT1
+6 KILL YSCLDATA,YSCLDEA,YSCLDEMO,YSCLED,YSCLF,YSCLFF,YSCLFRQ,YSCLGL,YSCLGRN,YSCLI
+7 KILL YSCLID,YSCLIED,YSCLIEN,YSCLIF,YSCLJ,YSCLLAB,YSCLLD,YSCLLDFN,YSCLLDN
+8 KILL YSCLLDT,YSCLLK,YSCLLLN,YSCLLN,YSCLLO,YSCLM180,YSCLM28,YSCLM56,YSCLM7,YSCLMTCH,YSCLNAME
+9 KILL YSCLNO,YSCLNOW,YSCLNST1,YSCLNSTE,YSCLOVR,YSCLP,YSCLPHY,YSCLR,YSCLRES,YSCLRET,YSCLRWBC,YSCLRX
+10 KILL YSCLRX2,YSCLSAND,YSCLSB1,YSCLSD,YSCLSGS,YSCLSITE,YSCLSN,YSCLSP,YSCLT,YSCLTA,YSCLTDT,YSCLTEST
+11 KILL YSCLTL,YSCLTPT,YSCLTLS,YSCLTLS1,YSCLTS1,YSCLTST,YSCLTYPE,YSCLWBC,YSCLWBCC
+12 KILL YSCLWBCT,YSCLX,YSCLZ2,YSDEBUG,YSOFF,YSRACE,YSRC,YSSTOP,YSTEXT,ZTDESC
+13 KILL ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSTOP
+14 QUIT
ZEOR ;YSCLTST3
