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

YSCLTST4.m

Go to the documentation of this file.
  1. YSCLTST4 ;DALOI/LB/RLM - TRANSMIT RX AND lAB DATA FOR CLOZAPINE ; Nov 27, 2018@17:15
  1. ;;5.01;MENTAL HEALTH;**92,122,166,227**;Dec 30, 1994;Build 17
  1. ;
  1. ; Reference to ^LAB(60 supported by IA #333
  1. ; Reference to ^LR7OR1 supported by IA #2503
  1. ; Reference to ^DIC supported by DBIA #2051
  1. ; Reference to ^DIQ supported by DBIA #2056
  1. ; Reference to ^%DTC supported by DBIA #10000
  1. ;
  1. CL1 ;(DFN,DAYS) ;
  1. K ^TMP($J,"PSO"),RESULTS,YSCLYWBC,YSCLRANC,YSCLXWBC
  1. Q:'DFN
  1. S:'$G(DAYS) DAYS=90
  1. N ARRAY D LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
  1. ;BEGIN: JCH - YS*5.01*166
  1. N YSCLPSN,PSOCZPTS,PSOERR
  1. ;S YSCLPSN=$$GET1^DIQ(55,DFN,53,"I") Q:YSCLPSN="" 0 ; Get current Clozapine number associated with patient's Clozapine registration
  1. D GET55^YSCLTST2(DFN,.YSCLPSN) S YSCLPSN=$G(YSCLPSN(DFN,53)) Q:YSCLPSN="" 0 ; Get current Clozapine number associated with patient's Clozapine registration
  1. D FIND^DIC(603.01,"","","QX",DFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
  1. S YSCLIEN=$G(PSOCZPTS("DILIST",2,1))
  1. ;END: JCH - YS*5.01*166
  1. ;S YSCLIEN=$G(ARRAY("DILIST",2,1)),YSCLFRQ="" I YSCLIEN S YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
  1. S YSCLFRQ="" I YSCLIEN S YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
  1. I $$GET1^DIQ(603.03,1,7,"I")=1 Q "-1^0^0^0^0^0^"_YSCLFRQ
  1. S X1=DT,X2="-"_DAYS D C^%DTC S YSCLSD=X
  1. K ARRAY D LIST^DIC(603.41,",1,","1;2","I",,,,,,,"ARRAY")
  1. F I=1:1 Q:'$D(ARRAY("DILIST",2,I)) S YSCLA=ARRAY("DILIST",2,I) D
  1. . N YSCLTNM,YSCLTTP,YSCLTFR S YSCLTNM=ARRAY("DILIST",1,I) ;$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
  1. . S YSCLTTP=ARRAY("DILIST","ID",I,1)
  1. . S YSCLTFR=ARRAY("DILIST","ID",I,2)
  1. . S YSCLTLS(YSCLTTP,YSCLTNM)=YSCLTFR
  1. F I=1:1 Q:'$D(ARRAY("DILIST",1,I)) S YSCLTL=ARRAY("DILIST",1,I) D
  1. . D RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L")
  1. . S YSCLSB1="" F S YSCLSB1=$O(^TMP("LRRR",$J,DFN,YSCLSB1)) Q:YSCLSB1="" D
  1. . . S YSCLTDT="" F S YSCLTDT=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT)) Q:YSCLTDT="" D ;YS227
  1. . . . S YSCLTA="" F S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)) Q:YSCLTA="" I YSCLTA D
  1. . . . . S RESULTS1=^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)
  1. . . . . S RESULTS(YSCLTL,YSCLTDT)=$P(RESULTS1,"^",2)
  1. ;Find all entries for WBC and sort by inverse date.
  1. S YSCLA="" F S YSCLA=$O(YSCLTLS("W",YSCLA)) Q:'YSCLA S YSCLXWBC(YSCLA)="" D
  1. . S YSCLA1="" F S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1 D
  1. . . S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)*$S(YSCLTLS("W",YSCLA):1000,1:1)
  1. . . S ^TMP($J,"PSO",YSCLA1)=YSCLYWBC(YSCLA1)
  1. S YSCLRWBC=0 F S YSCLRWBC=$O(YSCLYWBC(YSCLRWBC)) Q:YSCLRWBC="" S YSCLRWBC(YSCLRWBC)=YSCLYWBC(YSCLRWBC) D
  1. . ;Match all ANC's and WBC's
  1. . S YSCLMTCH=0 F YSCLA="A","N","S","C" Q:YSCLMTCH S YSCLTPT="" F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D Q:YSCLMTCH
  1. . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",$D(YSCLRWBC(YSCLRWBC)) S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1)) Q
  1. . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",$D(YSCLRWBC(YSCLRWBC)) S YSCLMTCH=1,^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01))) Q
  1. . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",$D(YSCLRWBC(YSCLRWBC)) D Q
  1. . . . S (YSCLSG1,YSCLSGS)="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:'YSCLSGS!YSCLMTCH
  1. . . . . I 'YSCLSG1,'YSCLSGS S YSCLSGS="Z",YSCLSG1=1
  1. . . . . I 'YSCLSGS,YSCLSG1 Q
  1. . . . . I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
  1. . . . . S YSCLMTCH=1,^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))) Q
  1. . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C" S YSCLMTCH=1 D
  1. . . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:'YSCLSGS!YSCLMTCH
  1. . . . . I '$G(YSCLSG1),'YSCLSGS S YSCLSGS="Z",YSCLSG1=1
  1. . . . . I 'YSCLSGS,$G(YSCLSG1) Q
  1. . . . . I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
  1. . . . . S YSCLMTCH=1,^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_((RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1))+(RESULTS(YSCLSGS,YSCLRWBC))) Q
  1. S YSCLA="A",YSCLTPT="" F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D
  1. . S YSCLRANC="" F S YSCLRNC=$O(RESULTS(YSCLTPT,YSCLRANC)) Q:'YSCLRANC D
  1. . . Q:$D(^TMP($J,"PSO",YSCLRANC))
  1. . . S ^TMP($J,"PSO",YSCLRANC)="^"_(RESULTS(YSCLTPT,YSCLRANC)*$S(YSCLTLS("A",YSCLTPT):1000,1:1))
  1. K FDA,YSCLSGS,Y15,YSCLRWBC,YSCLANC,YSCLYWBC,YSCLFRQ,ZIENS,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD
  1. K YSCLTA,YSCLTDT,YSCLTL,YSCLTLS,YSCLTPT,YSCLXWBC,YSCLMULT
  1. Q
  1. ;
  1. KILL ;
  1. K FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT
  1. K YSCLTDT,YSCLTL,YSCLSG1,YSCLTLS,YSCLTPT,YSCLXWBC
  1. ;
  1. ZEOR ;YSCLTST4