Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSCLHLAB

YSCLHLAB.m

Go to the documentation of this file.
YSCLHLAB ;DALOI/JCH-RETURN DATE RANGE LAB DATA FOR CLOZAPINE ; 10/17/20 5:34am
 ;;5.01;MENTAL HEALTH;**149**;Dec 30, 1994;Build 72
 ;
 ; 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 -7 (7 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
 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 X1=YSCLSD,X2=YSCLDAYS D C^%DTC S YSCLEDT=X
 I '$G(YSCLEDT)!'$G(YSCLSD) S X1=DT,X2="-7" 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=""  I $P(YSCLTDT,".",2)]"" D
 . . . 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
 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