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

BQICALRN.m

Go to the documentation of this file. 
  1. BQICALRN ;GDIT/HS/ALA-Expanded Community Alerts ; 13 Oct 2011  3:42 PM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
  1.  ;
  1. FND ;EP - Find alerts
  1.  ; Get the lab taxonomies for Community Alerts
  1.  NEW LIST,LNC,TAX,TREF,TX,IEN
  1.  D CA^BQITAXCK
  1.  D EN^BQITAXCK(.LIST)
  1.  I $G(X)="^" Q
  1.  ;
  1.  NEW DIR,ARRAY
  1.  S ARRAY(1)="**Warning**  Missing entries in lab taxonomies could result in non-identified"
  1.  S ARRAY(2)="             information."
  1.  S ARRAY(3)=" "
  1.  S ARRAY(4)="             Please quit and update lab taxonomies via Taxonomy Maintenance"
  1.  S ARRAY(5)="             before completing the export."
  1.  S ARRAY(6)="  "
  1.  D EN^DDIOL(.ARRAY)
  1.  S DIR(0)="E" D ^DIR
  1.  I X="^"!($G(DTOUT)'="") Q
  1.  NEW DA,DIK,UID
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  ;
  1.  ; Find clinics for primary care
  1.  NEW TREF,TAX,PREF,TMFRAME,STDT,ENDT,ALRT,BGDA,BGI,BGPC,BGPCI,A,DATA
  1.  NEW ATIEN,CM,TY,PT,DTE,DXN,DXCC,CIEN,DIEN,RIEN,XIEN,E,EXEC,G,IEN,CCT
  1.  NEW OK,PCL,SIEN,V,VISIT,VSDTM,X,Y,COMM,DFN,DOD,DTY,ATY,SDATA,AIEN
  1.  NEW LBT,VCLIN,BDT,BDXX,BGDT,BQIN,BSXX,CT,DEXEC,EDT,EXP,FILE,FLAG,I
  1.  NEW N,OPER,OPER2,OVALUE,RES,RES2,RN,TIEN,TYP,VCAT,VDATE,VFL,X,Y,ZZ
  1.  ; Need to get the program for the GPRA year to check active population
  1.  NEW BGPHOME,BQIH,BQIINDF,BQIINDG,BQIMEASF,BQIMEASG,BQIY,BQIYR,BQIROU
  1.  ;
  1.  I $G(DT)="" D DT^DICRW
  1.  ;
  1.  ; Set the alert temporary global
  1.  NEW TDATA
  1.  S TDATA=$NA(^TMP("BQIALRTTMP",UID))
  1.  S DATA=$NA(^TMP("BQIALERT",UID))
  1.  K @TDATA,@DATA
  1.  K ^XTMP("BQICAVAL")
  1.  ;
  1.  NEW DA,IENS,BQIH,BQI,TX,QFL,REP,TME,HAS
  1.  S BQIH=$$SPM^BQIGPUTL(),BQIN=0
  1.  F  S BQIN=$O(^BQI(90508,BQIH,15,BQIN)) Q:'BQIN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=BQIH,DA=BQIN,IENS=$$IENS^DILF(.DA)
  1.  . S TMFRAME="T-"_$$GET1^DIQ(90508,"1,",.24,"E")
  1.  . S TY=$$GET1^DIQ(90508.015,IENS,.01,"E")
  1.  . S ENDT=DT,STDT=$$DATE^BQIUL1(TMFRAME)
  1.  . S TYP(TY)=ENDT_U_STDT
  1.  S TY=""
  1.  F  S TY=$O(TYP(TY)) Q:TY=""  D
  1.  . S BGDT=$P(TYP(TY),U,2)-.0001,ENDT=$P(TYP(TY),U,1),STDT=$P(TYP(TY),U,2)
  1.  . F  S BGDT=$O(^AUPNVSIT("B",BGDT)) Q:BGDT=""!(BGDT\1>ENDT)  D  S CCT=$G(CCT)+1 W:CCT#100=0 "."
  1.  .. S VISIT=""
  1.  .. F  S VISIT=$O(^AUPNVSIT("B",BGDT,VISIT)) Q:VISIT=""  D
  1.  ... I $P(^AUPNVSIT(VISIT,0),U,11)=1 Q
  1.  ... S VCAT=$P(^AUPNVSIT(VISIT,0),U,7)
  1.  ... I VCAT'="A",VCAT'="C",VCAT'="H",VCAT'="T" Q
  1.  ... S DFN=$P(^AUPNVSIT(VISIT,0),U,5) I DFN="" Q
  1.  ... S VDATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I VDATE=0 Q
  1.  ... S @TDATA@("PT",DFN,VISIT)=VDATE
  1.  ;
  1.  ; For each community alert, set up temporary
  1.  S PT=""
  1.  F  S PT=$O(@TDATA@("PT",PT)) Q:PT=""  D  S CCT=$G(CCT)+1 W:CCT#100=0 "."
  1.  . S ALRT=0
  1.  . F  S ALRT=$O(^BQI(90507.8,ALRT)) Q:'ALRT  D
  1.  .. S TY=$P($G(^BQI(90507.8,ALRT,2)),U,1)
  1.  .. ; Check for taxonomies
  1.  .. S TX=0,QFL=0 K TAX
  1.  .. F  S TX=$O(^BQI(90507.8,ALRT,11,TX)) Q:'TX  D
  1.  ... S TAX=$P(^BQI(90507.8,ALRT,11,TX,0),U,1)
  1.  ... S TREF=$NA(^TMP("BQITAX",UID))
  1.  ... K @TREF
  1.  ... D BLD^BQITUTL(TAX,TREF)
  1.  ... I '$D(@TREF) Q
  1.  ... S ATIEN=0,QFL=1
  1.  ... F  S ATIEN=$O(@TREF@(ATIEN)) Q:ATIEN=""  D SRN(ATIEN,PT)
  1.  .. Q:QFL
  1.  .. Q
  1.  ;
  1.  D EN^BQICAVAL
  1.  Q
  1.  ;
  1. SRN(TIEN,DFN) ; Search through all records
  1.  S VISIT=""
  1.  F  S VISIT=$O(@TDATA@("PT",DFN,VISIT)) Q:VISIT=""  D
  1.  . ;  For each entry TIEN
  1.  . S IEN="",VSDTM=@TDATA@("PT",DFN,VISIT)
  1.  . F  S IEN=$O(^AUPNVPOV("AD",VISIT,IEN),-1) Q:IEN=""  D
  1.  .. ;  if a bad record (no zero node), quit
  1.  .. I $G(^AUPNVPOV(IEN,0))="" Q
  1.  .. I $P(^AUPNVPOV(IEN,0),U,1)'=TIEN Q
  1.  .. S ^XTMP("BQICAVAL",DFN,ALRT,"DX",VSDTM,IEN)=TIEN_U_"9000010.07"
  1.  Q