BQICASPL ;GDIT/HS/ALA-Community Alerts Splash ; 17 Oct 2011 4:21 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
;
EN(DATA,FAKE) ;EP -- BQI GET COMM ALERTS SPLASH
NEW UID,II,DATE,IEN,COMM,CMN,DCAT,DIAG,DXC,DXN,NUM,OCDT,TYP,TYPE,TEMP,TCAT
NEW ADATE,DCN,LINK,PAT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICASPL",UID)),TEMP=$NA(^TMP("BQITMP",UID))
K @DATA,@TEMP
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICASPL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D GRID(.DATA)
Q
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
K @TEMP
Q
;
SOR ; Sort out the alerts
NEW COMM,TYPE,LINK,DCAT,NUM,OCDT,TWEN,PT,DATE,TNUM,TTWN,LABNUM,LABNM
S COMM=""
F S COMM=$O(@TEMP@(COMM)) Q:COMM="" D
. S CMN=""
. F S CMN=$O(@TEMP@(COMM,CMN)) Q:CMN="" D
.. S TYPE=""
.. F S TYPE=$O(@TEMP@(COMM,CMN,TYPE)) Q:TYPE="" D
... NEW DA,IENS,BQIH,BQI
... S BQIH=$$SPM^BQIGPUTL()
... S BQI=$O(^BQI(90508,BQIH,15,"B",TYPE,""))
... S DA(1)=BQIH,DA=BQI,IENS=$$IENS^DILF(.DA)
... S LINK=$$GET1^DIQ(90508.015,IENS,.02,"E")
... S DCAT=""
... F S DCAT=$O(@TEMP@(COMM,CMN,TYPE,DCAT)) Q:DCAT="" D
.... S PT="",TNUM=0,TTWN=0,LABNM=0
.... F S PT=$O(@TEMP@(COMM,CMN,TYPE,DCAT,PT)) Q:PT="" D
..... S NUM=+$P(@TEMP@(COMM,CMN,TYPE,DCAT,PT),U,1)
..... S TNUM=TNUM+NUM
..... S TWEN=+$P(@TEMP@(COMM,CMN,TYPE,DCAT,PT),U,2)
..... S TTWN=TTWN+TWEN
..... S LABNUM=+$P(@TEMP@(COMM,CMN,TYPE,DCAT,PT),U,3)
..... S LABNM=LABNM+LABNUM
..... ; Check for lab display flag
..... S LABNM=$S(+$P(^BQI(90508,1,0),U,25)=0:"",1:LABNM)
..... S OCDT=$O(@TEMP@(COMM,CMN,TYPE,DCAT,PT,""),-1)
..... I OCDT'="" S DATE(OCDT)=""
..... S TCAT=$S(DCAT="Ideation":"Ideation with Plan and Intent",DCAT="Completion":"Completed Suicide",1:DCAT)
..... ;S CMN=@TEMP@(COMM,CMN,TYPE,DCAT,OCDT)
.... S OCDT=$O(DATE(""),-1) K DATE
.... S II=II+1,@DATA@(II)=COMM_U_TYPE_U_LINK_U_TCAT_U_TNUM_U_TTWN_U_$$FMTE^BQIUL1(OCDT)_U_CMN_U_LABNM_$C(30)
;
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
FND ;EP - Find the alerts for a date and a community
NEW COMM,TYP,TYPE,DXC,DCAT,DCN,LOOK,ADATE,DXN,QFL,TWDT,TCAT,LBN
S COMM=$$GET1^DIQ(90507.6,CMN_",",.01,"E")
S ADATE=$$DATE^BQIUL1("T-30"),TWDT=$$DATE^BQIUL1("T-1")
; Get the type of the alert, either CDC NND or Suicide
S TYP=0
F S TYP=$O(^BQI(90507.6,CMN,1,TYP)) Q:'TYP D
. S TYPE=$P(^BQI(90507.6,CMN,1,TYP,0),U,1)
. ; Get the Diagnosis Category
. S DXC=0
. F S DXC=$O(^BQI(90507.6,CMN,1,TYP,1,DXC)) Q:'DXC D
.. S DCAT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,0),U,1)
.. I TYPE'="Suicidal Behavior" S QFL=0 D Q:QFL
... S DCN=$$FIND1^DIC(90507.8,"","BX",DCAT,"","","ERROR")
... I DCN=0 S QFL=1 Q
... S LOOK=$$VAL^BQICAVW(DUZ,DCN)
... I $P(LOOK,U,1)="OFF"!($P(LOOK,U,1)=0) S QFL=1 Q
... S ADATE=$P(LOOK,U,2)
.. S DXN=0
.. F S DXN=$O(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN)) Q:'DXN D
... NEW DA,IENS
... S DA(3)=CMN,DA(2)=TYP,DA(1)=DXC,DA=DXN,IENS=$$IENS^DILF(.DA)
... S OCDT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,2)
... I (OCDT\1)'>ADATE Q
... S PAT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,4)
... ;I $D(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)) Q
... S @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
... S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
... ;S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=0
... I OCDT=TWDT S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
.. S LBN=0
.. F S LBN=$O(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN)) Q:'LBN D
... S DA(3)=CMN,DA(2)=TYP,DA(1)=DXC,DA=LBN,IENS=$$IENS^DILF(.DA)
... S OCDT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,2)
... I (OCDT\1)'>ADATE Q
... S PAT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,4)
... S @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
... S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,3)+1
... I $P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)=1 Q
... S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
... I OCDT=TWDT S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
Q
;
PAT(DATA,DFN) ;EP -- BQI GET COMM ALERTS BY PATIENT
; Gets a list of alerts that go along with the patient's community
;
NEW UID,II,DATE,IEN,COMM,ADATE,CMN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICAPAT",UID)),TEMP=$NA(^TMP("BQITMP",UID))
K @DATA,@TEMP
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICASPL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00030COMMUNITY^T00045ALERT_TYPE^T00100TYPE_LINK^T00045DX_CAT^I00005NUM_CASES^I00005TWEN_CASES^D00015VISITDATE^I00010COMM_IEN^I00005LAB_NUM"_$C(30)
S ADATE=$$DATE^BQIUL1("T-30")
;
S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"I"),CMN=COMM
; If no alerts for the patient's community, quit
I $D(^BQI(90507.6,COMM))<1 G DONE
;
D FND
D SOR
G DONE
;
GRID(DATA,FAKE) ; EP - BQI GET COMM ALERTS GRID
; Gets a list of alerts that go along with the patient's community
;
NEW UID,II,DATE,IEN,COMM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICAGRD",UID)),TEMP=$NA(^TMP("BQITMP",UID))
K @DATA,@TEMP
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICASPL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S ADATE=$$DATE^BQIUL1("T-30"),TWDT=$$DATE^BQIUL1("T-1")
;
S @DATA@(II)="T00030COMMUNITY^T00045ALERT_TYPE^T00100TYPE_LINK^T00045DX_CAT^I00005NUM_CASES^I00005TWEN_CASES^D00015VISITDATE^I00010COMM_IEN^I00005LAB_NUM"_$C(30)
;
S CMN=0
F S CMN=$O(^BQI(90507.6,CMN)) Q:'CMN D
. S COMM=$$GET1^DIQ(90507.6,CMN_",",.01,"E")
. ; Get the type of the alert, either CDC NND or Suicide
. S TYP=0
. F S TYP=$O(^BQI(90507.6,CMN,1,TYP)) Q:'TYP D
.. S TYPE=$P(^BQI(90507.6,CMN,1,TYP,0),U,1)
.. NEW DA,IENS,BQIH,BQI,SDATE
.. S BQIH=$$SPM^BQIGPUTL()
.. S BQI=$O(^BQI(90508,BQIH,15,"B",TYPE,""))
.. S DA(1)=BQIH,DA=BQI,IENS=$$IENS^DILF(.DA)
.. S SDATE=$$GET1^DIQ(90508.015,IENS,.03,"E")
.. I SDATE'="" S ADATE=$$DATE^BQIUL1("T-"_SDATE)
.. ; Get the Diagnosis Category
.. S DXC=0
.. F S DXC=$O(^BQI(90507.6,CMN,1,TYP,1,DXC)) Q:'DXC D
... S DCAT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,0),U,1)
... I TYPE'="Suicidal Behavior" S QFL=0 D Q:QFL
.... S DCN=$$FIND1^DIC(90507.8,"","BX",DCAT,"","","ERROR")
.... I DCN=0 S QFL=1 Q
.... S LOOK=$$VAL^BQICAVW(DUZ,DCN)
.... I $P(LOOK,U,1)="OFF"!($P(LOOK,U,1)=0) S QFL=1 Q
.... S ADATE=$P(LOOK,U,2)
... S DXN=0
... F S DXN=$O(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN)) Q:'DXN D
.... NEW DA,IENS
.... S DA(3)=CMN,DA(2)=TYP,DA(1)=DXC,DA=DXN,IENS=$$IENS^DILF(.DA)
.... S OCDT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,2)
.... I (OCDT\1)'>ADATE Q
.... S PAT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,4)
.... ;S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=0
.... ;I $D(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)) Q
.... S @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
.... S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
.... I OCDT=TWDT S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
... S LBN=0
... F S LBN=$O(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN)) Q:'LBN D
.... S DA(3)=CMN,DA(2)=TYP,DA(1)=DXC,DA=LBN,IENS=$$IENS^DILF(.DA)
.... S OCDT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,2)
.... I (OCDT\1)'>ADATE Q
.... S PAT=$P(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,4)
.... S @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
.... S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,3)+1
.... I $P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)=1 Q
.... S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
.... I OCDT=TWDT S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$P($G(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
D SOR
G DONE
BQICASPL ;GDIT/HS/ALA-Community Alerts Splash ; 17 Oct 2011 4:21 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
+2 ;
EN(DATA,FAKE) ;EP -- BQI GET COMM ALERTS SPLASH
+1 NEW UID,II,DATE,IEN,COMM,CMN,DCAT,DIAG,DXC,DXN,NUM,OCDT,TYP,TYPE,TEMP,TCAT
+2 NEW ADATE,DCN,LINK,PAT
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQICASPL",UID))
SET TEMP=$NAME(^TMP("BQITMP",UID))
+5 KILL @DATA,@TEMP
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICASPL D UNWIND^%ZTER"
+9 ;
+10 DO GRID(.DATA)
+11 QUIT
+12 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 KILL @TEMP
+3 QUIT
+4 ;
SOR ; Sort out the alerts
+1 NEW COMM,TYPE,LINK,DCAT,NUM,OCDT,TWEN,PT,DATE,TNUM,TTWN,LABNUM,LABNM
+2 SET COMM=""
+3 FOR
SET COMM=$ORDER(@TEMP@(COMM))
IF COMM=""
QUIT
Begin DoDot:1
+4 SET CMN=""
+5 FOR
SET CMN=$ORDER(@TEMP@(COMM,CMN))
IF CMN=""
QUIT
Begin DoDot:2
+6 SET TYPE=""
+7 FOR
SET TYPE=$ORDER(@TEMP@(COMM,CMN,TYPE))
IF TYPE=""
QUIT
Begin DoDot:3
+8 NEW DA,IENS,BQIH,BQI
+9 SET BQIH=$$SPM^BQIGPUTL()
+10 SET BQI=$ORDER(^BQI(90508,BQIH,15,"B",TYPE,""))
+11 SET DA(1)=BQIH
SET DA=BQI
SET IENS=$$IENS^DILF(.DA)
+12 SET LINK=$$GET1^DIQ(90508.015,IENS,.02,"E")
+13 SET DCAT=""
+14 FOR
SET DCAT=$ORDER(@TEMP@(COMM,CMN,TYPE,DCAT))
IF DCAT=""
QUIT
Begin DoDot:4
+15 SET PT=""
SET TNUM=0
SET TTWN=0
SET LABNM=0
+16 FOR
SET PT=$ORDER(@TEMP@(COMM,CMN,TYPE,DCAT,PT))
IF PT=""
QUIT
Begin DoDot:5
+17 SET NUM=+$PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PT),U,1)
+18 SET TNUM=TNUM+NUM
+19 SET TWEN=+$PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PT),U,2)
+20 SET TTWN=TTWN+TWEN
+21 SET LABNUM=+$PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PT),U,3)
+22 SET LABNM=LABNM+LABNUM
+23 ; Check for lab display flag
+24 SET LABNM=$SELECT(+$PIECE(^BQI(90508,1,0),U,25)=0:"",1:LABNM)
+25 SET OCDT=$ORDER(@TEMP@(COMM,CMN,TYPE,DCAT,PT,""),-1)
+26 IF OCDT'=""
SET DATE(OCDT)=""
+27 SET TCAT=$SELECT(DCAT="Ideation":"Ideation with Plan and Intent",DCAT="Completion":"Completed Suicide",1:DCAT)
+28 ;S CMN=@TEMP@(COMM,CMN,TYPE,DCAT,OCDT)
End DoDot:5
+29 SET OCDT=$ORDER(DATE(""),-1)
KILL DATE
+30 SET II=II+1
SET @DATA@(II)=COMM_U_TYPE_U_LINK_U_TCAT_U_TNUM_U_TTWN_U_$$FMTE^BQIUL1(OCDT)_U_CMN_U_LABNM_$CHAR(30)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 QUIT
+33 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
FND ;EP - Find the alerts for a date and a community
+1 NEW COMM,TYP,TYPE,DXC,DCAT,DCN,LOOK,ADATE,DXN,QFL,TWDT,TCAT,LBN
+2 SET COMM=$$GET1^DIQ(90507.6,CMN_",",.01,"E")
+3 SET ADATE=$$DATE^BQIUL1("T-30")
SET TWDT=$$DATE^BQIUL1("T-1")
+4 ; Get the type of the alert, either CDC NND or Suicide
+5 SET TYP=0
+6 FOR
SET TYP=$ORDER(^BQI(90507.6,CMN,1,TYP))
IF 'TYP
QUIT
Begin DoDot:1
+7 SET TYPE=$PIECE(^BQI(90507.6,CMN,1,TYP,0),U,1)
+8 ; Get the Diagnosis Category
+9 SET DXC=0
+10 FOR
SET DXC=$ORDER(^BQI(90507.6,CMN,1,TYP,1,DXC))
IF 'DXC
QUIT
Begin DoDot:2
+11 SET DCAT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,0),U,1)
+12 IF TYPE'="Suicidal Behavior"
SET QFL=0
Begin DoDot:3
+13 SET DCN=$$FIND1^DIC(90507.8,"","BX",DCAT,"","","ERROR")
+14 IF DCN=0
SET QFL=1
QUIT
+15 SET LOOK=$$VAL^BQICAVW(DUZ,DCN)
+16 IF $PIECE(LOOK,U,1)="OFF"!($PIECE(LOOK,U,1)=0)
SET QFL=1
QUIT
+17 SET ADATE=$PIECE(LOOK,U,2)
End DoDot:3
IF QFL
QUIT
+18 SET DXN=0
+19 FOR
SET DXN=$ORDER(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN))
IF 'DXN
QUIT
Begin DoDot:3
+20 NEW DA,IENS
+21 SET DA(3)=CMN
SET DA(2)=TYP
SET DA(1)=DXC
SET DA=DXN
SET IENS=$$IENS^DILF(.DA)
+22 SET OCDT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,2)
+23 IF (OCDT\1)'>ADATE
QUIT
+24 SET PAT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,4)
+25 ;I $D(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)) Q
+26 SET @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
+27 SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
+28 ;S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=0
+29 IF OCDT=TWDT
SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
End DoDot:3
+30 SET LBN=0
+31 FOR
SET LBN=$ORDER(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN))
IF 'LBN
QUIT
Begin DoDot:3
+32 SET DA(3)=CMN
SET DA(2)=TYP
SET DA(1)=DXC
SET DA=LBN
SET IENS=$$IENS^DILF(.DA)
+33 SET OCDT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,2)
+34 IF (OCDT\1)'>ADATE
QUIT
+35 SET PAT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,4)
+36 SET @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
+37 SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,3)+1
+38 IF $PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)=1
QUIT
+39 SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
+40 IF OCDT=TWDT
SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
End DoDot:3
End DoDot:2
End DoDot:1
+41 QUIT
+42 ;
PAT(DATA,DFN) ;EP -- BQI GET COMM ALERTS BY PATIENT
+1 ; Gets a list of alerts that go along with the patient's community
+2 ;
+3 NEW UID,II,DATE,IEN,COMM,ADATE,CMN
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DATA=$NAME(^TMP("BQICAPAT",UID))
SET TEMP=$NAME(^TMP("BQITMP",UID))
+6 KILL @DATA,@TEMP
+7 ;
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICASPL D UNWIND^%ZTER"
+10 ;
+11 SET @DATA@(II)="T00030COMMUNITY^T00045ALERT_TYPE^T00100TYPE_LINK^T00045DX_CAT^I00005NUM_CASES^I00005TWEN_CASES^D00015VISITDATE^I00010COMM_IEN^I00005LAB_NUM"_$CHAR(30)
+12 SET ADATE=$$DATE^BQIUL1("T-30")
+13 ;
+14 SET COMM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
SET CMN=COMM
+15 ; If no alerts for the patient's community, quit
+16 IF $DATA(^BQI(90507.6,COMM))<1
GOTO DONE
+17 ;
+18 DO FND
+19 DO SOR
+20 GOTO DONE
+21 ;
GRID(DATA,FAKE) ; EP - BQI GET COMM ALERTS GRID
+1 ; Gets a list of alerts that go along with the patient's community
+2 ;
+3 NEW UID,II,DATE,IEN,COMM
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DATA=$NAME(^TMP("BQICAGRD",UID))
SET TEMP=$NAME(^TMP("BQITMP",UID))
+6 KILL @DATA,@TEMP
+7 ;
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICASPL D UNWIND^%ZTER"
+10 ;
+11 SET ADATE=$$DATE^BQIUL1("T-30")
SET TWDT=$$DATE^BQIUL1("T-1")
+12 ;
+13 SET @DATA@(II)="T00030COMMUNITY^T00045ALERT_TYPE^T00100TYPE_LINK^T00045DX_CAT^I00005NUM_CASES^I00005TWEN_CASES^D00015VISITDATE^I00010COMM_IEN^I00005LAB_NUM"_$CHAR(30)
+14 ;
+15 SET CMN=0
+16 FOR
SET CMN=$ORDER(^BQI(90507.6,CMN))
IF 'CMN
QUIT
Begin DoDot:1
+17 SET COMM=$$GET1^DIQ(90507.6,CMN_",",.01,"E")
+18 ; Get the type of the alert, either CDC NND or Suicide
+19 SET TYP=0
+20 FOR
SET TYP=$ORDER(^BQI(90507.6,CMN,1,TYP))
IF 'TYP
QUIT
Begin DoDot:2
+21 SET TYPE=$PIECE(^BQI(90507.6,CMN,1,TYP,0),U,1)
+22 NEW DA,IENS,BQIH,BQI,SDATE
+23 SET BQIH=$$SPM^BQIGPUTL()
+24 SET BQI=$ORDER(^BQI(90508,BQIH,15,"B",TYPE,""))
+25 SET DA(1)=BQIH
SET DA=BQI
SET IENS=$$IENS^DILF(.DA)
+26 SET SDATE=$$GET1^DIQ(90508.015,IENS,.03,"E")
+27 IF SDATE'=""
SET ADATE=$$DATE^BQIUL1("T-"_SDATE)
+28 ; Get the Diagnosis Category
+29 SET DXC=0
+30 FOR
SET DXC=$ORDER(^BQI(90507.6,CMN,1,TYP,1,DXC))
IF 'DXC
QUIT
Begin DoDot:3
+31 SET DCAT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,0),U,1)
+32 IF TYPE'="Suicidal Behavior"
SET QFL=0
Begin DoDot:4
+33 SET DCN=$$FIND1^DIC(90507.8,"","BX",DCAT,"","","ERROR")
+34 IF DCN=0
SET QFL=1
QUIT
+35 SET LOOK=$$VAL^BQICAVW(DUZ,DCN)
+36 IF $PIECE(LOOK,U,1)="OFF"!($PIECE(LOOK,U,1)=0)
SET QFL=1
QUIT
+37 SET ADATE=$PIECE(LOOK,U,2)
End DoDot:4
IF QFL
QUIT
+38 SET DXN=0
+39 FOR
SET DXN=$ORDER(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN))
IF 'DXN
QUIT
Begin DoDot:4
+40 NEW DA,IENS
+41 SET DA(3)=CMN
SET DA(2)=TYP
SET DA(1)=DXC
SET DA=DXN
SET IENS=$$IENS^DILF(.DA)
+42 SET OCDT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,2)
+43 IF (OCDT\1)'>ADATE
QUIT
+44 SET PAT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,1,DXN,0),U,4)
+45 ;S $P(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=0
+46 ;I $D(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)) Q
+47 SET @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
+48 SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
+49 IF OCDT=TWDT
SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
End DoDot:4
+50 SET LBN=0
+51 FOR
SET LBN=$ORDER(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN))
IF 'LBN
QUIT
Begin DoDot:4
+52 SET DA(3)=CMN
SET DA(2)=TYP
SET DA(1)=DXC
SET DA=LBN
SET IENS=$$IENS^DILF(.DA)
+53 SET OCDT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,2)
+54 IF (OCDT\1)'>ADATE
QUIT
+55 SET PAT=$PIECE(^BQI(90507.6,CMN,1,TYP,1,DXC,2,LBN,0),U,4)
+56 SET @TEMP@(COMM,CMN,TYPE,DCAT,PAT,OCDT)=CMN
+57 SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,3)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,3)+1
+58 IF $PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)=1
QUIT
+59 SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,1)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,1)+1
+60 IF OCDT=TWDT
SET $PIECE(@TEMP@(COMM,CMN,TYPE,DCAT,PAT),U,2)=$PIECE($GET(@TEMP@(COMM,CMN,TYPE,DCAT,PAT)),U,2)+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+61 DO SOR
+62 GOTO DONE
