- 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
