- 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
