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

BQIRMIZ.m

Go to the documentation of this file. 
  1. BQIRMIZ ;GDIT/HCSD/ALA-Update IZ Forecaster ; 02 Sep 2015  12:28 PM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1.  ;
  1. EN(DFN) ;EP
  1.  NEW VALUE,FRN,IMN,BSR,LIDT,TEXT
  1.  D IMM(DFN)
  1.  I VALUE'="Immunization due" Q
  1.  ;W !,DFN
  1.  S FRN=""
  1.  F  S FRN=$O(^BIPDUE("B",DFN,FRN)) Q:FRN=""  D
  1.  . S IMN=$P(^BIPDUE(FRN,0),"^",2)
  1.  . S RCDUE=$P(^BIPDUE(FRN,0),"^",4),OVDUE=$P(^(0),"^",5)
  1.  . S REMDUE=$S(RCDUE'="":RCDUE,1:OVDUE)
  1.  . S BSR=$P(^AUTTIMM(IMN,0),"^",9)
  1.  . S NIM=0,LIDT=""
  1.  . F  S LIDT=$O(^AUPNVIMM("AA",DFN,IMN,LIDT)) Q:LIDT=""  S NIM=NIM+1
  1.  . S LIDT=$O(^AUPNVIMM("AA",DFN,IMN,LIDT)) I LIDT'="" S REMLAST=9999999-LIDT
  1.  . Q  S BIEN="" F  S BIEN=$O(^BIPDUE("B",DFN,BIEN)) Q:BIEN=""  D
  1.  .. ; Check for Dose
  1.  .. S NAM=$P(^BISERT(BSR,0),"^",3) I $P(^(0),"^",6)=0 Q
  1.  .. S QDOSE=$P(^BISERT(BSR,0),"^",4),ADOSE=$P(^BISERT(BSR,0),"^",7)
  1.  .. S DOSE=$S(QDOSE>ADOSE:QDOSE,1:ADOSE)
  1.  .. I NIM<DOSE D  Q
  1.  ... S NIM=NIM+1,CODE="IM_"_NIM_"-"_NAM
  1.  ... S RIEN=$O(^BQIPAT(DFN,40,"B",CODE,"")) I RIEN="" D FIL^BQIRMDR
  1.  .. ;B
  1.  Q
  1.  ;
  1. IMM(BIDFN) ;EP - Expand immunization reminders
  1.  S $P(^BIPDUE(0),U,3)=0
  1.  D UPDATE^BIPATUP(BIDFN,DT,.ERROR,1)
  1.  ;D CHECK^BPXRMIMF(BIDFN,1,DT,.VALUE,.TEXT)
  1.  Q
  1.  ;
  1. NX ;
  1.  S BQDFN=0,ERRCNT=0
  1.  F  S BQDFN=$O(^AUPNPAT(BQDFN)) Q:'BQDFN  D
  1.  . ; If deceased, don't include
  1.  . I $P($G(^DPT(BQDFN,.35)),U,1)'="" Q
  1.  . ; If no active HRN, don't include
  1.  . I '$$HRN^BQIUL1(BQDFN) Q
  1.  . ; If no visit in last 3 years, quit
  1.  . I '$$VTHR^BQIUL1(BQDFN) Q
  1.  . ; If no visit in last 2 years, quit
  1.  . ;I '$$VTWR^BQIUL1(BQDFN) Q
  1.  . D EN(BQDFN)
  1.  Q
  1.  ;
  1. PTLS ;EP - Run patient list
  1.  ;
  1.  NEW BIAG,BIPG,BIFDT,BICC,BICM,BIMMR,BIMMD,BILOT,BIMD,BIORD,BIRDT,BIDED,BIT,BIHBIDPRV,BIERR,BIBEN
  1.  S BIAG="ALL",BIPG=3,BIFDT=DT,BICC("ALL")="",BIBEN(1)="",BIERR=0,BIHCF("ALL")="",BIHCF($P(^BQI(90508,1,0),"^",1))=""
  1.  S BICM("ALL")="",BIMMR("ALL")="",BIMMD("ALL")="",BILOT("ALL")="",BIMD=0,BIDPRV("ALL")=""
  1.  S BIORD=1,BIRDT="",BIDED=0,BIT=0
  1.  D R^BIDUR(.BIAG,.BIPG,.BIFDT,.BICC,.BICM,.BIMMR,.BIMMD,.BILOT,.BIMD,.BIORD,.BIRDT,.BIDED,.BIT,.BIHCF,.BIDPRV,.BIERR,.BIBEN)
  1.  ;
  1.  S RVDT=""
  1.  F  S RVDT=$O(^TMP("BIDUL",$J,1,RVDT)) Q:RVDT=""  D
  1.  . S PTNAM="" F  S PTNAM=$O(^TMP("BIDUL",$J,1,RVDT,PTNAM)) Q:PTNAM=""  D
  1.  .. S BQDFN="" F  S BQDFN=$O(^TMP("BIDUL",$J,1,RVDT,PTNAM,BQDFN)) Q:BQDFN=""  D IMM(BQDFN)
  1.  Q
  1.  ;
  1. APT ;EP - check appointments
  1.  NEW NXDAY,PTN,APTD
  1.  S NXDAY=$$FMADD^XLFDT(DT,1)
  1.  S PTN=0
  1.  F  S PTN=$O(^DPT(PTN)) Q:'PTN  D
  1.  . S APTD=$O(^DPT(PTN,"S",NXDAY)) I APTD="" Q
  1.  . I APTD\1'=NXDAY Q
  1.  . D FOR(PTN,APTD)
  1.  Q
  1.  ;
  1. FOR(BIDFN,BIFDT) ;EP - Forecaster
  1.  NEW BIDUZ2,BIFORCST,BIPDSS
  1.  S BIDUZ2=DUZ(2)
  1.  D IMMFORC^BIRPC(.BIFORCST,BIDFN,BIFDT,,$G(BIDUZ2),.BIPDSS)
  1.  I BIFORCST'["No " S ^XTMP("BQINIGHT",BIDFN)=""
  1.  Q