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

BQICALRT.m

Go to the documentation of this file. 
  1. BQICALRT ;GDIT/HS/ALA-Expanded Community Alerts ; 13 Oct 2011  3:42 PM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
  1.  ;
  1. FND ;EP - Find alerts
  1.  NEW DA,DIK,UID
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  ;
  1.  ; Clear out existing Community Alerts before recalculating them
  1.  S DA=0,DIK="^BQI(90507.6,"
  1.  F  S DA=$O(^BQI(90507.6,DA)) Q:'DA  D ^DIK
  1.  I $D(^BQI(90507.6,-1)) K ^BQI(90507.6,-1)
  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
  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.  ;
  1.  I $G(DT)="" D DT^DICRW
  1.  ;
  1.  ; Set the alert temporary global
  1.  NEW TDATA
  1.  S TDATA=$NA(^TMP("BQIALRTTMP",UID)),DATA=$NA(^TMP("BQIALERT",UID))
  1.  K @TDATA,@DATA
  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.015,IENS,.03,"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
  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 to check for duplicates
  1.  S PT=""
  1.  F  S PT=$O(@TDATA@("PT",PT)) Q:PT=""  D
  1.  . S COMM=$$GET1^DIQ(9000001,PT_",",1117,"I")
  1.  . I COMM="" S COMM="Not identified"
  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.  .. S DEXEC=$G(^BQI(90507.8,ALRT,31))
  1.  .. I DEXEC'="" D
  1.  ... X DEXEC
  1.  .. ; if EXPANDED DEFINITION has an executable
  1.  .. S EXP=+$P($G(^BQI(90507.8,ALRT,2)),U,6) I EXP S EXEC=$G(^BQI(90507.8,ALRT,30))
  1.  .. I EXP D
  1.  ... X EXEC
  1.  ... ; if no result returned from the executable, quit
  1.  ... I $G(RES(1))=0 Q
  1.  ... S DTY=$P(^BQI(90507.8,ALRT,0),U,1),ATY=$P($G(^BQI(90507.8,ALRT,2)),U,1)
  1.  ... ; save the result
  1.  ... S N=0 F  S N=$O(RES(N)) Q:N=""  D
  1.  .... S SDATA=RES(N)
  1.  .... S VISIT=$P(SDATA,U,4),VSDTM=$P(SDATA,U,2),IEN=$P(SDATA,U,5),FILE=$P(SDATA,U,7),TIEN=$P(SDATA,U,6)
  1.  .... S ZZ=$S(FILE=9000010.01:"MS",FILE=9000010.12:"SK",1:"LB")
  1.  .... S @DATA@(COMM,ALRT,PT,ZZ,VSDTM,TIEN)=VISIT_U_IEN_U_FILE
  1.  .. I $G(DEXEC)'="" Q
  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.  ... K @TREF
  1.  .. Q:QFL
  1.  .. ; Check for SNOMED subsets
  1.  .. NEW BQISUB,SN,BQIOK,SNIEN
  1.  .. S SN=0
  1.  .. F  S SN=$O(^BQI(90507.8,ALRT,13,SN)) Q:'SN  D
  1.  ... S TREF=$NA(^TMP("BQISNOM",$J)) K @TREF
  1.  ... S BQISUB=$P(^BQI(90507.8,ALRT,13,SN,0),U,1)
  1.  ... S BQIOK=$$SUBLST^BSTSAPI(TREF,BQISUB_"^36^1")
  1.  ... I 'BQIOK Q
  1.  ... S SNIEN=""
  1.  ... F  S SNIEN=$O(@TREF@(SNIEN)) Q:SNIEN=""  D
  1.  .... S SCID=$P(@TREF@(SNIEN),U,1)
  1.  .... D SNS(SCID,PT)
  1.  ;
  1.  ; Check for duplicates
  1.  NEW LDTE
  1.  S (CM,TY,PT)=""
  1.  F  S CM=$O(@DATA@(CM)) Q:CM=""  D
  1.  . F  S TY=$O(@DATA@(CM,TY)) Q:TY=""  D
  1.  .. F  S PT=$O(@DATA@(CM,TY,PT)) Q:PT=""  D
  1.  ... S DTE=$O(@DATA@(CM,TY,PT,"DX",""),-1) Q:DTE=""
  1.  ... S LDTE=$$FMADD^XLFDT(DTE,-30)
  1.  ... F  S DTE=$O(@DATA@(CM,TY,PT,"DX",DTE),-1) Q:DTE=""  D
  1.  .... ; Only one alert type per patient per 30 day period should be included
  1.  .... I DTE>LDTE K @DATA@(CM,TY,PT,"DX",DTE) Q
  1.  .... S LDTE=$$FMADD^XLFDT(DTE,-30)
  1.  ... S DTE=$O(@DATA@(CM,TY,PT,"LB",""),-1) Q:DTE=""
  1.  ... S LDTE=$$FMADD^XLFDT(DTE,-30)
  1.  ... F  S DTE=$O(@DATA@(CM,TY,PT,"LB",DTE),-1) Q:DTE=""  D
  1.  .... I DTE>LDTE K @DATA@(CM,TY,PT,"LB",DTE) Q
  1.  .... S LDTE=$$FMADD^XLFDT(DTE,-30)
  1.  ;
  1.  S CM=""
  1.  F  S CM=$O(@DATA@(CM)) Q:CM=""  D
  1.  . S TY=""
  1.  . F  S TY=$O(@DATA@(CM,TY)) Q:TY=""  D
  1.  .. S DTY=$P(^BQI(90507.8,TY,0),U,1),ATY=$P($G(^BQI(90507.8,TY,2)),U,1)
  1.  .. S REP=$P($G(^BQI(90507.8,TY,2)),U,5)
  1.  .. ;
  1.  .. S TME=$S(REP=1:"T-61",REP=2:"T-183",REP=3:"T-365",1:"")
  1.  .. K TAX
  1.  .. S TX=0,QFL=0
  1.  .. F  S TX=$O(^BQI(90507.8,TY,11,TX)) Q:'TX  D
  1.  ... S TAX=$P(^BQI(90507.8,TY,11,TX,0),U,1)
  1.  .. S PT=""
  1.  .. F  S PT=$O(@DATA@(CM,TY,PT)) Q:PT=""  D
  1.  ... I $G(TAX)'="" S HAS=$$TAX^BQICAUTL(TME,TAX,2,PT,9000010.07,1,0)
  1.  ... I $G(TAX)="" D
  1.  .... S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  .... S N=0
  1.  .... F  S N=$O(^BQI(90507.8,TY,10,N)) Q:'N  D
  1.  ..... S IEN=$P(^BQI(90507.8,TY,10,N,0),U,1),COD=$P(^(0),U,2),@TREF@(IEN)=COD
  1.  .... S HAS=$$TAX^BQICAUTL(TME,"",2,PT,9000010.07,0,0,.TREF)
  1.  ... S DTE=""
  1.  ... F  S DTE=$O(@DATA@(CM,TY,PT,"DX",DTE)) Q:DTE=""  D
  1.  .... S DXN=""
  1.  .... F  S DXN=$O(@DATA@(CM,TY,PT,"DX",DTE,DXN)) Q:DXN=""  D
  1.  ..... I $$VERSION^XPDUTL("BCSV") S DXCC=$$ICD9^BQIUL3(DXN,(DTE\1),2) ; csv
  1.  ..... I '$$VERSION^XPDUTL("BCSV") S DXCC=$$GET1^DIQ(80,DXN_",",.01,"E")
  1.  ..... I DXCC="" Q
  1.  ..... S VISIT=$P(@DATA@(CM,TY,PT,"DX",DTE,DXN),U,1)
  1.  ..... I $P(HAS,U,1)=1 Q
  1.  ..... D NFILE(CM,DTY,DXCC,DTE,VISIT,PT,ATY,@DATA@(CM,TY,PT,"DX",DTE,DXN))
  1.  ... S DTE=""
  1.  ... F  S DTE=$O(@DATA@(CM,TY,PT,"LB",DTE)) Q:DTE=""  D
  1.  .... S LBT=""
  1.  .... F  S LBT=$O(@DATA@(CM,TY,PT,"LB",DTE,LBT)) Q:LBT=""  D
  1.  ..... S VISIT=$P(@DATA@(CM,TY,PT,"LB",DTE,LBT),U,1)
  1.  ..... D NLAB(CM,DTY,VISIT,PT,ATY,LBT,@DATA@(CM,TY,PT,"LB",DTE,LBT))
  1.  ;
  1.  K @DATA,@TDATA
  1.  Q
  1.  ;
  1. NFILE(COMM,DCAT,DXC,DATE,VISIT,PT,ATYP,SDATA) ;
  1.  ; Input
  1.  ;   COMM  - Community
  1.  ;   DCAT  - Diagnosis Category
  1.  ;   DXC   - Diagnosis Code
  1.  ;   DATE  - Event Date
  1.  ;   PT    - DFN
  1.  ;   ATYP  - Passed Alert Type
  1.  ;   SDATA - Data
  1.  ;
  1.  NEW DIC,DA,D,NFLG
  1.  ;  Set the community
  1.  S DIC="^BQI(90507.6,",X="`"_COMM,DIC(0)="LMZ"
  1.  D ^DIC
  1.  S CIEN=+Y
  1.  I CIEN=-1 S (X,DINUM)=COMM K DO,DD D FILE^DICN S CIEN=+Y
  1.  ;  Set the Alert Type
  1.  S DA(1)=CIEN,X=ATYP,DIC="^BQI(90507.6,"_DA(1)_",1,",DIC(0)="LMN"
  1.  I $G(^BQI(90507.6,DA(1),1,0))="" S ^BQI(90507.6,DA(1),1,0)="^90507.61A^^"
  1.  D ^DIC
  1.  S AIEN=+Y
  1.  ;  Set the DX Category
  1.  S DA(2)=CIEN,DA(1)=AIEN,X=DCAT,DIC(0)="LMN"
  1.  S DIC="^BQI(90507.6,"_DA(2)_",1,"_DA(1)_",1,"
  1.  I $G(^BQI(90507.6,DA(2),1,DA(1),1,0))="" S ^BQI(90507.6,DA(2),1,DA(1),1,0)="^90507.611A^^"
  1.  D ^DIC
  1.  S DIEN=+Y
  1.  ;  Set the Dx Code
  1.  K X
  1.  ;S DA(3)=CIEN,DA(2)=AIEN,DA(1)=DIEN,X(1)=DXC,X(2)=DATE,X(3)=VISIT,DIC(0)="LN",D="C"
  1.  S DA(3)=CIEN,DA(2)=AIEN,DA(1)=DIEN,X(1)=PT,X(2)=DATE,X(3)=VISIT,DIC(0)="LN",D="D"
  1.  S DIC="^BQI(90507.6,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
  1.  I $G(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,0))="" S ^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,0)="^90507.6111A^^"
  1.  D IX^DIC
  1.  I Y=-1 D
  1.  . K X,D
  1.  . S X(1)=DXC,X(2)=DATE,X(3)=VISIT,D="C"
  1.  . ;S X(1)=DXC,X(2)=DATE,X(3)=VISIT,D="D"
  1.  . D IX^DIC
  1.  S (RIEN,DA)=+Y,NFLG=+$P(Y,U,3)
  1.  ;S $P(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,RIEN,0),U,4)=PT
  1.  ;S $P(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,RIEN,0),U,5)=9000010
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90507.6111,IENS,.02)=DTE
  1.  S BQIUPD(90507.6111,IENS,.03)=$P(SDATA,U,2)
  1.  S BQIUPD(90507.6111,IENS,.04)=PT
  1.  S BQIUPD(90507.6111,IENS,.05)=$P(SDATA,U,3)
  1.  S BQIUPD(90507.6111,IENS,.06)=VISIT
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  NEW DIK
  1.  S DIK=DIC,DIK(1)=.04
  1.  D ENALL^DIK
  1.  Q
  1.  ;
  1. SRC(TIEN) ; Search through all records
  1.  ;  For each entry TIEN
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPNVPOV("B",TIEN,IEN),-1) Q:IEN=""  D
  1.  . ;  if a bad record (no zero node), quit
  1.  . I $G(^AUPNVPOV(IEN,0))="" Q
  1.  . ;  get patient record
  1.  . S DFN=$P(^AUPNVPOV(IEN,0),U,2) Q:DFN=""
  1.  . S VISIT=$P(^AUPNVPOV(IEN,0),U,3) I VISIT="" Q
  1.  . I $G(^AUPNVSIT(VISIT,0))="" Q
  1.  . I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  . S VSDTM=$P(^AUPNVSIT(VISIT,0),U,1)\1 I VSDTM=0 Q
  1.  . S ENDT=DT,STDT=$$DATE^BQIUL1(TMFRAME)
  1.  . I $G(TMFRAME)'="",VSDTM'>STDT Q
  1.  . ;I $G(TMFRAME)'="",VSDTM<STDT Q
  1.  . S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
  1.  . I COMM="" S COMM="Not identified"
  1.  . S @DATA@(COMM,ALRT,DFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010"
  1.  Q
  1.  ;
  1. SUP ; File Supporting Data
  1.  K X,DA
  1.  S X=$S($P(SDATA,U,7)=9000010.01:"Measurement",1:"Lab")
  1.  S DA(4)=CIEN,DA(3)=AIEN,DA(2)=DIEN,DA(1)=RIEN,DIC(0)="LN"
  1.  S DIC="^BQI(90507.6,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
  1.  I $G(^BQI(90507.6,DA(4),1,DA(3),1,DA(2),1,DA(1),1,0))="" S ^BQI(90507.6,DA(4),1,DA(3),1,DA(2),1,DA(1),1,0)="^90507.61111^^"
  1.  D FILE^DICN
  1.  S (SIEN,DA)=+Y
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90507.61111,IENS,.04)=$P(SDATA,U,7)
  1.  S BQIUPD(90507.61111,IENS,.02)=$P(SDATA,U,2)
  1.  S BQIUPD(90507.61111,IENS,.03)=$P(SDATA,U,5)
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  Q
  1.  ;
  1. NLAB(COMM,DCAT,VISIT,PT,ATYP,LIEN,SDATA) ;
  1.  ; Input
  1.  ;   COMM  - Community
  1.  ;   DCAT  - Diagnosis Category
  1.  ;   VISIT - Visit IEN
  1.  ;   PT    - DFN
  1.  ;   ATYP  - Passed Alert Type
  1.  ;   LIEN  - Lab Test IEN
  1.  ;   SDATA - Information
  1.  ;
  1.  NEW DIC,DA,D,NFLG
  1.  ;  Set the community
  1.  S DIC="^BQI(90507.6,",X="`"_COMM,DIC(0)="LMZ"
  1.  D ^DIC
  1.  S CIEN=+Y
  1.  I CIEN=-1 S (X,DINUM)=COMM K DO,DD D FILE^DICN S CIEN=+Y
  1.  ;  Set the Alert Type
  1.  S DA(1)=CIEN,X=ATYP,DIC="^BQI(90507.6,"_DA(1)_",1,",DIC(0)="LMN"
  1.  I $G(^BQI(90507.6,DA(1),1,0))="" S ^BQI(90507.6,DA(1),1,0)="^90507.61A^^"
  1.  D ^DIC
  1.  S AIEN=+Y
  1.  ;  Set the DX Category
  1.  S DA(2)=CIEN,DA(1)=AIEN,X=DCAT,DIC(0)="LMN"
  1.  S DIC="^BQI(90507.6,"_DA(2)_",1,"_DA(1)_",1,"
  1.  I $G(^BQI(90507.6,DA(2),1,DA(1),1,0))="" S ^BQI(90507.6,DA(2),1,DA(1),1,0)="^90507.611A^^"
  1.  D ^DIC
  1.  S DIEN=+Y
  1.  ;  Set the Lab
  1.  S DA(3)=CIEN,DA(2)=AIEN,DA(1)=DIEN,X=LIEN,DIC(0)="LMN"
  1.  S DIC="^BQI(90507.6,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",2,"
  1.  I $G(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),2,0))="" S ^BQI(90507.6,DA(3),1,DA(2),1,DA(1),2,0)="^90507.6112^^"
  1.  D FILE^DICN
  1.  S DA=+Y
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90507.6112,IENS,.02)=DTE
  1.  S BQIUPD(90507.6112,IENS,.03)=$P(SDATA,U,2)
  1.  S BQIUPD(90507.6112,IENS,.04)=PT
  1.  S BQIUPD(90507.6112,IENS,.05)=$P(SDATA,U,3)
  1.  S BQIUPD(90507.6112,IENS,.06)=VISIT
  1.  D FILE^DIE("","BQIUPD","ERROR")
  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 @DATA@(COMM,ALRT,DFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.07"
  1.  Q
  1.  ;
  1. SNS(BQCID,DFN) ;EP - Look by concept ID
  1.  S VISIT=""
  1.  F  S VISIT=$O(@TDATA@("PT",DFN,VISIT)) Q:VISIT=""  D
  1.  . ;  For each entry CONCEPT ID
  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($G(^AUPNVPOV(IEN,11)),U,1)'=BQCID Q
  1.  .. S @DATA@(COMM,ALRT,DFN,"DX",VSDTM,BQCID)=VISIT_U_IEN_U_"9000010.07"
  1.  Q