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

BQINIGH1.m

Go to the documentation of this file. 
  1. BQINIGH1 ;VNGT/HS/ALA - iCare Nightly Job continued ; 11 Jun 2008  11:22 AM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1. MEAS ;EP - Check for new Measurement Types in File #9999999.07
  1.  NEW VFIEN,DSIEN,MSIEN,NAME,CODE,CHIEN,TEXT,BTAG,BQIXTYP,BIL,XCLLFH
  1.  S VFIEN=$O(^BQI(90506.3,"B","Measurement","")) Q:VFIEN=""
  1.  S DSIEN=$O(^BQI(90506.3,VFIEN,10,"B","Measurement","")) Q:DSIEN=""
  1.  NEW DA,DIK
  1.  S DA(2)=VFIEN,DA(1)=DSIEN,DA=0,DIK="^BQI(90506.3,"_DA(2)_",10,"_DA(1)_",5,"
  1.  F  S DA=$O(^BQI(90506.3,VFIEN,10,DSIEN,5,DA)) Q:'DA  D ^DIK
  1.  S MSIEN=0
  1.  F  S MSIEN=$O(^AUTTMSR(MSIEN)) Q:'MSIEN  D
  1.  . S NAME=$P(^AUTTMSR(MSIEN,0),U,2),CODE=$P(^AUTTMSR(MSIEN,0),U,1)
  1.  . S CHIEN=$O(^BQI(90506.3,VFIEN,10,DSIEN,5,"B",NAME,""))
  1.  . I CHIEN'="" Q
  1.  . NEW DA,DIC,X
  1.  . S DA(2)=VFIEN,DA(1)=DSIEN,X=NAME
  1.  . S DIC="^BQI(90506.3,"_DA(2)_",10,"_DA(1)_",5,",DIC(0)="L"
  1.  . K DO,DD D FILE^DICN
  1.  . S DA=+Y
  1.  . NEW IENS
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . S BQIUPD(90506.315,IENS,.02)=CODE,BQIUPD(90506.315,IENS,.03)="Y"
  1.  . S BQIUPD(90506.315,IENS,.04)="APCDTVAL"
  1.  . I $E(CODE,1,3)="ASQ"!($E(NAME,1,3)="ASQ")!($E(CODE,1,3)="BMI") S BQIUPD(90506.315,IENS,.05)=1
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  . ;
  1.  . S BQIXTYP="H"_CODE_"^AUPNVMS2"
  1.  . I $T(@BQIXTYP)'="" D
  1.  .. S BTAG="H"_CODE
  1.  .. F BI=1:1 S BIL=$T(@(BTAG)+BI^AUPNVMS2) Q:BIL=""!($P(BIL,";;",1)'=" ")  S TEXT(BI)=$P(BIL,";;",2)
  1.  .. I $D(TEXT)>0 D WP^DIE(90506.315,IENS,1,"","TEXT","ERROR")
  1.  .. K TEXT,BI
  1.  ;
  1. DSPM ; EP - Find the official IHS provider categories
  1.  NEW DSN,ABBRV,CODE,NSOURCE,NCAT,NCLIN,HDR,TEXT
  1.  S CODE="BDP"
  1.  F  S CODE=$O(^BQI(90506.1,"B",CODE)) Q:CODE=""!($E(CODE,1,3)'="BDP")  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.1,"B",CODE,IEN)) Q:IEN=""  D
  1.  .. S BQIUPD(90506.1,IEN_",",.1)=1
  1.  .. I $P(^BQI(90506.1,IEN,0),U,11)="" S BQIUPD(90506.1,IEN_",",.11)=DT
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  S DSN=0
  1.  F  S DSN=$O(^BDPTCAT(DSN)) Q:'DSN  D
  1.  . ;I $P(^BDPTCAT(DSN,0),U,7)'=1 Q
  1.  . S ABBRV=$P(^BDPTCAT(DSN,0),U,2) I ABBRV="" Q
  1.  . S CODE="BDP"_ABBRV
  1.  . S NSOURCE="Patient",NCLIN="Specialty Providers",NCAT="Other Patient Data"
  1.  . S HDR="T00030"_CODE
  1.  . S TEXT=$P(^BDPTCAT(DSN,0),U,1)
  1.  . I TEXT="DESIGNATED PRIMARY PROVIDER" Q
  1.  . S TEXT=$$LOWER^VALM1(TEXT)
  1.  . I $P(TEXT," ",1)="Hiv" D
  1.  .. S TEXT="HIV "_$P(TEXT," ",2,99)
  1.  . I $P(TEXT," ",1)="Ob" D
  1.  .. S TEXT="OB "_$P(TEXT," ",2,99)
  1.  . NEW DA,X,DIC,DLAYGO
  1.  . S DIC="^BQI(90506.1,",DIC(0)="L",X=CODE
  1.  . S DA=$O(^BQI(90506.1,"B",CODE,""))
  1.  . I DA="" D  Q:$G(ERROR)=1
  1.  .. K DO,DD D FILE^DICN
  1.  .. S DA=+Y I DA=-1 S ERROR=1
  1.  . S BQIUPD(90506.1,DA_",",.03)=TEXT
  1.  . S BQIUPD(90506.1,DA_",",.08)=HDR
  1.  . S BQIUPD(90506.1,DA_",",.15)=120
  1.  . S BQIUPD(90506.1,DA_",",.1)="@"
  1.  . S BQIUPD(90506.1,DA_",",.11)="@"
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  . ;
  1.  . S BQIUPD(90506.1,DA_",",3.01)=NSOURCE
  1.  . S BQIUPD(90506.1,DA_",",3.02)=NCLIN
  1.  . S BQIUPD(90506.1,DA_",",3.03)=NCAT
  1.  . S BQIUPD(90506.1,DA_",",3.04)="Optional"
  1.  . S BQIUPD(90506.1,DA_",",1)="S VAL=$P($$BPD^BQIULPT(DFN,STVW),U,2)"
  1.  . D FILE^DIE("E","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1. TMPL ; Set list for templates with |V | data objects
  1.  K ^XTMP("BQITEMPL")
  1.  S ^XTMP("BQITEMPL",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Templates containing |V | data objects"
  1.  NEW TMPN,BLN
  1.  S TMPN=0
  1.  F  S TMPN=$O(^TIU(8927,TMPN)) Q:'TMPN  D
  1.  . S BLN=0
  1.  . F  S BLN=$O(^TIU(8927,TMPN,2,BLN)) Q:'BLN  D
  1.  .. I ^TIU(8927,TMPN,2,BLN,0)["|V " S ^XTMP("BQITEMPL",TMPN)=""
  1.  ;
  1. TRG ;Check for new Asthma Health Factor Triggers
  1.  NEW ASCIEN,ASIEN,TEXT,CODE,ORD,BQIAST
  1.  K BQIAST
  1.  S ASCIEN=$O(^AUTTHF("B","ASTHMA TRIGGERS",0))
  1.  I ASCIEN'="" D
  1.  . S ASIEN=""
  1.  . F  S ASIEN=$O(^AUTTHF("AC",ASCIEN,ASIEN)) Q:ASIEN=""  D
  1.  .. I ASIEN=ASCIEN Q
  1.  .. S TEXT=$P(^AUTTHF(ASIEN,0),U,1),CODE="AST_"_ASIEN
  1.  .. I TEXT["-" S TEXT=$$LOWER^VALM1($P(TEXT,"-",1))_"-"_$$LOWER^VALM1($P(TEXT,"-",2))
  1.  .. I TEXT'["-" S TEXT=$$LOWER^VALM1(TEXT)
  1.  .. S BQIAST(CODE)=TEXT
  1.  S CODE=""
  1.  F  S CODE=$O(BQIAST(CODE)) Q:CODE=""  D
  1.  . S HDR="T00030"_CODE,NSOURCE="Asthma",NCLIN="",NCAT=""
  1.  . NEW DA,X,DIC,DLAYGO
  1.  . S DIC="^BQI(90506.1,",DIC(0)="L",X=CODE
  1.  . S DA=$O(^BQI(90506.1,"B",CODE,""))
  1.  . I DA'="" Q
  1.  . I DA="" D  Q:$G(ERROR)=1
  1.  .. K DO,DD D FILE^DICN
  1.  .. S DA=+Y I DA=-1 S ERROR=1
  1.  .. S ORD=$O(^BQI(90506.1,"AD","A",""),-1)+1
  1.  . S BQIUPD(90506.1,DA_",",.03)=TEXT
  1.  . S BQIUPD(90506.1,DA_",",.08)=HDR
  1.  . S BQIUPD(90506.1,DA_",",.15)=120
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  . ;
  1.  . S BQIUPD(90506.1,DA_",",3.01)=NSOURCE
  1.  . S BQIUPD(90506.1,DA_",",3.02)=NCLIN
  1.  . S BQIUPD(90506.1,DA_",",3.03)=NCAT
  1.  . S BQIUPD(90506.1,DA_",",3.04)="Optional"
  1.  . S BQIUPD(90506.1,DA_",",3.05)=ORD
  1.  . S BQIUPD(90506.1,DA_",",1)="S VAL=$$DSP^BQIRGASU(DFN,STVW)"
  1.  . S BQIUPD(90506.1,DA_",",5)="S HF=$P($P(^BQI(90506.1,STVW,0),U,1),""_"",2),VAL=$$HF^BQIDCUTL(DFN,HF),VISIT=$P(VAL,U,2),VAL=$$FMTE^BQIUL1($P(VAL,U,1))"
  1.  . D FILE^DIE("E","BQIUPD","ERROR")
  1.  . K BQIUPD
  1.  . S HELP(1)=TEXT_": Date of most recent Asthma Trigger (Health Factor)."
  1.  . D WP^DIE(90506.1,DA_",",4,"","HELP","ERROR")
  1.  . K HELP
  1.  ;
  1.  ;Set Flag To Track Whether External Tag Call Or Not
  1.  S XCLLFH=1
  1.  ;
  1. FHDX ;EP - Sep up list of Family History Allowed DX codes
  1.  ;
  1.  NEW II,DATA,BQITMP,TXT
  1.  ;
  1.  S II=0,DATA=$NA(^XTMP("BQIFHDX")) K @DATA
  1.  S @DATA@(II)=$$FMADD^XLFDT(DT,7)_U_DT_U_"List of Family History Allowed DX Codes"
  1.  ;
  1.  F TXT="Z80*","Z81*","Z82*","Z83*","Z84*" D
  1.  . S INDEX="BA" K BQITMP
  1.  . D LST^ATXAPI(30,80,TXT,"","BQITMP")
  1.  . S LIEN=""
  1.  . F  S LIEN=$O(BQITMP(LIEN)) Q:LIEN=""  D
  1.  .. S DESC=$$ICD9^BQIUL3(LIEN,,4),INAC=$$INIC^BQITAXX5(80,LIEN)
  1.  .. S II=II+1,@DATA@(II)=BQITMP(LIEN)_U_DESC_U_INAC
  1.  ;
  1.  K DATA,DSC,DUP,DX,FILE,IEN,II,SRT,TXT,Y
  1.  Q
  1.  ;
  1. COMM ;EP - Set up communities
  1.  NEW CNME,CIEN,CSTE,CNTY,STCOCOMM,CCNT,IEN,DA,FILE,DATA
  1.  NEW SCHK,SMULT,CCHK,CMULT,CSCMULT,CSTR,SGLOB
  1.  S FILE=9999999.05
  1.  S II=0,SGLOB=$NA(^XTMP("BQICOMMZ")),DATA=$NA(^XTMP("BQICOMM"))
  1.  K @SGLOB,@DATA
  1.  S @DATA@(II)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Community Table List plus count of patients"
  1.  S CIEN=0
  1.  F  S CIEN=$O(^AUTTCOM(CIEN)) Q:'CIEN  D
  1.  . S DA=CIEN,IEN=$$IENS^DILF(.DA)
  1.  . ; Exclude Inactive Communities
  1.  . I $P($G(^AUTTCOM(CIEN,88)),U,2)'="",$P($G(^(88)),U,2)'>DT Q
  1.  . S CNME=$$GET1^DIQ(FILE,IEN,.01,"I")
  1.  . S CNTY=$$GET1^DIQ(FILE,IEN,.02,"E")
  1.  . S CSTE=$$GET1^DIQ(FILE,IEN,.03,"E")
  1.  . S STCOCOMM=$$GET1^DIQ(FILE,IEN,.08,"E")
  1.  . I CNME=""!(CSTE="")!(CNTY="") Q
  1.  . ; Set data into a 'sort' global.
  1.  . S @SGLOB@(CNME,CSTE)=CIEN
  1.  . S @SGLOB@(CNME,CSTE,CNTY,CIEN)=STCOCOMM
  1.  . NEW CCIEN,CNT
  1.  . S CCIEN="",CNT=0
  1.  . F  S CCIEN=$O(^AUPNPAT("AC",CNME,CCIEN)) Q:CCIEN=""  D
  1.  .. ;Exclude patients with no active HRNs
  1.  .. I '$$HRN^BQIUL1(CCIEN) Q
  1.  .. I $P($G(^AUPNPAT(CCIEN,11)),U,17)=CIEN  S CNT=CNT+1
  1.  . S @SGLOB@("ZZCOUNT",CIEN)=CNT
  1.  . Q
  1.  ; Read through temporary TMP and create final TMP.
  1.  S (CNME,CSTE,CNTY,CIEN)=""
  1.  F  S CNME=$O(@SGLOB@(CNME)) Q:CNME=""  D
  1.  . S (SCHK,SMULT)=0
  1.  . F  S CSTE=$O(@SGLOB@(CNME,CSTE)) Q:CSTE=""  D
  1.  .. ; Check for more than one state with same community name and flag it.
  1.  .. I 'SCHK S SCHK=1 I $O(@SGLOB@(CNME,CSTE))'="" S SMULT=1
  1.  .. ; If only one state for this Comm, set ^TMP and return to loop.
  1.  .. I 'SMULT D  Q
  1.  ... S CIEN=@SGLOB@(CNME,CSTE)
  1.  ... S II=II+1,@DATA@(II)=CIEN_"^"_CNME_"^"_$G(@SGLOB@("ZZCOUNT",CIEN))
  1.  ... ; More than one state for Comm, now loop thru and check for multiple counties.
  1.  .. S (CCHK,CMULT)=0
  1.  .. F  S CNTY=$O(@SGLOB@(CNME,CSTE,CNTY)) Q:CNTY=""  D
  1.  ... I 'CCHK S CCHK=1 I $O(@SGLOB@(CNME,CSTE,CNTY))'=""  S CMULT=1
  1.  ... ; Include county name with Comm and State only if more than 1 entry for Comm AND State.
  1.  ... S CSTR=CNME_" ("_CSTE_$S(CMULT:"  "_CNTY,1:"")_")"
  1.  ... ; Double check to make sure there are no multiple occurrances of Comm, State, AND County.
  1.  ... S CSCMULT=""
  1.  ... S CIEN=$O(@SGLOB@(CNME,CSTE,CNTY,""))
  1.  ... I CIEN S CIEN=$O(@SGLOB@(CNME,CSTE,CNTY,CIEN)) S:CIEN CSCMULT=1
  1.  ... S CIEN=""
  1.  ... F  S CIEN=$O(@SGLOB@(CNME,CSTE,CNTY,CIEN)) Q:'CIEN  D
  1.  .... S STCOCOMM=@SGLOB@(CNME,CSTE,CNTY,CIEN)
  1.  .... S II=II+1,@DATA@(II)=CIEN_U_$S(CSCMULT:$P(CSTR,")")_$S('CMULT:"  "_CNTY,1:"")_"  "_STCOCOMM_")",1:CSTR)_U_@SGLOB@("ZZCOUNT",CIEN)
  1.  K @SGLOB
  1.  Q
  1.  ;
  1. AST ; Update all patients with any care management data
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ;
  1.  I $G(DT)="" D DT^DICRW
  1.  ;  Set the NIGHTLY ASTHMA STARTED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.22)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.24)=1
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  NEW TAG,TGIEN,REG,SRIEN,SRC,RIEN,STAT,DFN,SRCIEN
  1.  S DFN=0
  1.  F  S DFN=$O(^XTMP("BQINIGHT",DFN)) Q:'DFN  D
  1.  . I $G(^BQIPAT(DFN,0))="" D NPT^BQITASK(DFN)
  1.  . K ^BQIPAT(DFN,60)
  1.  . ; If flag is set for nightly/weekly
  1.  . S SRIEN=""
  1.  . F  S SRIEN=$O(^BQI(90506.5,"AD",1,SRIEN)) Q:SRIEN=""  D
  1.  .. I $P($G(^BQI(90506.5,SRIEN,0)),"^",10)=1 Q
  1.  .. ;I $P($G(^BQI(90506.5,SRIEN,0)),"^",16)'=1 Q
  1.  .. S SOURCE=$P($G(^BQI(90506.5,SRIEN,0)),"^",1)
  1.  .. S SRC=$P($G(^BQI(90506.5,SRIEN,0)),U,2)
  1.  .. ; If patient is deceased, don't calculate
  1.  .. I $P($G(^DPT(DFN,.35)),U,1)'="" Q
  1.  .. ; If patient has no active HRNs, quit
  1.  .. I '$$HRN^BQIUL1(DFN) Q
  1.  .. ; If patient has no visit in past 3 years
  1.  .. I '$$VTHR^BQIUL1(DFN) Q
  1.  .. I SOURCE="Pediatric",$$AGE^BQIAGE(DFN,"")>21 Q
  1.  .. D PAT^BQIRGASP(DFN,SRC)
  1.  K BDMDMRG,BDMJOB,BDMBTH,CYR,CIEN,PGTHR,PGRF,BDMRBD,BDMADAT,BDMTYPE,BDMRED,BMDBDAT,BDMPD
  1.  ;
  1.  ;  Set the NIGHTLY ASTHMA STOPPED field
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S BQIUPD(90508,DA_",",3.23)=$$NOW^XLFDT()
  1.  S BQIUPD(90508,DA_",",3.24)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. SRC(SOURCE) ; EP
  1.  S SRIEN=$O(^BQI(90506.5,"B",SOURCE,"")) I SRIEN="" Q
  1.  S SRC=$P(^BQI(90506.5,SRIEN,0),U,2)
  1.  Q