YSCLHLAB ;DALOI/JCH - RETURN DATE RANGE LAB DATA FOR CLOZAPINE ; Jun 06, 2023@15:56
;;5.01;MENTAL HEALTH;**149,227**;Dec 30, 1994;Build 17
;
; Reference to ^LAB(60 supported by IA #333
; Reference to ^PS(55 supported by IA #787
; Reference to ^LR7OR1 supported by IA #2503
; Reference to ^DIC supported by DBIA #2051
; Reference to ^DIQ supported by DBIA #2056
; Reference to ^XLFDT supported by DBIA #10103
; Reference to ^%DTC supported by DBIA #10000
; Reference to ^VA(200 supported by DBIA #10060
;
CL(DFN,YSCLPSD,YSCLDAYS) ; Search for Lab Results
; Start Date (YSCLPSD) (optional). If no start date is passed, defaults to Today.
; Days backward (YSCLDAYS) from Start Date to search (optional). If nothing passed, defaults to -30 (30 days back)
;
K ^TMP("LRRR",$J)
N YSCLSD,RESULTS,YSCLYWBC,YSCLRANC,YSCLYANC,YSCLXANC,YSCLXWBC,YSCLRWBC,YSCLFRQ
N YSCLTDT,YSCLEDT,YSCLIEN,YSCLREGX,YSCLTPT,YSCL55AR,X,I
S YSCLDAYS=$G(YSCLDAYS,$$GET1^DIQ(603.03,"1,",12)) ; YS*5.01*227 - Change default to new field in parameters file
S:YSCLDAYS>0 YSCLDAYS=-1*YSCLDAYS ; YS*5.01*227 - Ensure lookback is negative
I '$G(DUZ(2)) N DUZ S DUZ=.5,DUZ(2)=$O(^VA(200,DUZ,2,0))
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"
D GET55^YSCLTST2(DFN,.YSCL55AR)
S YSCLREGX=$G(YSCL55AR(DFN,53)) I YSCLREGX'="" S YSCLIEN=$O(^YSCL(603.01,"B",YSCLREGX,0))
S YSCLFRQ=""
I '$G(YSCLIEN) S YSCLIEN=$O(^YSCL(603.01,"C",DFN,""),-1)
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 $P($G(YSCL55AR(DFN,54)),"^")'="A" Q "-1^0^0^0^0^0^"_YSCLFRQ
S YSCLSD=DT ; Default to Today
I $G(YSCLPSD)?7N!($G(YSCLPSD)?7N.1".".N) D
.Q:$$FMDIFF^XLFDT(YSCLPSD,DT,1)>0 ; No future dates
.;S YSCLSD=YSCLPSD,YSCLDAYS=$S($G(YSCLDAYS)>0:"-"_$G(YSCLDAYS),'$G(YSCLDAYS):"-7",1:$G(YSCLDAYS))
.S YSCLSD=YSCLPSD ; YS*5.01*227 - Move YSCLDAYS default setting to top of subroutine
.S X1=YSCLSD,X2=YSCLDAYS D C^%DTC S YSCLEDT=X
; YS*5.01*227 - Change default lookback below to use new field in parameters file
I '$G(YSCLEDT)!'$G(YSCLSD) S X1=DT,X2=$$GET1^DIQ(603.03,"1,",12) D C^%DTC S YSCLSD=DT,YSCLEDT=X ; If missing start or end date, revert to defaults
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,,YSCLEDT,YSCLSD,,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
I $G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1500 Q "2^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
Q "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
;
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
;
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)
Q
;
GETREGYS(PSODFN) ; Get file 603.01 IEN currently registered to patient
N PSOCLZN,PSOYSIEN,PSOCLODT
S PSOCLZN=$$GET1^DIQ(55,PSODFN,53)
S PSOYSIEN=$$FIND1^DIC(603.01,,"Q",PSOCLZN,"B")
Q PSOYSIEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLHLAB 9202 printed Nov 22, 2024@17:23:40 Page 2
YSCLHLAB ;DALOI/JCH - RETURN DATE RANGE LAB DATA FOR CLOZAPINE ; Jun 06, 2023@15:56
+1 ;;5.01;MENTAL HEALTH;**149,227**;Dec 30, 1994;Build 17
+2 ;
+3 ; Reference to ^LAB(60 supported by IA #333
+4 ; Reference to ^PS(55 supported by IA #787
+5 ; Reference to ^LR7OR1 supported by IA #2503
+6 ; Reference to ^DIC supported by DBIA #2051
+7 ; Reference to ^DIQ supported by DBIA #2056
+8 ; Reference to ^XLFDT supported by DBIA #10103
+9 ; Reference to ^%DTC supported by DBIA #10000
+10 ; Reference to ^VA(200 supported by DBIA #10060
+11 ;
CL(DFN,YSCLPSD,YSCLDAYS) ; Search for Lab Results
+1 ; Start Date (YSCLPSD) (optional). If no start date is passed, defaults to Today.
+2 ; Days backward (YSCLDAYS) from Start Date to search (optional). If nothing passed, defaults to -30 (30 days back)
+3 ;
+4 KILL ^TMP("LRRR",$JOB)
+5 NEW YSCLSD,RESULTS,YSCLYWBC,YSCLRANC,YSCLYANC,YSCLXANC,YSCLXWBC,YSCLRWBC,YSCLFRQ
+6 NEW YSCLTDT,YSCLEDT,YSCLIEN,YSCLREGX,YSCLTPT,YSCL55AR,X,I
+7 ; YS*5.01*227 - Change default to new field in parameters file
SET YSCLDAYS=$GET(YSCLDAYS,$$GET1^DIQ(603.03,"1,",12))
+8 ; YS*5.01*227 - Ensure lookback is negative
if YSCLDAYS>0
SET YSCLDAYS=-1*YSCLDAYS
+9 IF '$GET(DUZ(2))
NEW DUZ
SET DUZ=.5
SET DUZ(2)=$ORDER(^VA(200,DUZ,2,0))
+10 IF 'DFN
QUIT "-1^-1^-1^-1^-1^-1^-1"
+11 NEW ARRAY
DO LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
+12 IF '$DATA(ARRAY("DILIST","ID"))
QUIT "-1^-1^-1^-1^-1^-1^-1"
+13 DO GET55^YSCLTST2(DFN,.YSCL55AR)
+14 SET YSCLREGX=$GET(YSCL55AR(DFN,53))
IF YSCLREGX'=""
SET YSCLIEN=$ORDER(^YSCL(603.01,"B",YSCLREGX,0))
+15 SET YSCLFRQ=""
+16 IF '$GET(YSCLIEN)
SET YSCLIEN=$ORDER(^YSCL(603.01,"C",DFN,""),-1)
+17 IF YSCLIEN
SET YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
+18 IF $$GET1^DIQ(603.03,1,7,"I")=1!(YSCLFRQ="")
QUIT "-1^0^0^0^0^0^"_YSCLFRQ
+19 IF $PIECE($GET(YSCL55AR(DFN,54)),"^")'="A"
QUIT "-1^0^0^0^0^0^"_YSCLFRQ
+20 ; Default to Today
SET YSCLSD=DT
+21 IF $GET(YSCLPSD)?7N!($GET(YSCLPSD)?7N.1".".N)
Begin DoDot:1
+22 ; No future dates
if $$FMDIFF^XLFDT(YSCLPSD,DT,1)>0
QUIT
+23 ;S YSCLSD=YSCLPSD,YSCLDAYS=$S($G(YSCLDAYS)>0:"-"_$G(YSCLDAYS),'$G(YSCLDAYS):"-7",1:$G(YSCLDAYS))
+24 ; YS*5.01*227 - Move YSCLDAYS default setting to top of subroutine
SET YSCLSD=YSCLPSD
+25 SET X1=YSCLSD
SET X2=YSCLDAYS
DO C^%DTC
SET YSCLEDT=X
End DoDot:1
+26 ; YS*5.01*227 - Change default lookback below to use new field in parameters file
+27 ; If missing start or end date, revert to defaults
IF '$GET(YSCLEDT)!'$GET(YSCLSD)
SET X1=DT
SET X2=$$GET1^DIQ(603.03,"1,",12)
DO C^%DTC
SET YSCLSD=DT
SET YSCLEDT=X
+28 KILL ARRAY
DO LIST^DIC(603.41,",1,",,"I",,,,,,,"ARRAY")
+29 FOR I=1:1
if '$DATA(ARRAY("DILIST",2,I))
QUIT
SET YSCLA=ARRAY("DILIST",2,I)
Begin DoDot:1
+30 NEW YSCLTNM,YSCLTTP,YSCLTFR
SET YSCLTNM=$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
+31 SET YSCLTTP=$$GET1^DIQ(603.41,YSCLA_",1,",1,"I")
+32 SET YSCLTFR=$$GET1^DIQ(603.41,YSCLA_",1,",2,"I")
+33 SET YSCLTLS(YSCLTTP,YSCLTNM)=YSCLTFR
End DoDot:1
+34 FOR I=1:1
if '$DATA(ARRAY("DILIST",1,I))
QUIT
SET YSCLTL=ARRAY("DILIST",1,I)
Begin DoDot:1
+35 DO RR^LR7OR1(DFN,,YSCLEDT,YSCLSD,,YSCLTL,"L")
+36 SET YSCLSB1=""
FOR
SET YSCLSB1=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1))
if YSCLSB1=""
QUIT
Begin DoDot:2
+37 ;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
+38 SET YSCLTA=""
FOR
SET YSCLTA=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA))
if YSCLTA=""
QUIT
IF YSCLTA
Begin DoDot:4
+39 SET RESULTS1=^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA)
+40 SET RESULTS(YSCLTL,YSCLTDT)=$PIECE(RESULTS1,"^",2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 ;Find all entries for WBC and sort by inverse date.
+42 SET YSCLA=""
FOR
SET YSCLA=$ORDER(YSCLTLS("W",YSCLA))
if 'YSCLA
QUIT
SET YSCLXWBC(YSCLA)=""
Begin DoDot:1
+43 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
+44 IF '$DATA(YSCLYWBC)
GOTO ALTANC
+45 IF $DATA(YSCLXWBC)
IF $DATA(YSCLYWBC)
Begin DoDot:1
+46 ;D KILL Q "0^^^^^^"_YSCLFRQ
SET YSCLRWBC=$ORDER(YSCLYWBC(0))
IF 'YSCLRWBC
+47 SET YSCLMULT=$PIECE(YSCLYWBC(YSCLRWBC),"^",3)
SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
+48 SET YSCLRWBC(YSCLRWBC)=($PIECE(YSCLYWBC(YSCLRWBC),"^")*YSCLMULT)_"^"_$PIECE(YSCLYWBC(YSCLRWBC),"^",2)
+49 ;Scan for Neutrophil count on same day and time as most recent WBC
+50 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
+51 SET YSCLMULT=YSCLTLS(YSCLA,YSCLTPT)
SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
+52 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
+53 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
+54 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
IF YSCLA="S"
IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
Begin DoDot:3
+55 SET YSCLSGS=""
FOR
SET YSCLSGS=$ORDER(YSCLTLS("B",YSCLSGS))
Begin DoDot:4
+56 if 'YSCLSGS
SET YSCLSGS="Z"
IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
SET RESULTS(YSCLSGS,YSCLRWBC)=0
+57 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
+58 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
IF YSCLA="C"
IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
Begin DoDot:3
+59 SET YSCLSGS=""
FOR
SET YSCLSGS=$ORDER(YSCLTLS("T",YSCLSGS))
Begin DoDot:4
+60 if 'YSCLSGS
SET YSCLSGS="Z"
IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
SET RESULTS(YSCLSGS,YSCLRWBC)=0
+61 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
+62 DO KILL
+63 IF '$GET(YSCLRWBC(YSCLRWBC))
IF '+$GET(YSCLRANC(YSCLRWBC))
QUIT "0^^^^^^"_YSCLFRQ
+64 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
+65 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
+66 IF '$GET(YSCLRWBC(YSCLRWBC))
IF +$GET(YSCLRANC(YSCLRWBC))
QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+67 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
+68 QUIT "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
+69 ;
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 ;
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 KILL ^TMP("LRRR",$JOB)
+5 QUIT
+6 ;
GETREGYS(PSODFN) ; Get file 603.01 IEN currently registered to patient
+1 NEW PSOCLZN,PSOYSIEN,PSOCLODT
+2 SET PSOCLZN=$$GET1^DIQ(55,PSODFN,53)
+3 SET PSOYSIEN=$$FIND1^DIC(603.01,,"Q",PSOCLZN,"B")
+4 QUIT PSOYSIEN
