BQICALRT ;GDIT/HS/ALA-Expanded Community Alerts ; 13 Oct 2011 3:42 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
FND ;EP - Find alerts
NEW DA,DIK,UID
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;
; Clear out existing Community Alerts before recalculating them
S DA=0,DIK="^BQI(90507.6,"
F S DA=$O(^BQI(90507.6,DA)) Q:'DA D ^DIK
I $D(^BQI(90507.6,-1)) K ^BQI(90507.6,-1)
;
; Find clinics for primary care
NEW TREF,TAX,PREF,TMFRAME,STDT,ENDT,ALRT,BGDA,BGI,BGPC,BGPCI,A,DATA
NEW ATIEN,CM,TY,PT,DTE,DXN,DXCC,CIEN,DIEN,RIEN,XIEN,E,EXEC,G,IEN
NEW OK,PCL,SIEN,V,VISIT,VSDTM,X,Y,COMM,DFN,DOD,DTY,ATY,SDATA,AIEN
NEW LBT,VCLIN,BDT,BDXX,BGDT,BQIN,BSXX,CT,DEXEC,EDT,EXP,FILE,FLAG,I
NEW N,OPER,OPER2,OVALUE,RES,RES2,RN,TIEN,TYP,VCAT,VDATE,VFL,X,Y,ZZ
;
I $G(DT)="" D DT^DICRW
;
; Set the alert temporary global
NEW TDATA
S TDATA=$NA(^TMP("BQIALRTTMP",UID)),DATA=$NA(^TMP("BQIALERT",UID))
K @TDATA,@DATA
;
NEW DA,IENS,BQIH,BQI,TX,QFL,REP,TME,HAS
S BQIH=$$SPM^BQIGPUTL(),BQIN=0
F S BQIN=$O(^BQI(90508,BQIH,15,BQIN)) Q:'BQIN D
. NEW DA,IENS
. S DA(1)=BQIH,DA=BQIN,IENS=$$IENS^DILF(.DA)
. S TMFRAME="T-"_$$GET1^DIQ(90508.015,IENS,.03,"E")
. S TY=$$GET1^DIQ(90508.015,IENS,.01,"E")
. S ENDT=DT,STDT=$$DATE^BQIUL1(TMFRAME)
. S TYP(TY)=ENDT_U_STDT
S TY=""
F S TY=$O(TYP(TY)) Q:TY="" D
. S BGDT=$P(TYP(TY),U,2)-.0001,ENDT=$P(TYP(TY),U,1),STDT=$P(TYP(TY),U,2)
. F S BGDT=$O(^AUPNVSIT("B",BGDT)) Q:BGDT=""!(BGDT\1>ENDT) D
.. S VISIT=""
.. F S VISIT=$O(^AUPNVSIT("B",BGDT,VISIT)) Q:VISIT="" D
... I $P(^AUPNVSIT(VISIT,0),U,11)=1 Q
... S VCAT=$P(^AUPNVSIT(VISIT,0),U,7)
... I VCAT'="A",VCAT'="C",VCAT'="H",VCAT'="T" Q
... S DFN=$P(^AUPNVSIT(VISIT,0),U,5) I DFN="" Q
... S VDATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I VDATE=0 Q
... S @TDATA@("PT",DFN,VISIT)=VDATE
;
; For each community alert, set up temporary to check for duplicates
S PT=""
F S PT=$O(@TDATA@("PT",PT)) Q:PT="" D
. S COMM=$$GET1^DIQ(9000001,PT_",",1117,"I")
. I COMM="" S COMM="Not identified"
. S ALRT=0
. F S ALRT=$O(^BQI(90507.8,ALRT)) Q:'ALRT D
.. S TY=$P($G(^BQI(90507.8,ALRT,2)),U,1)
.. S DEXEC=$G(^BQI(90507.8,ALRT,31))
.. I DEXEC'="" D
... X DEXEC
.. ; if EXPANDED DEFINITION has an executable
.. S EXP=+$P($G(^BQI(90507.8,ALRT,2)),U,6) I EXP S EXEC=$G(^BQI(90507.8,ALRT,30))
.. I EXP D
... X EXEC
... ; if no result returned from the executable, quit
... I $G(RES(1))=0 Q
... S DTY=$P(^BQI(90507.8,ALRT,0),U,1),ATY=$P($G(^BQI(90507.8,ALRT,2)),U,1)
... ; save the result
... S N=0 F S N=$O(RES(N)) Q:N="" D
.... S SDATA=RES(N)
.... 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)
.... S ZZ=$S(FILE=9000010.01:"MS",FILE=9000010.12:"SK",1:"LB")
.... S @DATA@(COMM,ALRT,PT,ZZ,VSDTM,TIEN)=VISIT_U_IEN_U_FILE
.. I $G(DEXEC)'="" Q
.. ; Check for taxonomies
.. S TX=0,QFL=0 K TAX
.. F S TX=$O(^BQI(90507.8,ALRT,11,TX)) Q:'TX D
... S TAX=$P(^BQI(90507.8,ALRT,11,TX,0),U,1)
... S TREF=$NA(^TMP("BQITAX",UID))
... K @TREF
... D BLD^BQITUTL(TAX,TREF)
... I '$D(@TREF) Q
... S ATIEN=0,QFL=1
... F S ATIEN=$O(@TREF@(ATIEN)) Q:ATIEN="" D SRN(ATIEN,PT)
... K @TREF
.. Q:QFL
.. ; Check for SNOMED subsets
.. NEW BQISUB,SN,BQIOK,SNIEN
.. S SN=0
.. F S SN=$O(^BQI(90507.8,ALRT,13,SN)) Q:'SN D
... S TREF=$NA(^TMP("BQISNOM",$J)) K @TREF
... S BQISUB=$P(^BQI(90507.8,ALRT,13,SN,0),U,1)
... S BQIOK=$$SUBLST^BSTSAPI(TREF,BQISUB_"^36^1")
... I 'BQIOK Q
... S SNIEN=""
... F S SNIEN=$O(@TREF@(SNIEN)) Q:SNIEN="" D
.... S SCID=$P(@TREF@(SNIEN),U,1)
.... D SNS(SCID,PT)
;
; Check for duplicates
NEW LDTE
S (CM,TY,PT)=""
F S CM=$O(@DATA@(CM)) Q:CM="" D
. F S TY=$O(@DATA@(CM,TY)) Q:TY="" D
.. F S PT=$O(@DATA@(CM,TY,PT)) Q:PT="" D
... S DTE=$O(@DATA@(CM,TY,PT,"DX",""),-1) Q:DTE=""
... S LDTE=$$FMADD^XLFDT(DTE,-30)
... F S DTE=$O(@DATA@(CM,TY,PT,"DX",DTE),-1) Q:DTE="" D
.... ; Only one alert type per patient per 30 day period should be included
.... I DTE>LDTE K @DATA@(CM,TY,PT,"DX",DTE) Q
.... S LDTE=$$FMADD^XLFDT(DTE,-30)
... S DTE=$O(@DATA@(CM,TY,PT,"LB",""),-1) Q:DTE=""
... S LDTE=$$FMADD^XLFDT(DTE,-30)
... F S DTE=$O(@DATA@(CM,TY,PT,"LB",DTE),-1) Q:DTE="" D
.... I DTE>LDTE K @DATA@(CM,TY,PT,"LB",DTE) Q
.... S LDTE=$$FMADD^XLFDT(DTE,-30)
;
S CM=""
F S CM=$O(@DATA@(CM)) Q:CM="" D
. S TY=""
. F S TY=$O(@DATA@(CM,TY)) Q:TY="" D
.. S DTY=$P(^BQI(90507.8,TY,0),U,1),ATY=$P($G(^BQI(90507.8,TY,2)),U,1)
.. S REP=$P($G(^BQI(90507.8,TY,2)),U,5)
.. ;
.. S TME=$S(REP=1:"T-61",REP=2:"T-183",REP=3:"T-365",1:"")
.. K TAX
.. S TX=0,QFL=0
.. F S TX=$O(^BQI(90507.8,TY,11,TX)) Q:'TX D
... S TAX=$P(^BQI(90507.8,TY,11,TX,0),U,1)
.. S PT=""
.. F S PT=$O(@DATA@(CM,TY,PT)) Q:PT="" D
... I $G(TAX)'="" S HAS=$$TAX^BQICAUTL(TME,TAX,2,PT,9000010.07,1,0)
... I $G(TAX)="" D
.... S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
.... S N=0
.... F S N=$O(^BQI(90507.8,TY,10,N)) Q:'N D
..... S IEN=$P(^BQI(90507.8,TY,10,N,0),U,1),COD=$P(^(0),U,2),@TREF@(IEN)=COD
.... S HAS=$$TAX^BQICAUTL(TME,"",2,PT,9000010.07,0,0,.TREF)
... S DTE=""
... F S DTE=$O(@DATA@(CM,TY,PT,"DX",DTE)) Q:DTE="" D
.... S DXN=""
.... F S DXN=$O(@DATA@(CM,TY,PT,"DX",DTE,DXN)) Q:DXN="" D
..... I $$VERSION^XPDUTL("BCSV") S DXCC=$$ICD9^BQIUL3(DXN,(DTE\1),2) ; csv
..... I '$$VERSION^XPDUTL("BCSV") S DXCC=$$GET1^DIQ(80,DXN_",",.01,"E")
..... I DXCC="" Q
..... S VISIT=$P(@DATA@(CM,TY,PT,"DX",DTE,DXN),U,1)
..... I $P(HAS,U,1)=1 Q
..... D NFILE(CM,DTY,DXCC,DTE,VISIT,PT,ATY,@DATA@(CM,TY,PT,"DX",DTE,DXN))
... S DTE=""
... F S DTE=$O(@DATA@(CM,TY,PT,"LB",DTE)) Q:DTE="" D
.... S LBT=""
.... F S LBT=$O(@DATA@(CM,TY,PT,"LB",DTE,LBT)) Q:LBT="" D
..... S VISIT=$P(@DATA@(CM,TY,PT,"LB",DTE,LBT),U,1)
..... D NLAB(CM,DTY,VISIT,PT,ATY,LBT,@DATA@(CM,TY,PT,"LB",DTE,LBT))
;
K @DATA,@TDATA
Q
;
NFILE(COMM,DCAT,DXC,DATE,VISIT,PT,ATYP,SDATA) ;
; Input
; COMM - Community
; DCAT - Diagnosis Category
; DXC - Diagnosis Code
; DATE - Event Date
; PT - DFN
; ATYP - Passed Alert Type
; SDATA - Data
;
NEW DIC,DA,D,NFLG
; Set the community
S DIC="^BQI(90507.6,",X="`"_COMM,DIC(0)="LMZ"
D ^DIC
S CIEN=+Y
I CIEN=-1 S (X,DINUM)=COMM K DO,DD D FILE^DICN S CIEN=+Y
; Set the Alert Type
S DA(1)=CIEN,X=ATYP,DIC="^BQI(90507.6,"_DA(1)_",1,",DIC(0)="LMN"
I $G(^BQI(90507.6,DA(1),1,0))="" S ^BQI(90507.6,DA(1),1,0)="^90507.61A^^"
D ^DIC
S AIEN=+Y
; Set the DX Category
S DA(2)=CIEN,DA(1)=AIEN,X=DCAT,DIC(0)="LMN"
S DIC="^BQI(90507.6,"_DA(2)_",1,"_DA(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^^"
D ^DIC
S DIEN=+Y
; Set the Dx Code
K X
;S DA(3)=CIEN,DA(2)=AIEN,DA(1)=DIEN,X(1)=DXC,X(2)=DATE,X(3)=VISIT,DIC(0)="LN",D="C"
S DA(3)=CIEN,DA(2)=AIEN,DA(1)=DIEN,X(1)=PT,X(2)=DATE,X(3)=VISIT,DIC(0)="LN",D="D"
S DIC="^BQI(90507.6,"_DA(3)_",1,"_DA(2)_",1,"_DA(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^^"
D IX^DIC
I Y=-1 D
. K X,D
. S X(1)=DXC,X(2)=DATE,X(3)=VISIT,D="C"
. ;S X(1)=DXC,X(2)=DATE,X(3)=VISIT,D="D"
. D IX^DIC
S (RIEN,DA)=+Y,NFLG=+$P(Y,U,3)
;S $P(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,RIEN,0),U,4)=PT
;S $P(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,RIEN,0),U,5)=9000010
S IENS=$$IENS^DILF(.DA)
S BQIUPD(90507.6111,IENS,.02)=DTE
S BQIUPD(90507.6111,IENS,.03)=$P(SDATA,U,2)
S BQIUPD(90507.6111,IENS,.04)=PT
S BQIUPD(90507.6111,IENS,.05)=$P(SDATA,U,3)
S BQIUPD(90507.6111,IENS,.06)=VISIT
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
NEW DIK
S DIK=DIC,DIK(1)=.04
D ENALL^DIK
Q
;
SRC(TIEN) ; Search through all records
; For each entry TIEN
S IEN=""
F S IEN=$O(^AUPNVPOV("B",TIEN,IEN),-1) Q:IEN="" D
. ; if a bad record (no zero node), quit
. I $G(^AUPNVPOV(IEN,0))="" Q
. ; get patient record
. S DFN=$P(^AUPNVPOV(IEN,0),U,2) Q:DFN=""
. S VISIT=$P(^AUPNVPOV(IEN,0),U,3) I VISIT="" Q
. I $G(^AUPNVSIT(VISIT,0))="" Q
. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
. S VSDTM=$P(^AUPNVSIT(VISIT,0),U,1)\1 I VSDTM=0 Q
. S ENDT=DT,STDT=$$DATE^BQIUL1(TMFRAME)
. I $G(TMFRAME)'="",VSDTM'>STDT Q
. ;I $G(TMFRAME)'="",VSDTM<STDT Q
. S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
. I COMM="" S COMM="Not identified"
. S @DATA@(COMM,ALRT,DFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010"
Q
;
SUP ; File Supporting Data
K X,DA
S X=$S($P(SDATA,U,7)=9000010.01:"Measurement",1:"Lab")
S DA(4)=CIEN,DA(3)=AIEN,DA(2)=DIEN,DA(1)=RIEN,DIC(0)="LN"
S DIC="^BQI(90507.6,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",1,"_DA(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^^"
D FILE^DICN
S (SIEN,DA)=+Y
S IENS=$$IENS^DILF(.DA)
S BQIUPD(90507.61111,IENS,.04)=$P(SDATA,U,7)
S BQIUPD(90507.61111,IENS,.02)=$P(SDATA,U,2)
S BQIUPD(90507.61111,IENS,.03)=$P(SDATA,U,5)
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
Q
;
NLAB(COMM,DCAT,VISIT,PT,ATYP,LIEN,SDATA) ;
; Input
; COMM - Community
; DCAT - Diagnosis Category
; VISIT - Visit IEN
; PT - DFN
; ATYP - Passed Alert Type
; LIEN - Lab Test IEN
; SDATA - Information
;
NEW DIC,DA,D,NFLG
; Set the community
S DIC="^BQI(90507.6,",X="`"_COMM,DIC(0)="LMZ"
D ^DIC
S CIEN=+Y
I CIEN=-1 S (X,DINUM)=COMM K DO,DD D FILE^DICN S CIEN=+Y
; Set the Alert Type
S DA(1)=CIEN,X=ATYP,DIC="^BQI(90507.6,"_DA(1)_",1,",DIC(0)="LMN"
I $G(^BQI(90507.6,DA(1),1,0))="" S ^BQI(90507.6,DA(1),1,0)="^90507.61A^^"
D ^DIC
S AIEN=+Y
; Set the DX Category
S DA(2)=CIEN,DA(1)=AIEN,X=DCAT,DIC(0)="LMN"
S DIC="^BQI(90507.6,"_DA(2)_",1,"_DA(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^^"
D ^DIC
S DIEN=+Y
; Set the Lab
S DA(3)=CIEN,DA(2)=AIEN,DA(1)=DIEN,X=LIEN,DIC(0)="LMN"
S DIC="^BQI(90507.6,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",2,"
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^^"
D FILE^DICN
S DA=+Y
S IENS=$$IENS^DILF(.DA)
S BQIUPD(90507.6112,IENS,.02)=DTE
S BQIUPD(90507.6112,IENS,.03)=$P(SDATA,U,2)
S BQIUPD(90507.6112,IENS,.04)=PT
S BQIUPD(90507.6112,IENS,.05)=$P(SDATA,U,3)
S BQIUPD(90507.6112,IENS,.06)=VISIT
D FILE^DIE("","BQIUPD","ERROR")
Q
;
SRN(TIEN,DFN) ; Search through all records
S VISIT=""
F S VISIT=$O(@TDATA@("PT",DFN,VISIT)) Q:VISIT="" D
. ; For each entry TIEN
. S IEN="",VSDTM=@TDATA@("PT",DFN,VISIT)
. F S IEN=$O(^AUPNVPOV("AD",VISIT,IEN),-1) Q:IEN="" D
.. ; if a bad record (no zero node), quit
.. I $G(^AUPNVPOV(IEN,0))="" Q
.. I $P(^AUPNVPOV(IEN,0),U,1)'=TIEN Q
.. S @DATA@(COMM,ALRT,DFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.07"
Q
;
SNS(BQCID,DFN) ;EP - Look by concept ID
S VISIT=""
F S VISIT=$O(@TDATA@("PT",DFN,VISIT)) Q:VISIT="" D
. ; For each entry CONCEPT ID
. S IEN="",VSDTM=@TDATA@("PT",DFN,VISIT)
. F S IEN=$O(^AUPNVPOV("AD",VISIT,IEN),-1) Q:IEN="" D
.. ; if a bad record (no zero node), quit
.. I $G(^AUPNVPOV(IEN,0))="" Q
.. I $P($G(^AUPNVPOV(IEN,11)),U,1)'=BQCID Q
.. S @DATA@(COMM,ALRT,DFN,"DX",VSDTM,BQCID)=VISIT_U_IEN_U_"9000010.07"
Q
BQICALRT ;GDIT/HS/ALA-Expanded Community Alerts ; 13 Oct 2011 3:42 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
FND ;EP - Find alerts
+1 NEW DA,DIK,UID
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 ;
+4 ; Clear out existing Community Alerts before recalculating them
+5 SET DA=0
SET DIK="^BQI(90507.6,"
+6 FOR
SET DA=$ORDER(^BQI(90507.6,DA))
IF 'DA
QUIT
DO ^DIK
+7 IF $DATA(^BQI(90507.6,-1))
KILL ^BQI(90507.6,-1)
+8 ;
+9 ; Find clinics for primary care
+10 NEW TREF,TAX,PREF,TMFRAME,STDT,ENDT,ALRT,BGDA,BGI,BGPC,BGPCI,A,DATA
+11 NEW ATIEN,CM,TY,PT,DTE,DXN,DXCC,CIEN,DIEN,RIEN,XIEN,E,EXEC,G,IEN
+12 NEW OK,PCL,SIEN,V,VISIT,VSDTM,X,Y,COMM,DFN,DOD,DTY,ATY,SDATA,AIEN
+13 NEW LBT,VCLIN,BDT,BDXX,BGDT,BQIN,BSXX,CT,DEXEC,EDT,EXP,FILE,FLAG,I
+14 NEW N,OPER,OPER2,OVALUE,RES,RES2,RN,TIEN,TYP,VCAT,VDATE,VFL,X,Y,ZZ
+15 ;
+16 IF $GET(DT)=""
DO DT^DICRW
+17 ;
+18 ; Set the alert temporary global
+19 NEW TDATA
+20 SET TDATA=$NAME(^TMP("BQIALRTTMP",UID))
SET DATA=$NAME(^TMP("BQIALERT",UID))
+21 KILL @TDATA,@DATA
+22 ;
+23 NEW DA,IENS,BQIH,BQI,TX,QFL,REP,TME,HAS
+24 SET BQIH=$$SPM^BQIGPUTL()
SET BQIN=0
+25 FOR
SET BQIN=$ORDER(^BQI(90508,BQIH,15,BQIN))
IF 'BQIN
QUIT
Begin DoDot:1
+26 NEW DA,IENS
+27 SET DA(1)=BQIH
SET DA=BQIN
SET IENS=$$IENS^DILF(.DA)
+28 SET TMFRAME="T-"_$$GET1^DIQ(90508.015,IENS,.03,"E")
+29 SET TY=$$GET1^DIQ(90508.015,IENS,.01,"E")
+30 SET ENDT=DT
SET STDT=$$DATE^BQIUL1(TMFRAME)
+31 SET TYP(TY)=ENDT_U_STDT
End DoDot:1
+32 SET TY=""
+33 FOR
SET TY=$ORDER(TYP(TY))
IF TY=""
QUIT
Begin DoDot:1
+34 SET BGDT=$PIECE(TYP(TY),U,2)-.0001
SET ENDT=$PIECE(TYP(TY),U,1)
SET STDT=$PIECE(TYP(TY),U,2)
+35 FOR
SET BGDT=$ORDER(^AUPNVSIT("B",BGDT))
IF BGDT=""!(BGDT\1>ENDT)
QUIT
Begin DoDot:2
+36 SET VISIT=""
+37 FOR
SET VISIT=$ORDER(^AUPNVSIT("B",BGDT,VISIT))
IF VISIT=""
QUIT
Begin DoDot:3
+38 IF $PIECE(^AUPNVSIT(VISIT,0),U,11)=1
QUIT
+39 SET VCAT=$PIECE(^AUPNVSIT(VISIT,0),U,7)
+40 IF VCAT'="A"
IF VCAT'="C"
IF VCAT'="H"
IF VCAT'="T"
QUIT
+41 SET DFN=$PIECE(^AUPNVSIT(VISIT,0),U,5)
IF DFN=""
QUIT
+42 SET VDATE=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)\1
IF VDATE=0
QUIT
+43 SET @TDATA@("PT",DFN,VISIT)=VDATE
End DoDot:3
End DoDot:2
End DoDot:1
+44 ;
+45 ; For each community alert, set up temporary to check for duplicates
+46 SET PT=""
+47 FOR
SET PT=$ORDER(@TDATA@("PT",PT))
IF PT=""
QUIT
Begin DoDot:1
+48 SET COMM=$$GET1^DIQ(9000001,PT_",",1117,"I")
+49 IF COMM=""
SET COMM="Not identified"
+50 SET ALRT=0
+51 FOR
SET ALRT=$ORDER(^BQI(90507.8,ALRT))
IF 'ALRT
QUIT
Begin DoDot:2
+52 SET TY=$PIECE($GET(^BQI(90507.8,ALRT,2)),U,1)
+53 SET DEXEC=$GET(^BQI(90507.8,ALRT,31))
+54 IF DEXEC'=""
Begin DoDot:3
+55 XECUTE DEXEC
End DoDot:3
+56 ; if EXPANDED DEFINITION has an executable
+57 SET EXP=+$PIECE($GET(^BQI(90507.8,ALRT,2)),U,6)
IF EXP
SET EXEC=$GET(^BQI(90507.8,ALRT,30))
+58 IF EXP
Begin DoDot:3
+59 XECUTE EXEC
+60 ; if no result returned from the executable, quit
+61 IF $GET(RES(1))=0
QUIT
+62 SET DTY=$PIECE(^BQI(90507.8,ALRT,0),U,1)
SET ATY=$PIECE($GET(^BQI(90507.8,ALRT,2)),U,1)
+63 ; save the result
+64 SET N=0
FOR
SET N=$ORDER(RES(N))
IF N=""
QUIT
Begin DoDot:4
+65 SET SDATA=RES(N)
+66 SET VISIT=$PIECE(SDATA,U,4)
SET VSDTM=$PIECE(SDATA,U,2)
SET IEN=$PIECE(SDATA,U,5)
SET FILE=$PIECE(SDATA,U,7)
SET TIEN=$PIECE(SDATA,U,6)
+67 SET ZZ=$SELECT(FILE=9000010.01:"MS",FILE=9000010.12:"SK",1:"LB")
+68 SET @DATA@(COMM,ALRT,PT,ZZ,VSDTM,TIEN)=VISIT_U_IEN_U_FILE
End DoDot:4
End DoDot:3
+69 IF $GET(DEXEC)'=""
QUIT
+70 ; Check for taxonomies
+71 SET TX=0
SET QFL=0
KILL TAX
+72 FOR
SET TX=$ORDER(^BQI(90507.8,ALRT,11,TX))
IF 'TX
QUIT
Begin DoDot:3
+73 SET TAX=$PIECE(^BQI(90507.8,ALRT,11,TX,0),U,1)
+74 SET TREF=$NAME(^TMP("BQITAX",UID))
+75 KILL @TREF
+76 DO BLD^BQITUTL(TAX,TREF)
+77 IF '$DATA(@TREF)
QUIT
+78 SET ATIEN=0
SET QFL=1
+79 FOR
SET ATIEN=$ORDER(@TREF@(ATIEN))
IF ATIEN=""
QUIT
DO SRN(ATIEN,PT)
+80 KILL @TREF
End DoDot:3
+81 IF QFL
QUIT
+82 ; Check for SNOMED subsets
+83 NEW BQISUB,SN,BQIOK,SNIEN
+84 SET SN=0
+85 FOR
SET SN=$ORDER(^BQI(90507.8,ALRT,13,SN))
IF 'SN
QUIT
Begin DoDot:3
+86 SET TREF=$NAME(^TMP("BQISNOM",$JOB))
KILL @TREF
+87 SET BQISUB=$PIECE(^BQI(90507.8,ALRT,13,SN,0),U,1)
+88 SET BQIOK=$$SUBLST^BSTSAPI(TREF,BQISUB_"^36^1")
+89 IF 'BQIOK
QUIT
+90 SET SNIEN=""
+91 FOR
SET SNIEN=$ORDER(@TREF@(SNIEN))
IF SNIEN=""
QUIT
Begin DoDot:4
+92 SET SCID=$PIECE(@TREF@(SNIEN),U,1)
+93 DO SNS(SCID,PT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+94 ;
+95 ; Check for duplicates
+96 NEW LDTE
+97 SET (CM,TY,PT)=""
+98 FOR
SET CM=$ORDER(@DATA@(CM))
IF CM=""
QUIT
Begin DoDot:1
+99 FOR
SET TY=$ORDER(@DATA@(CM,TY))
IF TY=""
QUIT
Begin DoDot:2
+100 FOR
SET PT=$ORDER(@DATA@(CM,TY,PT))
IF PT=""
QUIT
Begin DoDot:3
+101 SET DTE=$ORDER(@DATA@(CM,TY,PT,"DX",""),-1)
IF DTE=""
QUIT
+102 SET LDTE=$$FMADD^XLFDT(DTE,-30)
+103 FOR
SET DTE=$ORDER(@DATA@(CM,TY,PT,"DX",DTE),-1)
IF DTE=""
QUIT
Begin DoDot:4
+104 ; Only one alert type per patient per 30 day period should be included
+105 IF DTE>LDTE
KILL @DATA@(CM,TY,PT,"DX",DTE)
QUIT
+106 SET LDTE=$$FMADD^XLFDT(DTE,-30)
End DoDot:4
+107 SET DTE=$ORDER(@DATA@(CM,TY,PT,"LB",""),-1)
IF DTE=""
QUIT
+108 SET LDTE=$$FMADD^XLFDT(DTE,-30)
+109 FOR
SET DTE=$ORDER(@DATA@(CM,TY,PT,"LB",DTE),-1)
IF DTE=""
QUIT
Begin DoDot:4
+110 IF DTE>LDTE
KILL @DATA@(CM,TY,PT,"LB",DTE)
QUIT
+111 SET LDTE=$$FMADD^XLFDT(DTE,-30)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+112 ;
+113 SET CM=""
+114 FOR
SET CM=$ORDER(@DATA@(CM))
IF CM=""
QUIT
Begin DoDot:1
+115 SET TY=""
+116 FOR
SET TY=$ORDER(@DATA@(CM,TY))
IF TY=""
QUIT
Begin DoDot:2
+117 SET DTY=$PIECE(^BQI(90507.8,TY,0),U,1)
SET ATY=$PIECE($GET(^BQI(90507.8,TY,2)),U,1)
+118 SET REP=$PIECE($GET(^BQI(90507.8,TY,2)),U,5)
+119 ;
+120 SET TME=$SELECT(REP=1:"T-61",REP=2:"T-183",REP=3:"T-365",1:"")
+121 KILL TAX
+122 SET TX=0
SET QFL=0
+123 FOR
SET TX=$ORDER(^BQI(90507.8,TY,11,TX))
IF 'TX
QUIT
Begin DoDot:3
+124 SET TAX=$PIECE(^BQI(90507.8,TY,11,TX,0),U,1)
End DoDot:3
+125 SET PT=""
+126 FOR
SET PT=$ORDER(@DATA@(CM,TY,PT))
IF PT=""
QUIT
Begin DoDot:3
+127 IF $GET(TAX)'=""
SET HAS=$$TAX^BQICAUTL(TME,TAX,2,PT,9000010.07,1,0)
+128 IF $GET(TAX)=""
Begin DoDot:4
+129 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+130 SET N=0
+131 FOR
SET N=$ORDER(^BQI(90507.8,TY,10,N))
IF 'N
QUIT
Begin DoDot:5
+132 SET IEN=$PIECE(^BQI(90507.8,TY,10,N,0),U,1)
SET COD=$PIECE(^(0),U,2)
SET @TREF@(IEN)=COD
End DoDot:5
+133 SET HAS=$$TAX^BQICAUTL(TME,"",2,PT,9000010.07,0,0,.TREF)
End DoDot:4
+134 SET DTE=""
+135 FOR
SET DTE=$ORDER(@DATA@(CM,TY,PT,"DX",DTE))
IF DTE=""
QUIT
Begin DoDot:4
+136 SET DXN=""
+137 FOR
SET DXN=$ORDER(@DATA@(CM,TY,PT,"DX",DTE,DXN))
IF DXN=""
QUIT
Begin DoDot:5
+138 ; csv
IF $$VERSION^XPDUTL("BCSV")
SET DXCC=$$ICD9^BQIUL3(DXN,(DTE\1),2)
+139 IF '$$VERSION^XPDUTL("BCSV")
SET DXCC=$$GET1^DIQ(80,DXN_",",.01,"E")
+140 IF DXCC=""
QUIT
+141 SET VISIT=$PIECE(@DATA@(CM,TY,PT,"DX",DTE,DXN),U,1)
+142 IF $PIECE(HAS,U,1)=1
QUIT
+143 DO NFILE(CM,DTY,DXCC,DTE,VISIT,PT,ATY,@DATA@(CM,TY,PT,"DX",DTE,DXN))
End DoDot:5
End DoDot:4
+144 SET DTE=""
+145 FOR
SET DTE=$ORDER(@DATA@(CM,TY,PT,"LB",DTE))
IF DTE=""
QUIT
Begin DoDot:4
+146 SET LBT=""
+147 FOR
SET LBT=$ORDER(@DATA@(CM,TY,PT,"LB",DTE,LBT))
IF LBT=""
QUIT
Begin DoDot:5
+148 SET VISIT=$PIECE(@DATA@(CM,TY,PT,"LB",DTE,LBT),U,1)
+149 DO NLAB(CM,DTY,VISIT,PT,ATY,LBT,@DATA@(CM,TY,PT,"LB",DTE,LBT))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+150 ;
+151 KILL @DATA,@TDATA
+152 QUIT
+153 ;
NFILE(COMM,DCAT,DXC,DATE,VISIT,PT,ATYP,SDATA) ;
+1 ; Input
+2 ; COMM - Community
+3 ; DCAT - Diagnosis Category
+4 ; DXC - Diagnosis Code
+5 ; DATE - Event Date
+6 ; PT - DFN
+7 ; ATYP - Passed Alert Type
+8 ; SDATA - Data
+9 ;
+10 NEW DIC,DA,D,NFLG
+11 ; Set the community
+12 SET DIC="^BQI(90507.6,"
SET X="`"_COMM
SET DIC(0)="LMZ"
+13 DO ^DIC
+14 SET CIEN=+Y
+15 IF CIEN=-1
SET (X,DINUM)=COMM
KILL DO,DD
DO FILE^DICN
SET CIEN=+Y
+16 ; Set the Alert Type
+17 SET DA(1)=CIEN
SET X=ATYP
SET DIC="^BQI(90507.6,"_DA(1)_",1,"
SET DIC(0)="LMN"
+18 IF $GET(^BQI(90507.6,DA(1),1,0))=""
SET ^BQI(90507.6,DA(1),1,0)="^90507.61A^^"
+19 DO ^DIC
+20 SET AIEN=+Y
+21 ; Set the DX Category
+22 SET DA(2)=CIEN
SET DA(1)=AIEN
SET X=DCAT
SET DIC(0)="LMN"
+23 SET DIC="^BQI(90507.6,"_DA(2)_",1,"_DA(1)_",1,"
+24 IF $GET(^BQI(90507.6,DA(2),1,DA(1),1,0))=""
SET ^BQI(90507.6,DA(2),1,DA(1),1,0)="^90507.611A^^"
+25 DO ^DIC
+26 SET DIEN=+Y
+27 ; Set the Dx Code
+28 KILL X
+29 ;S DA(3)=CIEN,DA(2)=AIEN,DA(1)=DIEN,X(1)=DXC,X(2)=DATE,X(3)=VISIT,DIC(0)="LN",D="C"
+30 SET DA(3)=CIEN
SET DA(2)=AIEN
SET DA(1)=DIEN
SET X(1)=PT
SET X(2)=DATE
SET X(3)=VISIT
SET DIC(0)="LN"
SET D="D"
+31 SET DIC="^BQI(90507.6,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
+32 IF $GET(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,0))=""
SET ^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,0)="^90507.6111A^^"
+33 DO IX^DIC
+34 IF Y=-1
Begin DoDot:1
+35 KILL X,D
+36 SET X(1)=DXC
SET X(2)=DATE
SET X(3)=VISIT
SET D="C"
+37 ;S X(1)=DXC,X(2)=DATE,X(3)=VISIT,D="D"
+38 DO IX^DIC
End DoDot:1
+39 SET (RIEN,DA)=+Y
SET NFLG=+$PIECE(Y,U,3)
+40 ;S $P(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,RIEN,0),U,4)=PT
+41 ;S $P(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),1,RIEN,0),U,5)=9000010
+42 SET IENS=$$IENS^DILF(.DA)
+43 SET BQIUPD(90507.6111,IENS,.02)=DTE
+44 SET BQIUPD(90507.6111,IENS,.03)=$PIECE(SDATA,U,2)
+45 SET BQIUPD(90507.6111,IENS,.04)=PT
+46 SET BQIUPD(90507.6111,IENS,.05)=$PIECE(SDATA,U,3)
+47 SET BQIUPD(90507.6111,IENS,.06)=VISIT
+48 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+49 ;
+50 NEW DIK
+51 SET DIK=DIC
SET DIK(1)=.04
+52 DO ENALL^DIK
+53 QUIT
+54 ;
SRC(TIEN) ; Search through all records
+1 ; For each entry TIEN
+2 SET IEN=""
+3 FOR
SET IEN=$ORDER(^AUPNVPOV("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+4 ; if a bad record (no zero node), quit
+5 IF $GET(^AUPNVPOV(IEN,0))=""
QUIT
+6 ; get patient record
+7 SET DFN=$PIECE(^AUPNVPOV(IEN,0),U,2)
IF DFN=""
QUIT
+8 SET VISIT=$PIECE(^AUPNVPOV(IEN,0),U,3)
IF VISIT=""
QUIT
+9 IF $GET(^AUPNVSIT(VISIT,0))=""
QUIT
+10 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+11 SET VSDTM=$PIECE(^AUPNVSIT(VISIT,0),U,1)\1
IF VSDTM=0
QUIT
+12 SET ENDT=DT
SET STDT=$$DATE^BQIUL1(TMFRAME)
+13 IF $GET(TMFRAME)'=""
IF VSDTM'>STDT
QUIT
+14 ;I $G(TMFRAME)'="",VSDTM<STDT Q
+15 SET COMM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
+16 IF COMM=""
SET COMM="Not identified"
+17 SET @DATA@(COMM,ALRT,DFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010"
End DoDot:1
+18 QUIT
+19 ;
SUP ; File Supporting Data
+1 KILL X,DA
+2 SET X=$SELECT($PIECE(SDATA,U,7)=9000010.01:"Measurement",1:"Lab")
+3 SET DA(4)=CIEN
SET DA(3)=AIEN
SET DA(2)=DIEN
SET DA(1)=RIEN
SET DIC(0)="LN"
+4 SET DIC="^BQI(90507.6,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
+5 IF $GET(^BQI(90507.6,DA(4),1,DA(3),1,DA(2),1,DA(1),1,0))=""
SET ^BQI(90507.6,DA(4),1,DA(3),1,DA(2),1,DA(1),1,0)="^90507.61111^^"
+6 DO FILE^DICN
+7 SET (SIEN,DA)=+Y
+8 SET IENS=$$IENS^DILF(.DA)
+9 SET BQIUPD(90507.61111,IENS,.04)=$PIECE(SDATA,U,7)
+10 SET BQIUPD(90507.61111,IENS,.02)=$PIECE(SDATA,U,2)
+11 SET BQIUPD(90507.61111,IENS,.03)=$PIECE(SDATA,U,5)
+12 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+13 QUIT
+14 ;
NLAB(COMM,DCAT,VISIT,PT,ATYP,LIEN,SDATA) ;
+1 ; Input
+2 ; COMM - Community
+3 ; DCAT - Diagnosis Category
+4 ; VISIT - Visit IEN
+5 ; PT - DFN
+6 ; ATYP - Passed Alert Type
+7 ; LIEN - Lab Test IEN
+8 ; SDATA - Information
+9 ;
+10 NEW DIC,DA,D,NFLG
+11 ; Set the community
+12 SET DIC="^BQI(90507.6,"
SET X="`"_COMM
SET DIC(0)="LMZ"
+13 DO ^DIC
+14 SET CIEN=+Y
+15 IF CIEN=-1
SET (X,DINUM)=COMM
KILL DO,DD
DO FILE^DICN
SET CIEN=+Y
+16 ; Set the Alert Type
+17 SET DA(1)=CIEN
SET X=ATYP
SET DIC="^BQI(90507.6,"_DA(1)_",1,"
SET DIC(0)="LMN"
+18 IF $GET(^BQI(90507.6,DA(1),1,0))=""
SET ^BQI(90507.6,DA(1),1,0)="^90507.61A^^"
+19 DO ^DIC
+20 SET AIEN=+Y
+21 ; Set the DX Category
+22 SET DA(2)=CIEN
SET DA(1)=AIEN
SET X=DCAT
SET DIC(0)="LMN"
+23 SET DIC="^BQI(90507.6,"_DA(2)_",1,"_DA(1)_",1,"
+24 IF $GET(^BQI(90507.6,DA(2),1,DA(1),1,0))=""
SET ^BQI(90507.6,DA(2),1,DA(1),1,0)="^90507.611A^^"
+25 DO ^DIC
+26 SET DIEN=+Y
+27 ; Set the Lab
+28 SET DA(3)=CIEN
SET DA(2)=AIEN
SET DA(1)=DIEN
SET X=LIEN
SET DIC(0)="LMN"
+29 SET DIC="^BQI(90507.6,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",2,"
+30 IF $GET(^BQI(90507.6,DA(3),1,DA(2),1,DA(1),2,0))=""
SET ^BQI(90507.6,DA(3),1,DA(2),1,DA(1),2,0)="^90507.6112^^"
+31 DO FILE^DICN
+32 SET DA=+Y
+33 SET IENS=$$IENS^DILF(.DA)
+34 SET BQIUPD(90507.6112,IENS,.02)=DTE
+35 SET BQIUPD(90507.6112,IENS,.03)=$PIECE(SDATA,U,2)
+36 SET BQIUPD(90507.6112,IENS,.04)=PT
+37 SET BQIUPD(90507.6112,IENS,.05)=$PIECE(SDATA,U,3)
+38 SET BQIUPD(90507.6112,IENS,.06)=VISIT
+39 DO FILE^DIE("","BQIUPD","ERROR")
+40 QUIT
+41 ;
SRN(TIEN,DFN) ; Search through all records
+1 SET VISIT=""
+2 FOR
SET VISIT=$ORDER(@TDATA@("PT",DFN,VISIT))
IF VISIT=""
QUIT
Begin DoDot:1
+3 ; For each entry TIEN
+4 SET IEN=""
SET VSDTM=@TDATA@("PT",DFN,VISIT)
+5 FOR
SET IEN=$ORDER(^AUPNVPOV("AD",VISIT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+6 ; if a bad record (no zero node), quit
+7 IF $GET(^AUPNVPOV(IEN,0))=""
QUIT
+8 IF $PIECE(^AUPNVPOV(IEN,0),U,1)'=TIEN
QUIT
+9 SET @DATA@(COMM,ALRT,DFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.07"
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
SNS(BQCID,DFN) ;EP - Look by concept ID
+1 SET VISIT=""
+2 FOR
SET VISIT=$ORDER(@TDATA@("PT",DFN,VISIT))
IF VISIT=""
QUIT
Begin DoDot:1
+3 ; For each entry CONCEPT ID
+4 SET IEN=""
SET VSDTM=@TDATA@("PT",DFN,VISIT)
+5 FOR
SET IEN=$ORDER(^AUPNVPOV("AD",VISIT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+6 ; if a bad record (no zero node), quit
+7 IF $GET(^AUPNVPOV(IEN,0))=""
QUIT
+8 IF $PIECE($GET(^AUPNVPOV(IEN,11)),U,1)'=BQCID
QUIT
+9 SET @DATA@(COMM,ALRT,DFN,"DX",VSDTM,BQCID)=VISIT_U_IEN_U_"9000010.07"
End DoDot:2
End DoDot:1
+10 QUIT
