- 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 Apr 23, 2025@18:28:03 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
