BQICAPT ;GDIT/HS/ALA-Community Alerts Patients ; 16 Oct 2011 11:49 AM
;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
;
EN(DATA,PARMS) ; EP - BQI GET COMM ALERTS PATIENTS
; Gets a list of patients that go along with community alerts
; Input parameters
; PARMS - Parameters of communities and dx categories
;
NEW UID,II,DATE,IEN,COMM,TYP,TYPE,ADATE,ASSOC,BGPHOME,BQ,BQI,BQIINDF,BQIINDG,BQIMEASF
NEW BQIMEASG,BQIROU,BQIY,BQIYR,CIEN,BN,DCAT,DCN,DXC,DXN,FILE,HDR,HEADR,LOOK,OCDT,ORD
NEW PAT,QFL,RECORD,TEMP,VAL,VALUE,NAFLG,NAME,PDATA,DXCAT,PATNAM,NVAL,TCAT,LBN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICAPT",UID)),TEMP=$NA(^TMP("BQITMP",UID))
K @DATA,@TEMP
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICAPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S PARMS=$G(PARMS,"")
I PARMS="" D
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
I PARMS'="" D
. F BQ=1:1:$L(PARMS,$C(28)) D
.. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
.. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
.. F BQI=1:1:$L(VALUE,$C(29)) D
... S VAL=$P(VALUE,$C(29),BQI),ASSOC=$P(VAL,$C(25),2,99)
... I NAME="COMM" S CIEN=$P(VAL,$C(25),1),COMM(CIEN)=""
... I NAME="DX" D
.... S DXC=$P(VAL,$C(25),1)
.... ;S TIEN=$$FIND1^DIC(90507.8,"","BX",TYPE,"","","ERROR")
.... S DXCAT(DXC)=""
... I ASSOC="" Q
... S NAME=$P(ASSOC,"=",1),NVAL=$P(ASSOC,"=",2,99)
... I NAME="DX" D
.... F BQQ=1:1:$L(NVAL,$C(24)) S DXC=$P(NVAL,$C(24),BQQ),DXCAT(DXC)=""
. I '$D(COMM) D ACOM
. I '$D(DXCAT) D ADXC
;
I PARMS="" D
. D ACOM
. D ADXC
;
S CIEN=""
F S CIEN=$O(COMM(CIEN)) Q:CIEN="" D
. D COM(CIEN)
D SOR
Q
;
ACOM ; Get all communities
K COMM
NEW CIEN
S CIEN=0
F S CIEN=$O(^BQI(90507.6,CIEN)) Q:'CIEN S COMM(CIEN)=""
Q
;
ADXC ; Get all types
K TYP
NEW TIEN,NAM
S TIEN=0
F S TIEN=$O(^BQI(90507.8,TIEN)) Q:'TIEN S DXCAT($P(^BQI(90507.8,TIEN,0),U,1))=""
F NAM="Attempt","Ideation","Completion" S DXCAT(NAM)=""
Q
;
COM(CIEN) ;EP
S COMM=$$GET1^DIQ(90507.6,CIEN_",",.01,"E")
; Get the type of the alert, either CDC NND or Suicide
S TYP=0
F S TYP=$O(^BQI(90507.6,CIEN,1,TYP)) Q:'TYP D FND(CIEN,TYP)
Q
;
FND(CIEN,TYP) ;EP
S TYPE=$P(^BQI(90507.6,CIEN,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 SDATE=30
I SDATE'="" S ADATE=$$DATE^BQIUL1("T-"_SDATE)
; Get the Diagnosis Category
S DCAT=""
F S DCAT=$O(DXCAT(DCAT)) Q:DCAT="" D
. S DXC=$O(^BQI(90507.6,CIEN,1,TYP,1,"B",$E(DCAT,1,30),""))
. I DXC="" Q
. 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,CIEN,1,TYP,1,DXC,1,DXN)) Q:'DXN D
.. NEW DA,IENS
.. S DA(3)=CIEN,DA(2)=TYP,DA(1)=DXC,DA=DXN,IENS=$$IENS^DILF(.DA)
.. S OCDT=$P(^BQI(90507.6,CIEN,1,TYP,1,DXC,1,DXN,0),U,2)
.. I (OCDT\1)'>ADATE Q
.. S PAT=$P(^BQI(90507.6,CIEN,1,TYP,1,DXC,1,DXN,0),U,4),RECORD=$P(^(0),U,3),FILE=$P(^(0),U,5),VISIT=$P(^(0),U,6)
.. S PATNAM=$P($G(^DPT(PAT,0)),U,1) S:PATNAM="" PATNAM="~"
.. I FILE=9000010 S VISIT=RECORD
.. S $P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,1,2)=RECORD_U_FILE
.. S $P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,6)=VISIT
. S LBN=0
. F S LBN=$O(^BQI(90507.6,CIEN,1,TYP,1,DXC,2,LBN)) Q:'LBN D
.. S LOCDT=$P(^BQI(90507.6,CIEN,1,TYP,1,DXC,2,LBN,0),U,2)
.. I (LOCDT\1)'>ADATE Q
.. S PAT=$P(^BQI(90507.6,CIEN,1,TYP,1,DXC,2,LBN,0),U,4),RECORD=$P(^(0),U,3),FILE=$P(^(0),U,5),VISIT=$P(^(0),U,6)
.. S PATNAM=$P($G(^DPT(PAT,0)),U,1) S:PATNAM="" PATNAM="~"
.. I $D(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT)) D
... S $P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,3,5)=RECORD_U_FILE_U_LOCDT
... S $P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,6)=VISIT
.. I '$D(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT)) D
... S $P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,"~"),U,3,5)=RECORD_U_FILE_U_LOCDT
... S $P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,"~"),U,6)=VISIT
;
Q
;
SOR ; Sort out the alerts
NEW COMM,TYPE,LINK,DCAT,NUM,OCDT,PATNAM,DOCDT,LOCDT,TCAT,OCDT,FILE
NEW LBREC,LBFIL,PAT,LBN
S PATNAM=""
F S PATNAM=$O(@TEMP@(PATNAM)) Q:PATNAM="" D
. S PAT=""
. F S PAT=$O(@TEMP@(PATNAM,PAT)) Q:PAT="" D
.. S COMM=""
.. F S COMM=$O(@TEMP@(PATNAM,PAT,COMM)) Q:COMM="" D
... S TYPE=""
... F S TYPE=$O(@TEMP@(PATNAM,PAT,COMM,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@(PATNAM,PAT,COMM,TYPE,DCAT)) Q:DCAT="" D
..... S OCDT=""
..... F S OCDT=$O(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT)) Q:OCDT="" D
...... S RECORD=$P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,1)
...... S FILE=$P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,2)
...... S LBREC=$P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,3)
...... S LBFIL=$P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,4)
...... S LOCDT=$P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,5)
...... S VISIT=$P(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,6)
...... S LOCDT=$S(+$P(^BQI(90508,1,0),U,25)=0:"",1:LOCDT)
...... S DOCDT=$S(OCDT="~":"",1:OCDT)
...... D STAND(PAT)
...... S TCAT=$S(DCAT="Ideation":"Ideation with Plan and Intent",DCAT="Completion":"Completed Suicide",1:DCAT)
...... S HDR=$P(HEADR,"^",1,9)_"^T00045ALERT_TYPE^T00045DX_CAT^D00015VISITDATE^I00010VISIT_IEN^I00010DFN^D00015LABDATE"_$C(30)
...... S II=II+1,@DATA@(II)=$P(VALUE,"^",1,9)_U_TYPE_U_TCAT_U_$$FMTE^BQIUL1(DOCDT)_U_VISIT_U_PAT_U_$$FMTE^BQIUL1(LOCDT)_$C(30)
;
DONE ;
I $G(HDR)="" D
. S HDR="T00030PN^T00030HRN^T00001SX^T00010AGE^D00030DOB^T00035DPCP^T00030COM^T00120DCAT^"
. S HDR=HDR_"T00045ALERT_TYPE^T00045DX_CAT^D00015VISITDATE^I00010VISIT_IEN^I00010DFN^D00015LABDATE"_$C(30)
S @DATA@(0)=HDR
S II=II+1,@DATA@(II)=$C(31)
K @TEMP
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
;
STAND(DFN) ;EP - Get standard display
NEW IEN,STVW,KEY,ORD
S HEADR="",VALUE=""
; Check for alternate display order first
S ORD=""
F S ORD=$O(^BQI(90506.1,"AF","D",ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AF","D",ORD,IEN)) Q:IEN="" D
.. S STVW=IEN
.. ; if the field has been inactivated, don't get data
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. ; For a standard display, display the 'R'equired and 'D'efault fields
.. I $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O" D
... D GVAL
... Q:HDR=""
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
;
; Check for normal display order
S ORD=""
F S ORD=$O(^BQI(90506.1,"AD","D",ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AD","D",ORD,IEN)) Q:IEN="" D
.. S STVW=IEN
.. ; if the field has been inactivated, don't get data
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. ; For a standard display, display the 'R'equired and 'D'efault fields
.. I $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O" D
... D GVAL
... Q:HDR=""
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
;
S HEADR=$$TKO^BQIUL1(HEADR,"^")
S VALUE=$$TKO^BQIUL1(VALUE,"^")
Q
;
GVAL ; Get values
;Parameters
; FIL = FileMan file number
; FLD = FileMan field number
; EXEC = If an executable is needed to determine value
; HDR = Header value
;the executable expects the value to be returned in variable VAL
NEW FIL,FLD,EXEC
S FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
S FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
S EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
S HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
I $G(DFN)="" S VAL="" Q
;
I $G(EXEC)'="" D Q
. I EXEC["PLIEN" S VAL="",HDR="" Q
. X EXEC
;
I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
Q
BQICAPT ;GDIT/HS/ALA-Community Alerts Patients ; 16 Oct 2011 11:49 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
+2 ;
EN(DATA,PARMS) ; EP - BQI GET COMM ALERTS PATIENTS
+1 ; Gets a list of patients that go along with community alerts
+2 ; Input parameters
+3 ; PARMS - Parameters of communities and dx categories
+4 ;
+5 NEW UID,II,DATE,IEN,COMM,TYP,TYPE,ADATE,ASSOC,BGPHOME,BQ,BQI,BQIINDF,BQIINDG,BQIMEASF
+6 NEW BQIMEASG,BQIROU,BQIY,BQIYR,CIEN,BN,DCAT,DCN,DXC,DXN,FILE,HDR,HEADR,LOOK,OCDT,ORD
+7 NEW PAT,QFL,RECORD,TEMP,VAL,VALUE,NAFLG,NAME,PDATA,DXCAT,PATNAM,NVAL,TCAT,LBN
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQICAPT",UID))
SET TEMP=$NAME(^TMP("BQITMP",UID))
+10 KILL @DATA,@TEMP
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICAPT D UNWIND^%ZTER"
+14 ;
+15 SET PARMS=$GET(PARMS,"")
+16 IF PARMS=""
Begin DoDot:1
+17 SET LIST=""
SET BN=""
+18 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+19 KILL PARMS
+20 SET PARMS=LIST
+21 KILL LIST
End DoDot:1
+22 ;
+23 IF PARMS'=""
Begin DoDot:1
+24 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:2
+25 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+26 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+27 FOR BQI=1:1:$LENGTH(VALUE,$CHAR(29))
Begin DoDot:3
+28 SET VAL=$PIECE(VALUE,$CHAR(29),BQI)
SET ASSOC=$PIECE(VAL,$CHAR(25),2,99)
+29 IF NAME="COMM"
SET CIEN=$PIECE(VAL,$CHAR(25),1)
SET COMM(CIEN)=""
+30 IF NAME="DX"
Begin DoDot:4
+31 SET DXC=$PIECE(VAL,$CHAR(25),1)
+32 ;S TIEN=$$FIND1^DIC(90507.8,"","BX",TYPE,"","","ERROR")
+33 SET DXCAT(DXC)=""
End DoDot:4
+34 IF ASSOC=""
QUIT
+35 SET NAME=$PIECE(ASSOC,"=",1)
SET NVAL=$PIECE(ASSOC,"=",2,99)
+36 IF NAME="DX"
Begin DoDot:4
+37 FOR BQQ=1:1:$LENGTH(NVAL,$CHAR(24))
SET DXC=$PIECE(NVAL,$CHAR(24),BQQ)
SET DXCAT(DXC)=""
End DoDot:4
End DoDot:3
End DoDot:2
+38 IF '$DATA(COMM)
DO ACOM
+39 IF '$DATA(DXCAT)
DO ADXC
End DoDot:1
+40 ;
+41 IF PARMS=""
Begin DoDot:1
+42 DO ACOM
+43 DO ADXC
End DoDot:1
+44 ;
+45 SET CIEN=""
+46 FOR
SET CIEN=$ORDER(COMM(CIEN))
IF CIEN=""
QUIT
Begin DoDot:1
+47 DO COM(CIEN)
End DoDot:1
+48 DO SOR
+49 QUIT
+50 ;
ACOM ; Get all communities
+1 KILL COMM
+2 NEW CIEN
+3 SET CIEN=0
+4 FOR
SET CIEN=$ORDER(^BQI(90507.6,CIEN))
IF 'CIEN
QUIT
SET COMM(CIEN)=""
+5 QUIT
+6 ;
ADXC ; Get all types
+1 KILL TYP
+2 NEW TIEN,NAM
+3 SET TIEN=0
+4 FOR
SET TIEN=$ORDER(^BQI(90507.8,TIEN))
IF 'TIEN
QUIT
SET DXCAT($PIECE(^BQI(90507.8,TIEN,0),U,1))=""
+5 FOR NAM="Attempt","Ideation","Completion"
SET DXCAT(NAM)=""
+6 QUIT
+7 ;
COM(CIEN) ;EP
+1 SET COMM=$$GET1^DIQ(90507.6,CIEN_",",.01,"E")
+2 ; Get the type of the alert, either CDC NND or Suicide
+3 SET TYP=0
+4 FOR
SET TYP=$ORDER(^BQI(90507.6,CIEN,1,TYP))
IF 'TYP
QUIT
DO FND(CIEN,TYP)
+5 QUIT
+6 ;
FND(CIEN,TYP) ;EP
+1 SET TYPE=$PIECE(^BQI(90507.6,CIEN,1,TYP,0),U,1)
+2 NEW DA,IENS,BQIH,BQI,SDATE
+3 SET BQIH=$$SPM^BQIGPUTL()
+4 SET BQI=$ORDER(^BQI(90508,BQIH,15,"B",TYPE,""))
+5 SET DA(1)=BQIH
SET DA=BQI
SET IENS=$$IENS^DILF(.DA)
+6 SET SDATE=$$GET1^DIQ(90508.015,IENS,.03,"E")
+7 IF SDATE=""
SET SDATE=30
+8 IF SDATE'=""
SET ADATE=$$DATE^BQIUL1("T-"_SDATE)
+9 ; Get the Diagnosis Category
+10 SET DCAT=""
+11 FOR
SET DCAT=$ORDER(DXCAT(DCAT))
IF DCAT=""
QUIT
Begin DoDot:1
+12 SET DXC=$ORDER(^BQI(90507.6,CIEN,1,TYP,1,"B",$EXTRACT(DCAT,1,30),""))
+13 IF DXC=""
QUIT
+14 IF TYPE'="Suicidal Behavior"
SET QFL=0
Begin DoDot:2
+15 SET DCN=$$FIND1^DIC(90507.8,"","BX",DCAT,"","","ERROR")
+16 IF DCN=0
SET QFL=1
QUIT
+17 SET LOOK=$$VAL^BQICAVW(DUZ,DCN)
+18 IF $PIECE(LOOK,U,1)="OFF"!($PIECE(LOOK,U,1)=0)
SET QFL=1
QUIT
+19 SET ADATE=$PIECE(LOOK,U,2)
End DoDot:2
IF QFL
QUIT
+20 SET DXN=0
+21 FOR
SET DXN=$ORDER(^BQI(90507.6,CIEN,1,TYP,1,DXC,1,DXN))
IF 'DXN
QUIT
Begin DoDot:2
+22 NEW DA,IENS
+23 SET DA(3)=CIEN
SET DA(2)=TYP
SET DA(1)=DXC
SET DA=DXN
SET IENS=$$IENS^DILF(.DA)
+24 SET OCDT=$PIECE(^BQI(90507.6,CIEN,1,TYP,1,DXC,1,DXN,0),U,2)
+25 IF (OCDT\1)'>ADATE
QUIT
+26 SET PAT=$PIECE(^BQI(90507.6,CIEN,1,TYP,1,DXC,1,DXN,0),U,4)
SET RECORD=$PIECE(^(0),U,3)
SET FILE=$PIECE(^(0),U,5)
SET VISIT=$PIECE(^(0),U,6)
+27 SET PATNAM=$PIECE($GET(^DPT(PAT,0)),U,1)
IF PATNAM=""
SET PATNAM="~"
+28 IF FILE=9000010
SET VISIT=RECORD
+29 SET $PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,1,2)=RECORD_U_FILE
+30 SET $PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,6)=VISIT
End DoDot:2
+31 SET LBN=0
+32 FOR
SET LBN=$ORDER(^BQI(90507.6,CIEN,1,TYP,1,DXC,2,LBN))
IF 'LBN
QUIT
Begin DoDot:2
+33 SET LOCDT=$PIECE(^BQI(90507.6,CIEN,1,TYP,1,DXC,2,LBN,0),U,2)
+34 IF (LOCDT\1)'>ADATE
QUIT
+35 SET PAT=$PIECE(^BQI(90507.6,CIEN,1,TYP,1,DXC,2,LBN,0),U,4)
SET RECORD=$PIECE(^(0),U,3)
SET FILE=$PIECE(^(0),U,5)
SET VISIT=$PIECE(^(0),U,6)
+36 SET PATNAM=$PIECE($GET(^DPT(PAT,0)),U,1)
IF PATNAM=""
SET PATNAM="~"
+37 IF $DATA(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT))
Begin DoDot:3
+38 SET $PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,3,5)=RECORD_U_FILE_U_LOCDT
+39 SET $PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,6)=VISIT
End DoDot:3
+40 IF '$DATA(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT))
Begin DoDot:3
+41 SET $PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,"~"),U,3,5)=RECORD_U_FILE_U_LOCDT
+42 SET $PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,"~"),U,6)=VISIT
End DoDot:3
End DoDot:2
End DoDot:1
+43 ;
+44 QUIT
+45 ;
SOR ; Sort out the alerts
+1 NEW COMM,TYPE,LINK,DCAT,NUM,OCDT,PATNAM,DOCDT,LOCDT,TCAT,OCDT,FILE
+2 NEW LBREC,LBFIL,PAT,LBN
+3 SET PATNAM=""
+4 FOR
SET PATNAM=$ORDER(@TEMP@(PATNAM))
IF PATNAM=""
QUIT
Begin DoDot:1
+5 SET PAT=""
+6 FOR
SET PAT=$ORDER(@TEMP@(PATNAM,PAT))
IF PAT=""
QUIT
Begin DoDot:2
+7 SET COMM=""
+8 FOR
SET COMM=$ORDER(@TEMP@(PATNAM,PAT,COMM))
IF COMM=""
QUIT
Begin DoDot:3
+9 SET TYPE=""
+10 FOR
SET TYPE=$ORDER(@TEMP@(PATNAM,PAT,COMM,TYPE))
IF TYPE=""
QUIT
Begin DoDot:4
+11 NEW DA,IENS,BQIH,BQI
+12 SET BQIH=$$SPM^BQIGPUTL()
+13 SET BQI=$ORDER(^BQI(90508,BQIH,15,"B",TYPE,""))
+14 SET DA(1)=BQIH
SET DA=BQI
SET IENS=$$IENS^DILF(.DA)
+15 ;S LINK=$$GET1^DIQ(90508.015,IENS,.02,"E")
+16 SET DCAT=""
+17 FOR
SET DCAT=$ORDER(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT))
IF DCAT=""
QUIT
Begin DoDot:5
+18 SET OCDT=""
+19 FOR
SET OCDT=$ORDER(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT))
IF OCDT=""
QUIT
Begin DoDot:6
+20 SET RECORD=$PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,1)
+21 SET FILE=$PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,2)
+22 SET LBREC=$PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,3)
+23 SET LBFIL=$PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,4)
+24 SET LOCDT=$PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,5)
+25 SET VISIT=$PIECE(@TEMP@(PATNAM,PAT,COMM,TYPE,DCAT,OCDT),U,6)
+26 SET LOCDT=$SELECT(+$PIECE(^BQI(90508,1,0),U,25)=0:"",1:LOCDT)
+27 SET DOCDT=$SELECT(OCDT="~":"",1:OCDT)
+28 DO STAND(PAT)
+29 SET TCAT=$SELECT(DCAT="Ideation":"Ideation with Plan and Intent",DCAT="Completion":"Completed Suicide",1:DCAT)
+30 SET HDR=$PIECE(HEADR,"^",1,9)_"^T00045ALERT_TYPE^T00045DX_CAT^D00015VISITDATE^I00010VISIT_IEN^I00010DFN^D00015LABDATE"_$CHAR(30)
+31 SET II=II+1
SET @DATA@(II)=$PIECE(VALUE,"^",1,9)_U_TYPE_U_TCAT_U_$$FMTE^BQIUL1(DOCDT)_U_VISIT_U_PAT_U_$$FMTE^BQIUL1(LOCDT)_$CHAR(30)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
DONE ;
+1 IF $GET(HDR)=""
Begin DoDot:1
+2 SET HDR="T00030PN^T00030HRN^T00001SX^T00010AGE^D00030DOB^T00035DPCP^T00030COM^T00120DCAT^"
+3 SET HDR=HDR_"T00045ALERT_TYPE^T00045DX_CAT^D00015VISITDATE^I00010VISIT_IEN^I00010DFN^D00015LABDATE"_$CHAR(30)
End DoDot:1
+4 SET @DATA@(0)=HDR
+5 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 KILL @TEMP
+7 QUIT
+8 ;
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 ;
STAND(DFN) ;EP - Get standard display
+1 NEW IEN,STVW,KEY,ORD
+2 SET HEADR=""
SET VALUE=""
+3 ; Check for alternate display order first
+4 SET ORD=""
+5 FOR
SET ORD=$ORDER(^BQI(90506.1,"AF","D",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^BQI(90506.1,"AF","D",ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+8 SET STVW=IEN
+9 ; if the field has been inactivated, don't get data
+10 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+11 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+12 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+13 ; For a standard display, display the 'R'equired and 'D'efault fields
+14 IF $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O"
Begin DoDot:3
+15 DO GVAL
+16 IF HDR=""
QUIT
+17 SET VALUE=VALUE_VAL_"^"
+18 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
+20 ; Check for normal display order
+21 SET ORD=""
+22 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD","D",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+23 SET IEN=""
+24 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD","D",ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+25 SET STVW=IEN
+26 ; if the field has been inactivated, don't get data
+27 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+28 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+29 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+30 ; For a standard display, display the 'R'equired and 'D'efault fields
+31 IF $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O"
Begin DoDot:3
+32 DO GVAL
+33 IF HDR=""
QUIT
+34 SET VALUE=VALUE_VAL_"^"
+35 SET HEADR=HEADR_HDR_"^"
End DoDot:3
End DoDot:2
End DoDot:1
+36 ;
+37 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+38 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+39 QUIT
+40 ;
GVAL ; Get values
+1 ;Parameters
+2 ; FIL = FileMan file number
+3 ; FLD = FileMan field number
+4 ; EXEC = If an executable is needed to determine value
+5 ; HDR = Header value
+6 ;the executable expects the value to be returned in variable VAL
+7 NEW FIL,FLD,EXEC
+8 SET FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
+9 SET FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
+10 SET EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
+11 SET HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
+12 IF $GET(DFN)=""
SET VAL=""
QUIT
+13 ;
+14 IF $GET(EXEC)'=""
Begin DoDot:1
+15 IF EXEC["PLIEN"
SET VAL=""
SET HDR=""
QUIT
+16 XECUTE EXEC
End DoDot:1
QUIT
+17 ;
+18 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+19 QUIT