YSCLTST2 ;DALOI/LB/RLM - TRANSMIT RX AND LAB DATA FOR CLOZAPINE ; Nov 11, 2018@03:34
;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122,166,193,227**;Dec 30, 1994;Build 17
;
; Reference to ^LAB(60 supported by IA #333
; Reference to ^PSDRUG supported by IA #25
; Reference to ^PS(55 supported by IA #787
; Reference to ^XMD supported by IA #10070
; Reference to ^LR7OR1 supported by IA #2503
; 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 $$SITE^VASITE supported by DBIA #10112
; Reference to ^XLFDT supported by DBIA #10103
; Reference to MIX^DIC1 supported by DBIA #10007
; Reference to ^%ZTLOAD supported by DBIA #10063
; Reference to ^%DTC supported by DBIA #10000
; Reference to ^%DT supported by DBIA #10003
; Reference to PSS^PSS781 supported by DBIA #4480
; Reference to $$GETREGYS^PSOCLUTL supported by DBIA #7314
;
TRANSMIT ; send remote and local, kill and quit
K XMZ S %DT="T",X="NOW" D ^%DT S YSCLNOW=$P(Y,".",2),YSCLSITE=$P($$SITE^VASITE,"^",2)
S $P(YSSTOP,",",7)=7 I $$S^%ZTLOAD D ABORT^YSCLTEST G END
S YSDEBUG=$$GET1^DIQ(603.03,1,3,"I"),YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
S YSPRODST=$$GET1^DIQ(603.03,1,8) ;S:YSPRODST="" YSPRODST="S.RUCLRXLAB@FO-HINES.DOMAIN.EXT"
S YSDBGST=$$GET1^DIQ(603.03,1,10) ;S:YSDBGST="" YSDBGST="G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT"
;/RBN - Begin modifications for YS*5.01*122
I $G(YSCLLN) D
.K XMY
.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.RUCLRXLAB@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 lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW D ^XMD
K XMY
S ^TMP("YSCL",$J,2,0)=" ",^TMP("YSCL",$J,3,0)="In message # "_$S($D(XMZ):XMZ,1:"no data sent")
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 XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW
K XMZ S ^TMP("YSCL",$J,1,0)="Clozapine lab data was transmitted, "_YSCLLN_" records were sent",XMTEXT="^TMP(""YSCL"",$J," D ^XMD
S DIE="^YSCL(603.03,",DA=1,DR="5////"_$$NOW^XLFDT D ^DIE ;S $P(^YSCL(603.03,1,0),"^",5)=$$NOW^XLFDT
;/RBN - End modifications for YS*5.01*122
END ;
G END1^YSCLTST3
Q
;
REXMIT ; retransmit lab and RX data
; must be a tuesday
S DIR(0)="Y",DIR("A")="Are you sure you wish to retransmit lab data"
D ^DIR K DIR I Y'=1 K Y Q
;/RBN Begin modification for YS*122
D REX^YSCLTST5
;/RBN End modification for YS*122
Q
;
DATE S %DT="AEXP",%DT(0)=-DT,%DT("A")="Ending date for data collection."
D ^%DT K %DT G END:X="^",END:X="^" I Y=-1 G DATE
;/RBN Begin modifications for *122
S ZTDESC="Server triggered retransmission"
S ZTSAVE("YSCLED")="",ZTIO="",ZTRTN="REXMIT^YSCLTST5",ZTDTH=$H
D REXMIT^YSCLTST5 G END
;/RBN End modifications for *122
FLSET ;Set up file 603.02
W @IOF,"This option specifies the blood tests associated with the Clozapine"
W !,"reporting software. Two tests must be defined. The first is the White"
W !,"Blood Count. The second is the Granulocyte (or Neutrophil) percentage."
K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be used to record the White Blood Count for the",DIR("A")="Clozapine patients: " D ^DIR
Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT))
S YSCLWBC=+Y
K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be used to record the Neutrophil Count (percentage)",DIR("A")=" for the Clozapine patients: " D ^DIR
Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT))
S YSCLGRN=+Y
I YSCLWBC,YSCLGRN D
.;YS193 - add SET of DIC(0) in next line
.K DD S DIC="^YSCL(603.02,",DIC(0)="",X=YSCLWBC,DIC("DR")="1////"_YSCLGRN K DO D FILE^DICN
;Only one entry is allowed.
K DIR,X,Y,YSCLWBC,YSCLGRN,ZTDESC
Q
EN(DRG) ;
K LAB
I $$GET1^DIQ(50,DRG,17.5)'="PSOCLO1" S LAB("NOT")=0 Q
N YSARRAY D LIST^DIC(50.02,","_YSDRG_",",3,"I",,,,,,,"YSARRAY")
S (CNT,I)=0 F S I=$O(YSARRAY("DILIST",2,I)) Q:'I S CNT=$G(CNT)+1
I CNT'=2 S LAB("BAD TEST")=0 K CNT Q
K CNT F I=1:1 Q:'$D(YSARRAY("DILIST","ID",I)) D
.S LABT=$S(YSARRAY("DILIST","ID",I,3)=1:"WBC",1:"ANC"),YSLN=YSARRAY("DILIST",2,I)
.S LAB(LABT)=$$GET1^DIQ(50.02,YSLN_","_DRG,.01,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,2,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,3,"I")
K LABT,I
Q
CL1(DFN,DAYS) ;The routine was split due to size
G CL1^YSCLTST4
Q
;
;BEGIN: JCH - PSO*7*612
CL(DFN,PSORCLOZ) ; patient must be in both file #55 and #603.01 to get lab results
;END: JCH - PSO*7*612
K ^TMP("LRRR",$J) N RESULTS,YSCLYWBC,YSCLRANC,YSCLYANC,YSCLXANC,YSCLXWBC,YSCLRWBC,YSCLFRQ,YSCLIEN
I 'DFN Q "-1^-1^-1^-1^-1^-1^-1"
N ARRAY D LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
I '$D(ARRAY("DILIST","ID")) Q "-1^-1^-1^-1^-1^-1^-1"
;BEGIN: JCH - YS*5.01*166 Use frequency from registered cloz auth number, otherwise most recently assigned cloz number
S YSCLIEN=$$GETREGYS^PSOCLUTL(DFN),YSCLFRQ=""
I YSCLIEN>0 S YSCLIEN=$O(^YSCL(603.01,"C",DFN,""),-1)
;END: JCH - YS*5.01*166
I YSCLIEN S YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
I $$GET1^DIQ(603.03,1,7,"I")=1!(YSCLFRQ="") Q "-1^0^0^0^0^0^"_YSCLFRQ
I $$GET1^DIQ(55,DFN,54,"I")'="A" Q "-1^0^0^0^0^0^"_YSCLFRQ
; BEGIN: JCH - PSO*7*612. If coming from CPRS, no cloz ordering if local override number currently registered
I $G(PSORCLOZ) N ORYSIEN S ORYSIEN=$$GET1^DIQ(603.01,YSCLIEN,.01,"I") I ORYSIEN?1U6N Q "-1^0^0^0^0^0"
; END: JCH - PSO*7*612
S X1=DT,X2=$$GET1^DIQ(603.03,"1,",12) D C^%DTC S YSCLSD=X ; YS*5.01*227 - Change default to new field in parameters file
K ARRAY D LIST^DIC(603.41,",1,",,"I",,,,,,,"ARRAY")
F I=1:1 Q:'$D(ARRAY("DILIST",2,I)) S YSCLA=ARRAY("DILIST",2,I) D
. N YSCLTNM,YSCLTTP,YSCLTFR S YSCLTNM=$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
. S YSCLTTP=$$GET1^DIQ(603.41,YSCLA_",1,",1,"I")
. S YSCLTFR=$$GET1^DIQ(603.41,YSCLA_",1,",2,"I")
. S YSCLTLS(YSCLTTP,YSCLTNM)=YSCLTFR
F I=1:1 Q:'$D(ARRAY("DILIST",1,I)) S YSCLTL=ARRAY("DILIST",1,I) D
. D RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L")
. S YSCLSB1="" F S YSCLSB1=$O(^TMP("LRRR",$J,DFN,YSCLSB1)) Q:YSCLSB1="" D
. . S YSCLTDT="" F S YSCLTDT=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT)) Q:YSCLTDT="" D ;YS*5.01*227 - No longer excluding dates without times
. . . S YSCLTA="" F S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)) Q:YSCLTA="" I YSCLTA D
. . . . S RESULTS1=^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)
. . . . S RESULTS(YSCLTL,YSCLTDT)=$P(RESULTS1,"^",2)
;Find all entries for WBC and sort by inverse date.
S YSCLA="" F S YSCLA=$O(YSCLTLS("W",YSCLA)) Q:'YSCLA S YSCLXWBC(YSCLA)="" D
. S YSCLA1="" F S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1 S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_YSCLTLS("W",YSCLA)
I '$D(YSCLYWBC) G ALTANC
I $D(YSCLXWBC),$D(YSCLYWBC) D
.S YSCLRWBC=$O(YSCLYWBC(0)) I 'YSCLRWBC ;D KILL Q "0^^^^^^"_YSCLFRQ
.S YSCLMULT=$P(YSCLYWBC(YSCLRWBC),"^",3),YSCLMULT=$S(YSCLMULT:1000,1:1)
.S YSCLRWBC(YSCLRWBC)=($P(YSCLYWBC(YSCLRWBC),"^")*YSCLMULT)_"^"_$P(YSCLYWBC(YSCLRWBC),"^",2)
.;Scan for Neutrophil count on same day and time as most recent WBC
.S YSCLMTCH=0 F YSCLA="A","N","S","T" S YSCLTPT="" Q:YSCLMTCH F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D Q:YSCLMTCH
..S YSCLMULT=YSCLTLS(YSCLA,YSCLTPT),YSCLMULT=$S(YSCLMULT:1000,1:1)
..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01) Q
..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01) Q
..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E D
...S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:YSCLMTCH!'YSCLSGS
....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
....S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01) Q
..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E D
...S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:YSCLMTCH!'YSCLSGS
....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
....S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=((RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRWBC)*YSCLMULT))_"^"_$P(^LAB(60,YSCLTPT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q
D KILL
I '$G(YSCLRWBC(YSCLRWBC)),'+$G(YSCLRANC(YSCLRWBC)) Q "0^^^^^^"_YSCLFRQ
I $G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1000 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1000 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
;I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC)) Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ ; PWT - YS*5.01*227
I $G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1500 Q "2^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
;;END NCC REMEDIATION << RJS*122
Q "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
;
;;START NCC REMEDIATION >> RJS*122
ALTANC ;
S YSCLA=0 F S YSCLA=$O(YSCLTLS("A",YSCLA)) Q:'YSCLA S YSCLXANC(YSCLA)="" D
.S YSCLA1=0 F S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1 S YSCLYANC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_YSCLTLS("A",YSCLA)
I $D(YSCLYANC) D
.S (YSCLRANC,YSCLRWBC)=$O(YSCLYANC(0)) I 'YSCLRANC ;D KILL Q "0^^^^^^"_YSCLFRQ
.S YSCLMULT=$P(YSCLYANC(YSCLRANC),"^",3),YSCLMULT=$S(YSCLMULT:1000,1:1)
.S YSCLRANC(YSCLRANC)=($P(YSCLYANC(YSCLRANC),"^")*YSCLMULT)_"^"_$P(YSCLYANC(YSCLRANC),"^",2)
.;Scan for Neutrophil count on same day and time as most recent ANC
.S YSCLMTCH=0 F YSCLA="A","N","S","T" S YSCLTPT="" Q:YSCLMTCH F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D Q:YSCLMTCH
..S YSCLMULT=YSCLTLS(YSCLA,YSCLTPT),YSCLMULT=$S(YSCLMULT:1000,1:1)
..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="A",RESULTS(YSCLTPT,YSCLRANC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRANC)=RESULTS(YSCLTPT,YSCLRANC)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01) Q
..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="N",RESULTS(YSCLTPT,YSCLRANC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01) Q
..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="S",RESULTS(YSCLTPT,YSCLRANC)'?1A.E D
...S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:YSCLMTCH
....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRANC)) S RESULTS(YSCLSGS,YSCLRANC)=0
....S YSCLMTCH=1,YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC)*.01)+(RESULTS(YSCLSGS,YSCLRANC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01) Q
..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="C",RESULTS(YSCLTPT,YSCLRANC)'?1A.E D
...S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:YSCLMTCH
....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRANC)) S RESULTS(YSCLSGS,YSCLRANC)=0
....S YSCLMTCH=1,YSCLRANC(YSCLRANC)=((RESULTS(YSCLTPT,YSCLRANC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRANC)*YSCLMULT))_"^"_$P(^LAB(60,YSCLTPT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q
.S YSCLRWBC(YSCLRWBC)="^WBC"
D KILL
I '$G(YSCLRANC(+$G(YSCLRWBC))) Q "0^^^^^^"_YSCLFRQ
I +$G(YSCLRANC(YSCLRWBC))<1000 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
I +$G(YSCLRANC(YSCLRWBC))<1500 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
;;END NCC REMEDIATION << RJS*122
;
KILL ;
;Q:$D(PSLAST7) ;RTW
K FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT
K YSCLTL,YSCLTLS,X1,X2
K ^TMP("LRRR",$J) ; YS*5.01*227 - Clean up ^TMP
Q
;
OVERRIDE(DFN) ;Check for an over-ride. SEE RQ12.11
N YSCLIEN,YSCLOVRD,ARRAY ;S YSCLIEN=$O(^YSCL(603.01,"C",DFN,0)) Q:YSCLIEN="" 0
;BEGIN: JCH - YS*5.01*166
N YSCLPSN,PSOCZPTS,PSOERR,Y,X
D GET55(DFN,.YSCLPSN) S YSCLPSN=$G(YSCLPSN(DFN,53)) Q:YSCLPSN="" 0 ; Get current Clozapine number associated with patient's Clozapine registration
D FIND^DIC(603.01,"","","QX",DFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
S YSCLIEN=$G(PSOCZPTS("DILIST",2,1)) Q:YSCLPSN="" 0
;END: JCH - YS*5.01*166
S YSCLOVRD=$$GET1^DIQ(603.01,YSCLIEN,3,"I")
S:YSCLOVRD'=DT ANQRE=""
I '$G(PSGCFLG),$G(YSCLOVRD),DT>YSCLOVRD S X=YSCLOVRD,YSCXDATE=$$FMTE^XLFDT(X,"D") W !,"National Override expired at midnight on "_YSCXDATE
Q YSCLOVRD=DT
ZEOR ;YSCLTST2
Q
;
GET55(DFN,CLOZ55) ; JCH - PSO*7*612 - Get Clozapine "SAND" node from file 55 via PDM API
Q:'$G(DFN) ""
K CLOZ55
D PSS^PSS781(+DFN,"","SAND")
M CLOZ55(DFN)=^TMP($J,"SAND",DFN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLTST2 13781 printed Sep 23, 2025@19:50 Page 2
YSCLTST2 ;DALOI/LB/RLM - TRANSMIT RX AND LAB DATA FOR CLOZAPINE ; Nov 11, 2018@03:34
+1 ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122,166,193,227**;Dec 30, 1994;Build 17
+2 ;
+3 ; Reference to ^LAB(60 supported by IA #333
+4 ; Reference to ^PSDRUG supported by IA #25
+5 ; Reference to ^PS(55 supported by IA #787
+6 ; Reference to ^XMD supported by IA #10070
+7 ; Reference to ^LR7OR1 supported by IA #2503
+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 $$SITE^VASITE supported by DBIA #10112
+13 ; Reference to ^XLFDT supported by DBIA #10103
+14 ; Reference to MIX^DIC1 supported by DBIA #10007
+15 ; Reference to ^%ZTLOAD supported by DBIA #10063
+16 ; Reference to ^%DTC supported by DBIA #10000
+17 ; Reference to ^%DT supported by DBIA #10003
+18 ; Reference to PSS^PSS781 supported by DBIA #4480
+19 ; Reference to $$GETREGYS^PSOCLUTL supported by DBIA #7314
+20 ;
TRANSMIT ; send remote and local, kill and quit
+1 KILL XMZ
SET %DT="T"
SET X="NOW"
DO ^%DT
SET YSCLNOW=$PIECE(Y,".",2)
SET YSCLSITE=$PIECE($$SITE^VASITE,"^",2)
+2 SET $PIECE(YSSTOP,",",7)=7
IF $$S^%ZTLOAD
DO ABORT^YSCLTEST
GOTO END
+3 SET YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
SET YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
+4 ;S:YSPRODST="" YSPRODST="S.RUCLRXLAB@FO-HINES.DOMAIN.EXT"
SET YSPRODST=$$GET1^DIQ(603.03,1,8)
+5 ;S:YSDBGST="" YSDBGST="G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT"
SET YSDBGST=$$GET1^DIQ(603.03,1,10)
+6 ;/RBN - Begin modifications for YS*5.01*122
+7 IF $GET(YSCLLN)
Begin DoDot:1
+8 KILL XMY
+9 IF YSPROD
Begin DoDot:2
+10 ;XMY("G.CLOZAPINE ROLL-UP")="" ;,
IF 'YSDEBUG
SET XMY(YSPRODST)=""
+11 IF '$TEST
SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
SET XMY("G.RUCLRXLAB@FO-DALLAS.DOMAIN.EXT")=""
End DoDot:2
+12 IF '$TEST
Begin DoDot:2
+13 IF 'YSDEBUG
SET XMY(YSDBGST)=""
+14 IF '$TEST
SET XMY("G.CLOZAPINE DEBUG")=""
End DoDot:2
+15 SET XMDUZ="Clozapine MONITOR"
SET XMTEXT="^TMP($J,"
SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW
DO ^XMD
End DoDot:1
+16 KILL XMY
+17 SET ^TMP("YSCL",$JOB,2,0)=" "
SET ^TMP("YSCL",$JOB,3,0)="In message # "_$SELECT($DATA(XMZ):XMZ,1:"no data sent")
+18 IF 'YSDEBUG
SET XMY("G.PSOCLOZ")=""
if YSPROD
SET XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
+19 IF '$TEST
SET XMY("G.CLOZAPINE DEBUG")=""
if YSPROD
SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
+20 SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW
+21 KILL XMZ
SET ^TMP("YSCL",$JOB,1,0)="Clozapine lab data was transmitted, "_YSCLLN_" records were sent"
SET XMTEXT="^TMP(""YSCL"",$J,"
DO ^XMD
+22 ;S $P(^YSCL(603.03,1,0),"^",5)=$$NOW^XLFDT
SET DIE="^YSCL(603.03,"
SET DA=1
SET DR="5////"_$$NOW^XLFDT
DO ^DIE
+23 ;/RBN - End modifications for YS*5.01*122
END ;
+1 GOTO END1^YSCLTST3
+2 QUIT
+3 ;
REXMIT ; retransmit lab and RX data
+1 ; must be a tuesday
+2 SET DIR(0)="Y"
SET DIR("A")="Are you sure you wish to retransmit lab data"
+3 DO ^DIR
KILL DIR
IF Y'=1
KILL Y
QUIT
+4 ;/RBN Begin modification for YS*122
+5 DO REX^YSCLTST5
+6 ;/RBN End modification for YS*122
+7 QUIT
+8 ;
DATE SET %DT="AEXP"
SET %DT(0)=-DT
SET %DT("A")="Ending date for data collection."
+1 DO ^%DT
KILL %DT
if X="^"
GOTO END
if X="^"
GOTO END
IF Y=-1
GOTO DATE
+2 ;/RBN Begin modifications for *122
+3 SET ZTDESC="Server triggered retransmission"
+4 SET ZTSAVE("YSCLED")=""
SET ZTIO=""
SET ZTRTN="REXMIT^YSCLTST5"
SET ZTDTH=$HOROLOG
+5 DO REXMIT^YSCLTST5
GOTO END
+6 ;/RBN End modifications for *122
FLSET ;Set up file 603.02
+1 WRITE @IOF,"This option specifies the blood tests associated with the Clozapine"
+2 WRITE !,"reporting software. Two tests must be defined. The first is the White"
+3 WRITE !,"Blood Count. The second is the Granulocyte (or Neutrophil) percentage."
+4 KILL DIR
WRITE !!
SET DIR(0)="PA^64:EMZ"
SET DIR("A",1)="Enter the test that will be used to record the White Blood Count for the"
SET DIR("A")="Clozapine patients: "
DO ^DIR
+5 if Y=-1!($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+6 SET YSCLWBC=+Y
+7 KILL DIR
WRITE !!
SET DIR(0)="PA^64:EMZ"
SET DIR("A",1)="Enter the test that will be used to record the Neutrophil Count (percentage)"
SET DIR("A")=" for the Clozapine patients: "
DO ^DIR
+8 if Y=-1!($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+9 SET YSCLGRN=+Y
+10 IF YSCLWBC
IF YSCLGRN
Begin DoDot:1
+11 ;YS193 - add SET of DIC(0) in next line
+12 KILL DD
SET DIC="^YSCL(603.02,"
SET DIC(0)=""
SET X=YSCLWBC
SET DIC("DR")="1////"_YSCLGRN
KILL DO
DO FILE^DICN
End DoDot:1
+13 ;Only one entry is allowed.
+14 KILL DIR,X,Y,YSCLWBC,YSCLGRN,ZTDESC
+15 QUIT
EN(DRG) ;
+1 KILL LAB
+2 IF $$GET1^DIQ(50,DRG,17.5)'="PSOCLO1"
SET LAB("NOT")=0
QUIT
+3 NEW YSARRAY
DO LIST^DIC(50.02,","_YSDRG_",",3,"I",,,,,,,"YSARRAY")
+4 SET (CNT,I)=0
FOR
SET I=$ORDER(YSARRAY("DILIST",2,I))
if 'I
QUIT
SET CNT=$GET(CNT)+1
+5 IF CNT'=2
SET LAB("BAD TEST")=0
KILL CNT
QUIT
+6 KILL CNT
FOR I=1:1
if '$DATA(YSARRAY("DILIST","ID",I))
QUIT
Begin DoDot:1
+7 SET LABT=$SELECT(YSARRAY("DILIST","ID",I,3)=1:"WBC",1:"ANC")
SET YSLN=YSARRAY("DILIST",2,I)
+8 SET LAB(LABT)=$$GET1^DIQ(50.02,YSLN_","_DRG,.01,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,2,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,3,"I")
End DoDot:1
+9 KILL LABT,I
+10 QUIT
CL1(DFN,DAYS) ;The routine was split due to size
+1 GOTO CL1^YSCLTST4
+2 QUIT
+3 ;
+4 ;BEGIN: JCH - PSO*7*612
CL(DFN,PSORCLOZ) ; patient must be in both file #55 and #603.01 to get lab results
+1 ;END: JCH - PSO*7*612
+2 KILL ^TMP("LRRR",$JOB)
NEW RESULTS,YSCLYWBC,YSCLRANC,YSCLYANC,YSCLXANC,YSCLXWBC,YSCLRWBC,YSCLFRQ,YSCLIEN
+3 IF 'DFN
QUIT "-1^-1^-1^-1^-1^-1^-1"
+4 NEW ARRAY
DO LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
+5 IF '$DATA(ARRAY("DILIST","ID"))
QUIT "-1^-1^-1^-1^-1^-1^-1"
+6 ;BEGIN: JCH - YS*5.01*166 Use frequency from registered cloz auth number, otherwise most recently assigned cloz number
+7 SET YSCLIEN=$$GETREGYS^PSOCLUTL(DFN)
SET YSCLFRQ=""
+8 IF YSCLIEN>0
SET YSCLIEN=$ORDER(^YSCL(603.01,"C",DFN,""),-1)
+9 ;END: JCH - YS*5.01*166
+10 IF YSCLIEN
SET YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
+11 IF $$GET1^DIQ(603.03,1,7,"I")=1!(YSCLFRQ="")
QUIT "-1^0^0^0^0^0^"_YSCLFRQ
+12 IF $$GET1^DIQ(55,DFN,54,"I")'="A"
QUIT "-1^0^0^0^0^0^"_YSCLFRQ
+13 ; BEGIN: JCH - PSO*7*612. If coming from CPRS, no cloz ordering if local override number currently registered
+14 IF $GET(PSORCLOZ)
NEW ORYSIEN
SET ORYSIEN=$$GET1^DIQ(603.01,YSCLIEN,.01,"I")
IF ORYSIEN?1U6N
QUIT "-1^0^0^0^0^0"
+15 ; END: JCH - PSO*7*612
+16 ; YS*5.01*227 - Change default to new field in parameters file
SET X1=DT
SET X2=$$GET1^DIQ(603.03,"1,",12)
DO C^%DTC
SET YSCLSD=X
+17 KILL ARRAY
DO LIST^DIC(603.41,",1,",,"I",,,,,,,"ARRAY")
+18 FOR I=1:1
if '$DATA(ARRAY("DILIST",2,I))
QUIT
SET YSCLA=ARRAY("DILIST",2,I)
Begin DoDot:1
+19 NEW YSCLTNM,YSCLTTP,YSCLTFR
SET YSCLTNM=$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
+20 SET YSCLTTP=$$GET1^DIQ(603.41,YSCLA_",1,",1,"I")
+21 SET YSCLTFR=$$GET1^DIQ(603.41,YSCLA_",1,",2,"I")
+22 SET YSCLTLS(YSCLTTP,YSCLTNM)=YSCLTFR
End DoDot:1
+23 FOR I=1:1
if '$DATA(ARRAY("DILIST",1,I))
QUIT
SET YSCLTL=ARRAY("DILIST",1,I)
Begin DoDot:1
+24 DO RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L")
+25 SET YSCLSB1=""
FOR
SET YSCLSB1=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1))
if YSCLSB1=""
QUIT
Begin DoDot:2
+26 ;YS*5.01*227 - No longer excluding dates without times
SET YSCLTDT=""
FOR
SET YSCLTDT=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT))
if YSCLTDT=""
QUIT
Begin DoDot:3
+27 SET YSCLTA=""
FOR
SET YSCLTA=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA))
if YSCLTA=""
QUIT
IF YSCLTA
Begin DoDot:4
+28 SET RESULTS1=^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA)
+29 SET RESULTS(YSCLTL,YSCLTDT)=$PIECE(RESULTS1,"^",2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 ;Find all entries for WBC and sort by inverse date.
+31 SET YSCLA=""
FOR
SET YSCLA=$ORDER(YSCLTLS("W",YSCLA))
if 'YSCLA
QUIT
SET YSCLXWBC(YSCLA)=""
Begin DoDot:1
+32 SET YSCLA1=""
FOR
SET YSCLA1=$ORDER(RESULTS(YSCLA,YSCLA1))
if 'YSCLA1
QUIT
SET YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_YSCLTLS("W",YSCLA)
End DoDot:1
+33 IF '$DATA(YSCLYWBC)
GOTO ALTANC
+34 IF $DATA(YSCLXWBC)
IF $DATA(YSCLYWBC)
Begin DoDot:1
+35 ;D KILL Q "0^^^^^^"_YSCLFRQ
SET YSCLRWBC=$ORDER(YSCLYWBC(0))
IF 'YSCLRWBC
+36 SET YSCLMULT=$PIECE(YSCLYWBC(YSCLRWBC),"^",3)
SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
+37 SET YSCLRWBC(YSCLRWBC)=($PIECE(YSCLYWBC(YSCLRWBC),"^")*YSCLMULT)_"^"_$PIECE(YSCLYWBC(YSCLRWBC),"^",2)
+38 ;Scan for Neutrophil count on same day and time as most recent WBC
+39 SET YSCLMTCH=0
FOR YSCLA="A","N","S","T"
SET YSCLTPT=""
if YSCLMTCH
QUIT
FOR
SET YSCLTPT=$ORDER(YSCLTLS(YSCLA,YSCLTPT))
if 'YSCLTPT
QUIT
Begin DoDot:2
+40 SET YSCLMULT=YSCLTLS(YSCLA,YSCLTPT)
SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
+41 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
IF YSCLA="A"
IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
SET YSCLMTCH=1
SET YSCLRANC(YSCLRWBC)=RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
QUIT
+42 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
IF YSCLA="N"
IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
SET YSCLMTCH=1
SET YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
QUIT
+43 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
IF YSCLA="S"
IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
Begin DoDot:3
+44 SET YSCLSGS=""
FOR
SET YSCLSGS=$ORDER(YSCLTLS("B",YSCLSGS))
Begin DoDot:4
+45 if 'YSCLSGS
SET YSCLSGS="Z"
IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
SET RESULTS(YSCLSGS,YSCLRWBC)=0
+46 SET YSCLMTCH=1
SET YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01)
QUIT
End DoDot:4
if YSCLMTCH!'YSCLSGS
QUIT
End DoDot:3
+47 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
IF YSCLA="C"
IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
Begin DoDot:3
+48 SET YSCLSGS=""
FOR
SET YSCLSGS=$ORDER(YSCLTLS("T",YSCLSGS))
Begin DoDot:4
+49 if 'YSCLSGS
SET YSCLSGS="Z"
IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
SET RESULTS(YSCLSGS,YSCLRWBC)=0
+50 SET YSCLMTCH=1
SET YSCLRANC(YSCLRWBC)=((RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRWBC)*YSCLMULT))_"^"_$PIECE(^LAB(60,YSCLTPT,0),"^")_"/"_$PIECE($GET(^LAB(60,YSCLSGS,0)),"^")
QUIT
End DoDot:4
if YSCLMTCH!'YSCLSGS
QUIT
End DoDot:3
End DoDot:2
if YSCLMTCH
QUIT
End DoDot:1
+51 DO KILL
+52 IF '$GET(YSCLRWBC(YSCLRWBC))
IF '+$GET(YSCLRANC(YSCLRWBC))
QUIT "0^^^^^^"_YSCLFRQ
+53 IF $GET(YSCLRWBC(YSCLRWBC))
IF +$GET(YSCLRANC(YSCLRWBC))<1000
QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+54 IF '$GET(YSCLRWBC(YSCLRWBC))
IF +$GET(YSCLRANC(YSCLRWBC))<1000
QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+55 ;I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC)) Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ ; PWT - YS*5.01*227
+56 IF $GET(YSCLRWBC(YSCLRWBC))
IF +$GET(YSCLRANC(YSCLRWBC))<1500
QUIT "2^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+57 ;;END NCC REMEDIATION << RJS*122
+58 QUIT "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+59 ;
+60 ;;START NCC REMEDIATION >> RJS*122
ALTANC ;
+1 SET YSCLA=0
FOR
SET YSCLA=$ORDER(YSCLTLS("A",YSCLA))
if 'YSCLA
QUIT
SET YSCLXANC(YSCLA)=""
Begin DoDot:1
+2 SET YSCLA1=0
FOR
SET YSCLA1=$ORDER(RESULTS(YSCLA,YSCLA1))
if 'YSCLA1
QUIT
SET YSCLYANC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_YSCLTLS("A",YSCLA)
End DoDot:1
+3 IF $DATA(YSCLYANC)
Begin DoDot:1
+4 ;D KILL Q "0^^^^^^"_YSCLFRQ
SET (YSCLRANC,YSCLRWBC)=$ORDER(YSCLYANC(0))
IF 'YSCLRANC
+5 SET YSCLMULT=$PIECE(YSCLYANC(YSCLRANC),"^",3)
SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
+6 SET YSCLRANC(YSCLRANC)=($PIECE(YSCLYANC(YSCLRANC),"^")*YSCLMULT)_"^"_$PIECE(YSCLYANC(YSCLRANC),"^",2)
+7 ;Scan for Neutrophil count on same day and time as most recent ANC
+8 SET YSCLMTCH=0
FOR YSCLA="A","N","S","T"
SET YSCLTPT=""
if YSCLMTCH
QUIT
FOR
SET YSCLTPT=$ORDER(YSCLTLS(YSCLA,YSCLTPT))
if 'YSCLTPT
QUIT
Begin DoDot:2
+9 SET YSCLMULT=YSCLTLS(YSCLA,YSCLTPT)
SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
+10 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
IF YSCLA="A"
IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
SET YSCLMTCH=1
SET YSCLRANC(YSCLRANC)=RESULTS(YSCLTPT,YSCLRANC)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
QUIT
+11 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
IF YSCLA="N"
IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
SET YSCLMTCH=1
SET YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
QUIT
+12 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
IF YSCLA="S"
IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
Begin DoDot:3
+13 SET YSCLSGS=""
FOR
SET YSCLSGS=$ORDER(YSCLTLS("B",YSCLSGS))
Begin DoDot:4
+14 if 'YSCLSGS
SET YSCLSGS="Z"
IF '$DATA(RESULTS(YSCLSGS,YSCLRANC))
SET RESULTS(YSCLSGS,YSCLRANC)=0
+15 SET YSCLMTCH=1
SET YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC)*.01)+(RESULTS(YSCLSGS,YSCLRANC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01)
QUIT
End DoDot:4
if YSCLMTCH
QUIT
End DoDot:3
+16 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
IF YSCLA="C"
IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
Begin DoDot:3
+17 SET YSCLSGS=""
FOR
SET YSCLSGS=$ORDER(YSCLTLS("T",YSCLSGS))
Begin DoDot:4
+18 if 'YSCLSGS
SET YSCLSGS="Z"
IF '$DATA(RESULTS(YSCLSGS,YSCLRANC))
SET RESULTS(YSCLSGS,YSCLRANC)=0
+19 SET YSCLMTCH=1
SET YSCLRANC(YSCLRANC)=((RESULTS(YSCLTPT,YSCLRANC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRANC)*YSCLMULT))_"^"_$PIECE(^LAB(60,YSCLTPT,0),"^")_"/"_$PIECE($GET(^LAB(60,YSCLSGS,0)),"^")
QUIT
End DoDot:4
if YSCLMTCH
QUIT
End DoDot:3
End DoDot:2
if YSCLMTCH
QUIT
+20 SET YSCLRWBC(YSCLRWBC)="^WBC"
End DoDot:1
+21 DO KILL
+22 IF '$GET(YSCLRANC(+$GET(YSCLRWBC)))
QUIT "0^^^^^^"_YSCLFRQ
+23 IF +$GET(YSCLRANC(YSCLRWBC))<1000
QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+24 IF +$GET(YSCLRANC(YSCLRWBC))<1500
QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+25 QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+26 ;;END NCC REMEDIATION << RJS*122
+27 ;
KILL ;
+1 ;Q:$D(PSLAST7) ;RTW
+2 KILL FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT
+3 KILL YSCLTL,YSCLTLS,X1,X2
+4 ; YS*5.01*227 - Clean up ^TMP
KILL ^TMP("LRRR",$JOB)
+5 QUIT
+6 ;
OVERRIDE(DFN) ;Check for an over-ride. SEE RQ12.11
+1 ;S YSCLIEN=$O(^YSCL(603.01,"C",DFN,0)) Q:YSCLIEN="" 0
NEW YSCLIEN,YSCLOVRD,ARRAY
+2 ;BEGIN: JCH - YS*5.01*166
+3 NEW YSCLPSN,PSOCZPTS,PSOERR,Y,X
+4 ; Get current Clozapine number associated with patient's Clozapine registration
DO GET55(DFN,.YSCLPSN)
SET YSCLPSN=$GET(YSCLPSN(DFN,53))
if YSCLPSN=""
QUIT 0
+5 DO FIND^DIC(603.01,"","","QX",DFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
+6 SET YSCLIEN=$GET(PSOCZPTS("DILIST",2,1))
if YSCLPSN=""
QUIT 0
+7 ;END: JCH - YS*5.01*166
+8 SET YSCLOVRD=$$GET1^DIQ(603.01,YSCLIEN,3,"I")
+9 if YSCLOVRD'=DT
SET ANQRE=""
+10 IF '$GET(PSGCFLG)
IF $GET(YSCLOVRD)
IF DT>YSCLOVRD
SET X=YSCLOVRD
SET YSCXDATE=$$FMTE^XLFDT(X,"D")
WRITE !,"National Override expired at midnight on "_YSCXDATE
+11 QUIT YSCLOVRD=DT
ZEOR ;YSCLTST2
+1 QUIT
+2 ;
GET55(DFN,CLOZ55) ; JCH - PSO*7*612 - Get Clozapine "SAND" node from file 55 via PDM API
+1 if '$GET(DFN)
QUIT ""
+2 KILL CLOZ55
+3 DO PSS^PSS781(+DFN,"","SAND")
+4 MERGE CLOZ55(DFN)=^TMP($JOB,"SAND",DFN)
+5 QUIT
