BQICALRN ;GDIT/HS/ALA-Expanded Community Alerts ; 13 Oct 2011 3:42 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
FND ;EP - Find alerts
; Get the lab taxonomies for Community Alerts
NEW LIST,LNC,TAX,TREF,TX,IEN
D CA^BQITAXCK
D EN^BQITAXCK(.LIST)
I $G(X)="^" Q
;
NEW DIR,ARRAY
S ARRAY(1)="**Warning** Missing entries in lab taxonomies could result in non-identified"
S ARRAY(2)=" information."
S ARRAY(3)=" "
S ARRAY(4)=" Please quit and update lab taxonomies via Taxonomy Maintenance"
S ARRAY(5)=" before completing the export."
S ARRAY(6)=" "
D EN^DDIOL(.ARRAY)
S DIR(0)="E" D ^DIR
I X="^"!($G(DTOUT)'="") Q
NEW DA,DIK,UID
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;
; 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,CCT
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
; Need to get the program for the GPRA year to check active population
NEW BGPHOME,BQIH,BQIINDF,BQIINDG,BQIMEASF,BQIMEASG,BQIY,BQIYR,BQIROU
;
I $G(DT)="" D DT^DICRW
;
; Set the alert temporary global
NEW TDATA
S TDATA=$NA(^TMP("BQIALRTTMP",UID))
S DATA=$NA(^TMP("BQIALERT",UID))
K @TDATA,@DATA
K ^XTMP("BQICAVAL")
;
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,"1,",.24,"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 CCT=$G(CCT)+1 W:CCT#100=0 "."
.. 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
S PT=""
F S PT=$O(@TDATA@("PT",PT)) Q:PT="" D S CCT=$G(CCT)+1 W:CCT#100=0 "."
. 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)
.. ; 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)
.. Q:QFL
.. Q
;
D EN^BQICAVAL
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 ^XTMP("BQICAVAL",DFN,ALRT,"DX",VSDTM,IEN)=TIEN_U_"9000010.07"
Q
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
+2 ;
FND ;EP - Find alerts
+1 ; Get the lab taxonomies for Community Alerts
+2 NEW LIST,LNC,TAX,TREF,TX,IEN
+3 DO CA^BQITAXCK
+4 DO EN^BQITAXCK(.LIST)
+5 IF $GET(X)="^"
QUIT
+6 ;
+7 NEW DIR,ARRAY
+8 SET ARRAY(1)="**Warning** Missing entries in lab taxonomies could result in non-identified"
+9 SET ARRAY(2)=" information."
+10 SET ARRAY(3)=" "
+11 SET ARRAY(4)=" Please quit and update lab taxonomies via Taxonomy Maintenance"
+12 SET ARRAY(5)=" before completing the export."
+13 SET ARRAY(6)=" "
+14 DO EN^DDIOL(.ARRAY)
+15 SET DIR(0)="E"
DO ^DIR
+16 IF X="^"!($GET(DTOUT)'="")
QUIT
+17 NEW DA,DIK,UID
+18 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+19 ;
+20 ; Find clinics for primary care
+21 NEW TREF,TAX,PREF,TMFRAME,STDT,ENDT,ALRT,BGDA,BGI,BGPC,BGPCI,A,DATA
+22 NEW ATIEN,CM,TY,PT,DTE,DXN,DXCC,CIEN,DIEN,RIEN,XIEN,E,EXEC,G,IEN,CCT
+23 NEW OK,PCL,SIEN,V,VISIT,VSDTM,X,Y,COMM,DFN,DOD,DTY,ATY,SDATA,AIEN
+24 NEW LBT,VCLIN,BDT,BDXX,BGDT,BQIN,BSXX,CT,DEXEC,EDT,EXP,FILE,FLAG,I
+25 NEW N,OPER,OPER2,OVALUE,RES,RES2,RN,TIEN,TYP,VCAT,VDATE,VFL,X,Y,ZZ
+26 ; Need to get the program for the GPRA year to check active population
+27 NEW BGPHOME,BQIH,BQIINDF,BQIINDG,BQIMEASF,BQIMEASG,BQIY,BQIYR,BQIROU
+28 ;
+29 IF $GET(DT)=""
DO DT^DICRW
+30 ;
+31 ; Set the alert temporary global
+32 NEW TDATA
+33 SET TDATA=$NAME(^TMP("BQIALRTTMP",UID))
+34 SET DATA=$NAME(^TMP("BQIALERT",UID))
+35 KILL @TDATA,@DATA
+36 KILL ^XTMP("BQICAVAL")
+37 ;
+38 NEW DA,IENS,BQIH,BQI,TX,QFL,REP,TME,HAS
+39 SET BQIH=$$SPM^BQIGPUTL()
SET BQIN=0
+40 FOR
SET BQIN=$ORDER(^BQI(90508,BQIH,15,BQIN))
IF 'BQIN
QUIT
Begin DoDot:1
+41 NEW DA,IENS
+42 SET DA(1)=BQIH
SET DA=BQIN
SET IENS=$$IENS^DILF(.DA)
+43 SET TMFRAME="T-"_$$GET1^DIQ(90508,"1,",.24,"E")
+44 SET TY=$$GET1^DIQ(90508.015,IENS,.01,"E")
+45 SET ENDT=DT
SET STDT=$$DATE^BQIUL1(TMFRAME)
+46 SET TYP(TY)=ENDT_U_STDT
End DoDot:1
+47 SET TY=""
+48 FOR
SET TY=$ORDER(TYP(TY))
IF TY=""
QUIT
Begin DoDot:1
+49 SET BGDT=$PIECE(TYP(TY),U,2)-.0001
SET ENDT=$PIECE(TYP(TY),U,1)
SET STDT=$PIECE(TYP(TY),U,2)
+50 FOR
SET BGDT=$ORDER(^AUPNVSIT("B",BGDT))
IF BGDT=""!(BGDT\1>ENDT)
QUIT
Begin DoDot:2
+51 SET VISIT=""
+52 FOR
SET VISIT=$ORDER(^AUPNVSIT("B",BGDT,VISIT))
IF VISIT=""
QUIT
Begin DoDot:3
+53 IF $PIECE(^AUPNVSIT(VISIT,0),U,11)=1
QUIT
+54 SET VCAT=$PIECE(^AUPNVSIT(VISIT,0),U,7)
+55 IF VCAT'="A"
IF VCAT'="C"
IF VCAT'="H"
IF VCAT'="T"
QUIT
+56 SET DFN=$PIECE(^AUPNVSIT(VISIT,0),U,5)
IF DFN=""
QUIT
+57 SET VDATE=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)\1
IF VDATE=0
QUIT
+58 SET @TDATA@("PT",DFN,VISIT)=VDATE
End DoDot:3
End DoDot:2
SET CCT=$GET(CCT)+1
IF CCT#100=0
WRITE "."
End DoDot:1
+59 ;
+60 ; For each community alert, set up temporary
+61 SET PT=""
+62 FOR
SET PT=$ORDER(@TDATA@("PT",PT))
IF PT=""
QUIT
Begin DoDot:1
+63 SET ALRT=0
+64 FOR
SET ALRT=$ORDER(^BQI(90507.8,ALRT))
IF 'ALRT
QUIT
Begin DoDot:2
+65 SET TY=$PIECE($GET(^BQI(90507.8,ALRT,2)),U,1)
+66 ; Check for taxonomies
+67 SET TX=0
SET QFL=0
KILL TAX
+68 FOR
SET TX=$ORDER(^BQI(90507.8,ALRT,11,TX))
IF 'TX
QUIT
Begin DoDot:3
+69 SET TAX=$PIECE(^BQI(90507.8,ALRT,11,TX,0),U,1)
+70 SET TREF=$NAME(^TMP("BQITAX",UID))
+71 KILL @TREF
+72 DO BLD^BQITUTL(TAX,TREF)
+73 IF '$DATA(@TREF)
QUIT
+74 SET ATIEN=0
SET QFL=1
+75 FOR
SET ATIEN=$ORDER(@TREF@(ATIEN))
IF ATIEN=""
QUIT
DO SRN(ATIEN,PT)
End DoDot:3
+76 IF QFL
QUIT
+77 QUIT
End DoDot:2
End DoDot:1
SET CCT=$GET(CCT)+1
IF CCT#100=0
WRITE "."
+78 ;
+79 DO EN^BQICAVAL
+80 QUIT
+81 ;
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 ^XTMP("BQICAVAL",DFN,ALRT,"DX",VSDTM,IEN)=TIEN_U_"9000010.07"
End DoDot:2
End DoDot:1
+10 QUIT
