BEDDRPT ;VNGT/HS/BEE-BEDD Report Routine - Cache Calls ; 08 Nov 2011 12:00 PM
;;2.0;IHS EMERGENCY DEPT DASHBOARD;;Apr 02, 2014
;
;This routine is included in the BEDD XML 1.0 install and is not in the KIDS
;
Q
;
;Reports by Date Range (Admit or Discharge)
;
ALST(BEGDT,ENDDT,RTYPE,INDEX) ;EP - Assemble List of Information for Date Range
;
;Input:
; BEGDT - Report Beginning Date
; ENDDT - Report End Date
; RTYPE - Report to run
; INDEX (optional) - Index/Sort to use (ADMIT/DISCH/TRGA) - Default is ADMIT
;
;Error Trapping
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDRPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW DDATE,DIEN,RCNT
;
S BEGDT=$G(BEGDT,"")
S ENDDT=$G(ENDDT,"")
S RTYPE=$G(RTYPE,"")
S INDEX=$G(INDEX,"") S:INDEX="" INDEX="ADMIT"
;
;Initialie Record Count
S RCNT=0
;
;Reset scratch global
K ^TMP("BEDDADT",$J)
;
;Set in default dates if needed
I $G(BEGDT)="",$G(ENDDT)="" D
. S BEGDT="T-1"
. S ENDDT="T"
;
;Reformat inputed dates
S BEGDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(BEGDT),"5Y")
S ENDDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(ENDDT),"5Y")
;
;Set external parameters in scratch global
S ^TMP("BEDDADT",$J,"XBDT")=BEGDT
S ^TMP("BEDDADT",$J,"XEDT")=ENDDT
S ^TMP("BEDDADT",$J,"XIND")=INDEX
;
S BEGDT=$P($$TODLH^BEDDUTIL(BEGDT),",")
S ENDDT=$P($$TODLH^BEDDUTIL(ENDDT),",")
;
;Set internal parameters in scratch global
S ^TMP("BEDDADT",$J,"IBDT")=BEGDT
S ^TMP("BEDDADT",$J,"IEDT")=ENDDT
;
;Select Index
S IDX="ArrIdx"
I INDEX="DISCH" S IDX="DisIdx"
I RTYPE="DI" S IDX="DisIdx"
;
;Assemble list of entries
S DDATE=$S($G(BEGDT)]"":BEGDT-1,1:"")
F S DDATE=$O(^BEDD.EDVISITI(IDX,DDATE)) Q:((DDATE>ENDDT)!(DDATE="")) D
. S DIEN="" F S DIEN=$O(^BEDD.EDVISITI(IDX,DDATE,DIEN)) Q:DIEN="" D
.. NEW EDVST,AMERVSIT
.. S EDVST=##CLASS(BEDD.EDVISIT).%OpenId(DIEN) Q:EDVST=""
.. S AMERVSIT=EDVST.AMERVSIT
.. ;
.. ;Admission Summary Report
.. I RTYPE="AS" D AS
.. ;
.. ;Central Log
.. I RTYPE="CL" D CL(DIEN,.RCNT)
.. ;
.. ;Check in Summary By Hour
.. I RTYPE="CI" D CI
.. ;
.. ;Discharge Summary By Hour
.. I RTYPE="DI" D DI
;
Q
;
AS ;EP - Set up entry for Admission Summary
;
NEW ADMDT,TRGA,ARRMD,DISP,INJ
;
;Disposition
S DISP=EDVST.DispN S:DISP="" DISP="BLANK"
;
;Screen out Registered in Error entries
I DISP="REGISTERED IN ERROR" Q
S ^TMP("BEDDADT",$J,"DISP",DISP)=$G(^TMP("BEDDADT",$J,"DISP",DISP))+1
;
;Initial Acuity
S ADMDT=EDVST.PtCIDT S:ADMDT="" ADMDT="DATE"
S TRGA=EDVST.TrgA S:TRGA="" TRGA="BLANK"
S ^TMP("BEDDADT",$J,"TRGA",TRGA)=$G(^TMP("BEDDADT",$J,"TRGA",TRGA))+1
;
;Arrival Mode
S ARRMD=EDVST.ArrMode S:ARRMD="" ARRMD="BLANK"
S ^TMP("BEDDADT",$J,"ARRMD",ARRMD)=$G(^TMP("BEDDADT",$J,"ARRMD",ARRMD))+1
;
;Injury
S INJ=EDVST.Injury S:INJ="" INJ="BLANK"
S ^TMP("BEDDADT",$J,"INJ",INJ)=$G(^TMP("BEDDADT",$J,"INJ",INJ))+1
Q
;
CL(OBJID,RCNT) ;EP - Set up entry for Central Log
;
NEW CDT,TRGA,ODT,CIDT,CITM,ADDTTM,ODT,DCDT,DCTM,DCDTTM,DDT,CONS,CTWT,CLIN
NEW ARRMD,PTNAME,COMP,CHART,AGE,SEX,DOB,DIAG,APRV,DISP,TRGDTM,ROOM,RMDTTM
NEW DFN,INJ,LOS,PCP,RDWT,RMDTMH,TRGDT,TRGH,TRGTM,TRWT,VIEN,DPRV,DNRS,FINA
NEW XORMDT,ORMDT,ORMTM,ORMDTTM,PRMNRS,DCADDTM,APRVDTM,CIMSEWTG,FMMSE,HMSE
;
;Disposition
S DISP=EDVST.DispN
I DISP="REGISTERED IN ERROR" Q
;
;Get entry value
S RCNT=RCNT+1
;
;Check-In Date/Time
S CIDT=EDVST.CIDt,CITM=EDVST.CITm S:CITM>0 CITM="00000"_CITM,CITM=$E(CITM,$L(CITM)-4,$L(CITM))
S ADDTTM=CIDT_","_CITM S:ADDTTM="," ADDTTM="" S:ADDTTM="-1" ADDTTM=""
S ODT=ADDTTM S:ODT="" ODT="99999,99999"
S CDT=EDVST.PtCIDT
;
;Initial Acuity
S TRGA=EDVST.TrgA
I INDEX="TRGA" S ODT=" "_TRGA
;
;Arrival Mode
S ARRMD=EDVST.ArrMode
;
;Patient Name
S PTNAME=EDVST.PtName
;
;Presenting Complaint
S COMP=EDVST.Complaint
;
;Chart
S CHART=EDVST.Chart
;
S CLIN=EDVST.TrgECln
I CLIN]"" S CLIN=$$GET1^DIQ(9009083,CLIN_",",.01,"E")
;Age
S AGE=EDVST.Age
;
;Sex
S SEX=EDVST.Sex
;
;Date of Birth
S DOB=EDVST.DOB
;
;Diagnosis
D DXCNT^BEDDUTIS(OBJID,1,.DIAG,1)
S DIAG=$P(DIAG,"^",4)
S DIAG=$$GET1^DIQ(80,DIAG_",",.01,"I")_" "_$$GET1^DIQ(80,DIAG_",",3,"I") S:DIAG=" " DIAG=""
;
;Admitting Physician
S APRV=EDVST.AdmPrv
S:APRV]"" APRV=$$GET1^DIQ(200,APRV_",",".01","I")
;
;Medical Screening Exam Time
S CIMSEWTG=""
S FMMSE=EDVST.AdPvDtm
S HMSE=$$FMTH^XLFDT(FMMSE)
S APRVDTM=$$FMTE^BEDDUTIL(FMMSE)
I ADDTTM]"",FMMSE]"",HMSE]"" S CIMSEWTG=$P($$HDIFF^XLFDT(HMSE,ADDTTM,2)/60,".")
;
;Primary Nurse
S PRMNRS=EDVST.PrmNurse
S:PRMNRS]"" PRMNRS=$$GET1^DIQ(200,PRMNRS_",",".01","I")
;
;Decision to Admit Dt/Tm
S DCADDTM=EDVST.NewDecAdmit
;
;Triage Date/Time
S TRGDT=EDVST.TrgDt,TRGTM=EDVST.TrgTm S:TRGTM>0 TRGTM="00000"_TRGTM,TRGTM=$E(TRGTM,$L(TRGTM)-4,$L(TRGTM))
S TRGH=TRGDT_","_TRGTM S:TRGH="," TRGH="" S:TRGH="-1" TRGH=""
S TRGDTM=EDVST.TrgDtTm S:TRGDTM]"" TRGDTM=$$FMTE^BEDDUTIL(TRGDTM)
;
;CI/Triage Wait Time
S CTWT=""
I TRGH]"",ADDTTM]"" S CTWT=$P($$HDIFF^XLFDT(TRGH,ADDTTM,2)/60,".")
;
;Room Info
S ROOM=$P($$RMLST^BEDDUTW(OBJID),"^",2)
S RMDTTM=$P($$RMLST^BEDDUTW(OBJID),"^")
S RMDTMH=$$TODLH^BEDDUTIL(RMDTTM) S:RMDTMH="," RMDTMH="" S:RMDTMH="-1" RMDTMH=""
;
S ORMDT=EDVST.ORmDt
S ORMTM=EDVST.ORmTm
S ORMDTTM=ORMDT_","_ORMTM S:ORMDTTM="," ORMDTTM=""
S XORMDT=$$HTFM^XLFDT(ORMDTTM) S:XORMDT="-1" XORMDT=""
S XORMDT=$$FMTE^BEDDUTIL(XORMDT)
;
;Tr/Rm Wait Time
S TRWT=""
I TRGH]"",ORMDTTM]"" S TRWT=$P($$HDIFF^XLFDT(ORMDTTM,TRGH,2)/60,".")
;
;Disposition Date
S DCDT=EDVST.DCDt,DCTM=EDVST.DCTm S:DCTM>0 DCTM="00000"_DCTM,DCTM=$E(DCTM,$L(DCTM)-4,$L(DCTM))
S DCDTTM=DCDT_","_DCTM S:DCDTTM="," DCDTTM="" S:DCDTTM="-1" DCDTTM=""
S DDT=EDVST.PtDCDT
I INDEX="DISCH" S ODT=DCDTTM S:DCDTTM="" ODT="99999,99999"
;
;Rm/Disp Wait Time
S RDWT=""
I ORMDTTM]"",DCDTTM]"" S RDWT=$P($$HDIFF^XLFDT(DCDTTM,ORMDTTM,2)/60,".")
;
;LOS
S LOS=""
I ADDTTM]"",DCDTTM]"" S LOS=$P($$HDIFF^XLFDT(DCDTTM,ADDTTM,2)/60,".")
;
;Injury
S INJ=EDVST.Injury
;
;Consult
S CONS="NO"
I $$EDCNT^BEDDUTIS(OBJID)>0 S CONS="YES"
;
;IENS
S VIEN=EDVST.VIEN,DFN=EDVST.PtDFN,AMERVSIT=EDVST.AMERVSIT
;
;PCP
S PCP=$$PPR^BEDDUTIL(VIEN,OBJID,DFN)
;
;Primary Provider
S PPRV=EDVST.DCPrv
S:PPRV]"" PPRV=$$GET1^DIQ(200,PPRV_",",".01","I")
;
;Discharge Nurse
S DNRS=EDVST.DCNrs
S:DNRS]"" DNRS=$$GET1^DIQ(200,DNRS_",",".01","I")
;
;Final Acuity
S FINA=EDVST.FinA
;
;Save Entry
S ^TMP("BEDDADT",$J,"CLOG",ODT,RCNT,0)=CDT_"^"_ARRMD_"^"_PTNAME_"^"_COMP_"^"_CHART_"^"_AGE_"^"_SEX_"^"_DOB_"^"_CLIN
S ^TMP("BEDDADT",$J,"CLOG",ODT,RCNT,1)=TRGA_"^"_DIAG_"^"_APRV_"^"_DISP_"^"_TRGDTM_"^"_CTWT_"^"_ROOM_"^"_XORMDT_"^"_TRWT_"^"_DDT_"^"_APRVDTM
S ^TMP("BEDDADT",$J,"CLOG",ODT,RCNT,2)=RDWT_"^"_LOS_"^"_INJ_"^"_CONS_"^"_PCP_"^"_AMERVSIT_"^"_OBJID_"^"_VIEN_"^"_DFN_"^"_PPRV_"^"_DNRS_"^"_FINA_"^"_PRMNRS_"^"_DCADDTM_"^"_CIMSEWTG
;
Q
;
CI ;EP - Check in summary by hour
;
NEW DISP,CIDT,CITM,CIDTTM,XCDTTM,XCIDT,XCITM
;
;Disposition
S DISP=EDVST.DispN
;
;Screen out Registered in Error entries
I DISP="REGISTERED IN ERROR" Q
;
S CIDT=EDVST.CIDt
S CITM=EDVST.CITm
S CIDTTM=CIDT_","_CITM S:$TR(CIDTTM,",")="" CIDTTM=""
S XCDTTM=$$HTE^XLFDT(CIDTTM)
S XCIDT=$P(XCDTTM,"@") Q:XCIDT=""
S XCITM=$P($P(XCDTTM,"@",2),":") S:XCITM="" XTM="."
S XCITM=" "_XCITM S:XCITM'["." XCITM=XCITM_":00"
;
;Check-In Hour
S ^TMP("BEDDADT",$J,"HOUR",XCIDT,XCITM)=$G(^TMP("BEDDADT",$J,"HOUR",XCIDT,XCITM))+1
;
Q
;
DI ;EP - Discharge summary by hour
;
NEW DISP,CIDT,CITM,CIDTTM,XCDTTM,XCIDT,XCITM
;
;Disposition
S DISP=EDVST.DispN
;
;Screen out Registered in Error entries
I DISP="REGISTERED IN ERROR" Q
;
S CIDT=EDVST.DCDt
S CITM=EDVST.DCTm
S CIDTTM=CIDT_","_CITM S:$TR(CIDTTM,",")="" CIDTTM=""
S XCDTTM=$$HTE^XLFDT(CIDTTM)
S XCIDT=$P(XCDTTM,"@") Q:XCIDT=""
S XCITM=$P($P(XCDTTM,"@",2),":") S:XCITM="" XTM="."
S XCITM=" "_XCITM S:XCITM'["." XCITM=XCITM_":00"
;
;Check-In Hour
S ^TMP("BEDDADT",$J,"HOUR",XCIDT,XCITM)=$G(^TMP("BEDDADT",$J,"HOUR",XCIDT,XCITM))+1
;
Q
;
;Room Report by Date Range
;
RMRPT(BEGDT,ENDDT) ;EP - Assemble Room Information By Date Range
;
;Input:
; BEGDT - Report Beginning Date
; ENDDT - Report End Date
;
;Error Trapping
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDRPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW DDATE,RIEN,RCNT
;
S BEGDT=$G(BEGDT,"")
S ENDDT=$G(ENDDT,"")
;
;Initialize Record Count
S RCNT=0
;
;Reset scratch global
K ^TMP("BEDDRM",$J)
;
;Set in default dates if needed
I $G(BEGDT)="",$G(ENDDT)="" D
. S BEGDT="T-1"
. S ENDDT="T"
;
;Reformat inputed dates
S BEGDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(BEGDT),"5Y")
S ENDDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(ENDDT),"5Y")
;
;Set external parameters in scratch global
S ^TMP("BEDDRM",$J,"XBDT")=BEGDT
S ^TMP("BEDDRM",$J,"XEDT")=ENDDT
;
S BEGDT=$P($$TODLH^BEDDUTIL(BEGDT),",")
S ENDDT=$P($$TODLH^BEDDUTIL(ENDDT),",")
;
;Set internal parameters in scratch global
S ^TMP("BEDDRM",$J,"IBDT")=BEGDT
S ^TMP("BEDDRM",$J,"IEDT")=ENDDT
;
;Assemble list of entries
S DDATE=$S($G(BEGDT)]"":BEGDT-1,1:"")
F S DDATE=$O(^BEDD.EDRoomUseI("RdtIdx",DDATE)) Q:((DDATE>ENDDT)!(DDATE="")) D
. S RIEN="" F S RIEN=$O(^BEDD.EDRoomUseI("RdtIdx",DDATE,RIEN)) Q:RIEN="" D
.. ;
.. S RMUSE=##CLASS(BEDD.EDRoomUse).%OpenId(RIEN)
.. ;
.. ;Room Use Report
.. D RU
;
Q
;
RU ;EP - Room Use Report
;
NEW ROOM,RMDT,RMTM,RMDTTM,XRMDT,CHK
;
;Get ID
S EDID=RMUSE.EDID
S CHK=""
I EDID]"" D I CHK Q
. NEW EDVST,DISP
. S EDVST=##CLASS(BEDD.EDVISIT).%OpenId(EDID)
. S DISP=EDVST.DispN
. I DISP="REGISTERED IN ERROR" S CHK=1
;
;Room
S ROOM=RMUSE.RoomID S:ROOM="" ROOM="ROOM"
;
;Room Date/Time
S RMDT=RMUSE.RoomDt
S RMTM=RMUSE.RoomTime
S RMDTTM=RMDT_","_RMTM S:$TR(RMDTTM,",")="" RMDTTM=""
S XRMDT=$$HTE^XLFDT(RMDTTM)
S XTM=$P($P(XRMDT,"@",2),":") S:XTM="" XTM="."
S XTM=" "_XTM S:XTM'["." XTM=XTM_":00"
;
S ^TMP("BEDDRM",$J,"ROOM",RMDT,XTM,ROOM)=$G(^TMP("BEDDRM",$J,"ROOM",RMDT,XTM,ROOM))+1
S ^TMP("BEDDRM",$J,"RLST",ROOM)=$G(^TMP("BEDDRM",$J,"RLST",ROOM))+1
S ^TMP("BEDDRM",$J,"RTOT",RMDT,ROOM)=$G(^TMP("BEDDRM",$J,"RTOT",RMDT,ROOM))+1
;
Q
;
DLST(BEGDT,ENDDT) ;EP - Assemble List of Discharges for Date Ranges
;
;Error Trapping
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDRPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW DDATE,DIEN
;
;Reset scratch global
K ^TMP("BEDDDSC",$J)
;
;Set in default dates if needed
I $G(BEGDT)="",$G(ENDDT)="" D
. S BEGDT="T-1"
. S ENDDT="T"
;
;Reformat inputed dates
S BEGDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(BEGDT),"5Y")
S ENDDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(ENDDT),"5Y")
;
;Set external parameters in scratch global
S ^TMP("BEDDDSC",$J,"XBDT")=BEGDT
S ^TMP("BEDDDSC",$J,"XEDT")=ENDDT
;
S BEGDT=$P($$TODLH^BEDDUTIL(BEGDT),",")
S ENDDT=$P($$TODLH^BEDDUTIL(ENDDT),",")
;
;Set internal parameters in scratch global
S ^TMP("BEDDDSC",$J,"IBDT")=BEGDT
S ^TMP("BEDDDSC",$J,"IEDT")=ENDDT
;
;Assemble list of discharges
S DDATE=$S($G(BEGDT)]"":BEGDT-1,1:"")
F S DDATE=$O(^BEDD.EDVISITI("DisIdx",DDATE)) Q:((DDATE>ENDDT)!(DDATE="")) D
. S DIEN="" F S DIEN=$O(^BEDD.EDVISITI("DisIdx",DDATE,DIEN)) Q:DIEN="" D
.. NEW EDVST,DSCDT,AMERVSIT
.. S EDVST=##CLASS(BEDD.EDVISIT).%OpenId(DIEN)
.. S AMERVSIT=EDVST.AMERVSIT
.. S DSCDT=$$GETF^BEDDUTIL(9009080,AMERVSIT,6.2,"I")
.. S ^TMP("BEDDDSC",$J,"LST",DSCDT,DIEN)=""
;
Q
;
ERR ;
D ^%ZTER
Q
BEDDRPT ;VNGT/HS/BEE-BEDD Report Routine - Cache Calls ; 08 Nov 2011 12:00 PM
+1 ;;2.0;IHS EMERGENCY DEPT DASHBOARD;;Apr 02, 2014
+2 ;
+3 ;This routine is included in the BEDD XML 1.0 install and is not in the KIDS
+4 ;
+5 QUIT
+6 ;
+7 ;Reports by Date Range (Admit or Discharge)
+8 ;
ALST(BEGDT,ENDDT,RTYPE,INDEX) ;EP - Assemble List of Information for Date Range
+1 ;
+2 ;Input:
+3 ; BEGDT - Report Beginning Date
+4 ; ENDDT - Report End Date
+5 ; RTYPE - Report to run
+6 ; INDEX (optional) - Index/Sort to use (ADMIT/DISCH/TRGA) - Default is ADMIT
+7 ;
+8 ;Error Trapping
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDRPT D UNWIND^%ZTER"
+10 ;
+11 NEW DDATE,DIEN,RCNT
+12 ;
+13 SET BEGDT=$GET(BEGDT,"")
+14 SET ENDDT=$GET(ENDDT,"")
+15 SET RTYPE=$GET(RTYPE,"")
+16 SET INDEX=$GET(INDEX,"")
IF INDEX=""
SET INDEX="ADMIT"
+17 ;
+18 ;Initialie Record Count
+19 SET RCNT=0
+20 ;
+21 ;Reset scratch global
+22 KILL ^TMP("BEDDADT",$JOB)
+23 ;
+24 ;Set in default dates if needed
+25 IF $GET(BEGDT)=""
IF $GET(ENDDT)=""
Begin DoDot:1
+26 SET BEGDT="T-1"
+27 SET ENDDT="T"
End DoDot:1
+28 ;
+29 ;Reformat inputed dates
+30 SET BEGDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(BEGDT),"5Y")
+31 SET ENDDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(ENDDT),"5Y")
+32 ;
+33 ;Set external parameters in scratch global
+34 SET ^TMP("BEDDADT",$JOB,"XBDT")=BEGDT
+35 SET ^TMP("BEDDADT",$JOB,"XEDT")=ENDDT
+36 SET ^TMP("BEDDADT",$JOB,"XIND")=INDEX
+37 ;
+38 SET BEGDT=$PIECE($$TODLH^BEDDUTIL(BEGDT),",")
+39 SET ENDDT=$PIECE($$TODLH^BEDDUTIL(ENDDT),",")
+40 ;
+41 ;Set internal parameters in scratch global
+42 SET ^TMP("BEDDADT",$JOB,"IBDT")=BEGDT
+43 SET ^TMP("BEDDADT",$JOB,"IEDT")=ENDDT
+44 ;
+45 ;Select Index
+46 SET IDX="ArrIdx"
+47 IF INDEX="DISCH"
SET IDX="DisIdx"
+48 IF RTYPE="DI"
SET IDX="DisIdx"
+49 ;
+50 ;Assemble list of entries
+51 SET DDATE=$SELECT($GET(BEGDT)]"":BEGDT-1,1:"")
+52 FOR
SET DDATE=$ORDER(^BEDD.EDVISITI(IDX,DDATE))
IF ((DDATE>ENDDT)!(DDATE=""))
QUIT
Begin DoDot:1
+53 SET DIEN=""
FOR
SET DIEN=$ORDER(^BEDD.EDVISITI(IDX,DDATE,DIEN))
IF DIEN=""
QUIT
Begin DoDot:2
+54 NEW EDVST,AMERVSIT
+55 SET EDVST=##CLASS(BEDD.EDVISIT).%OpenId(DIEN)
IF EDVST=""
QUIT
+56 SET AMERVSIT=EDVST.AMERVSIT
+57 ;
+58 ;Admission Summary Report
+59 IF RTYPE="AS"
DO AS
+60 ;
+61 ;Central Log
+62 IF RTYPE="CL"
DO CL(DIEN,.RCNT)
+63 ;
+64 ;Check in Summary By Hour
+65 IF RTYPE="CI"
DO CI
+66 ;
+67 ;Discharge Summary By Hour
+68 IF RTYPE="DI"
DO DI
End DoDot:2
End DoDot:1
+69 ;
+70 QUIT
+71 ;
AS ;EP - Set up entry for Admission Summary
+1 ;
+2 NEW ADMDT,TRGA,ARRMD,DISP,INJ
+3 ;
+4 ;Disposition
+5 SET DISP=EDVST.DispN
IF DISP=""
SET DISP="BLANK"
+6 ;
+7 ;Screen out Registered in Error entries
+8 IF DISP="REGISTERED IN ERROR"
QUIT
+9 SET ^TMP("BEDDADT",$JOB,"DISP",DISP)=$GET(^TMP("BEDDADT",$JOB,"DISP",DISP))+1
+10 ;
+11 ;Initial Acuity
+12 SET ADMDT=EDVST.PtCIDT
IF ADMDT=""
SET ADMDT="DATE"
+13 SET TRGA=EDVST.TrgA
IF TRGA=""
SET TRGA="BLANK"
+14 SET ^TMP("BEDDADT",$JOB,"TRGA",TRGA)=$GET(^TMP("BEDDADT",$JOB,"TRGA",TRGA))+1
+15 ;
+16 ;Arrival Mode
+17 SET ARRMD=EDVST.ArrMode
IF ARRMD=""
SET ARRMD="BLANK"
+18 SET ^TMP("BEDDADT",$JOB,"ARRMD",ARRMD)=$GET(^TMP("BEDDADT",$JOB,"ARRMD",ARRMD))+1
+19 ;
+20 ;Injury
+21 SET INJ=EDVST.Injury
IF INJ=""
SET INJ="BLANK"
+22 SET ^TMP("BEDDADT",$JOB,"INJ",INJ)=$GET(^TMP("BEDDADT",$JOB,"INJ",INJ))+1
+23 QUIT
+24 ;
CL(OBJID,RCNT) ;EP - Set up entry for Central Log
+1 ;
+2 NEW CDT,TRGA,ODT,CIDT,CITM,ADDTTM,ODT,DCDT,DCTM,DCDTTM,DDT,CONS,CTWT,CLIN
+3 NEW ARRMD,PTNAME,COMP,CHART,AGE,SEX,DOB,DIAG,APRV,DISP,TRGDTM,ROOM,RMDTTM
+4 NEW DFN,INJ,LOS,PCP,RDWT,RMDTMH,TRGDT,TRGH,TRGTM,TRWT,VIEN,DPRV,DNRS,FINA
+5 NEW XORMDT,ORMDT,ORMTM,ORMDTTM,PRMNRS,DCADDTM,APRVDTM,CIMSEWTG,FMMSE,HMSE
+6 ;
+7 ;Disposition
+8 SET DISP=EDVST.DispN
+9 IF DISP="REGISTERED IN ERROR"
QUIT
+10 ;
+11 ;Get entry value
+12 SET RCNT=RCNT+1
+13 ;
+14 ;Check-In Date/Time
+15 SET CIDT=EDVST.CIDt
SET CITM=EDVST.CITm
IF CITM>0
SET CITM="00000"_CITM
SET CITM=$EXTRACT(CITM,$LENGTH(CITM)-4,$LENGTH(CITM))
+16 SET ADDTTM=CIDT_","_CITM
IF ADDTTM=","
SET ADDTTM=""
IF ADDTTM="-1"
SET ADDTTM=""
+17 SET ODT=ADDTTM
IF ODT=""
SET ODT="99999,99999"
+18 SET CDT=EDVST.PtCIDT
+19 ;
+20 ;Initial Acuity
+21 SET TRGA=EDVST.TrgA
+22 IF INDEX="TRGA"
SET ODT=" "_TRGA
+23 ;
+24 ;Arrival Mode
+25 SET ARRMD=EDVST.ArrMode
+26 ;
+27 ;Patient Name
+28 SET PTNAME=EDVST.PtName
+29 ;
+30 ;Presenting Complaint
+31 SET COMP=EDVST.Complaint
+32 ;
+33 ;Chart
+34 SET CHART=EDVST.Chart
+35 ;
+36 SET CLIN=EDVST.TrgECln
+37 IF CLIN]""
SET CLIN=$$GET1^DIQ(9009083,CLIN_",",.01,"E")
+38 ;Age
+39 SET AGE=EDVST.Age
+40 ;
+41 ;Sex
+42 SET SEX=EDVST.Sex
+43 ;
+44 ;Date of Birth
+45 SET DOB=EDVST.DOB
+46 ;
+47 ;Diagnosis
+48 DO DXCNT^BEDDUTIS(OBJID,1,.DIAG,1)
+49 SET DIAG=$PIECE(DIAG,"^",4)
+50 SET DIAG=$$GET1^DIQ(80,DIAG_",",.01,"I")_" "_$$GET1^DIQ(80,DIAG_",",3,"I")
IF DIAG=" "
SET DIAG=""
+51 ;
+52 ;Admitting Physician
+53 SET APRV=EDVST.AdmPrv
+54 IF APRV]""
SET APRV=$$GET1^DIQ(200,APRV_",",".01","I")
+55 ;
+56 ;Medical Screening Exam Time
+57 SET CIMSEWTG=""
+58 SET FMMSE=EDVST.AdPvDtm
+59 SET HMSE=$$FMTH^XLFDT(FMMSE)
+60 SET APRVDTM=$$FMTE^BEDDUTIL(FMMSE)
+61 IF ADDTTM]""
IF FMMSE]""
IF HMSE]""
SET CIMSEWTG=$PIECE($$HDIFF^XLFDT(HMSE,ADDTTM,2)/60,".")
+62 ;
+63 ;Primary Nurse
+64 SET PRMNRS=EDVST.PrmNurse
+65 IF PRMNRS]""
SET PRMNRS=$$GET1^DIQ(200,PRMNRS_",",".01","I")
+66 ;
+67 ;Decision to Admit Dt/Tm
+68 SET DCADDTM=EDVST.NewDecAdmit
+69 ;
+70 ;Triage Date/Time
+71 SET TRGDT=EDVST.TrgDt
SET TRGTM=EDVST.TrgTm
IF TRGTM>0
SET TRGTM="00000"_TRGTM
SET TRGTM=$EXTRACT(TRGTM,$LENGTH(TRGTM)-4,$LENGTH(TRGTM))
+72 SET TRGH=TRGDT_","_TRGTM
IF TRGH=","
SET TRGH=""
IF TRGH="-1"
SET TRGH=""
+73 SET TRGDTM=EDVST.TrgDtTm
IF TRGDTM]""
SET TRGDTM=$$FMTE^BEDDUTIL(TRGDTM)
+74 ;
+75 ;CI/Triage Wait Time
+76 SET CTWT=""
+77 IF TRGH]""
IF ADDTTM]""
SET CTWT=$PIECE($$HDIFF^XLFDT(TRGH,ADDTTM,2)/60,".")
+78 ;
+79 ;Room Info
+80 SET ROOM=$PIECE($$RMLST^BEDDUTW(OBJID),"^",2)
+81 SET RMDTTM=$PIECE($$RMLST^BEDDUTW(OBJID),"^")
+82 SET RMDTMH=$$TODLH^BEDDUTIL(RMDTTM)
IF RMDTMH=","
SET RMDTMH=""
IF RMDTMH="-1"
SET RMDTMH=""
+83 ;
+84 SET ORMDT=EDVST.ORmDt
+85 SET ORMTM=EDVST.ORmTm
+86 SET ORMDTTM=ORMDT_","_ORMTM
IF ORMDTTM=","
SET ORMDTTM=""
+87 SET XORMDT=$$HTFM^XLFDT(ORMDTTM)
IF XORMDT="-1"
SET XORMDT=""
+88 SET XORMDT=$$FMTE^BEDDUTIL(XORMDT)
+89 ;
+90 ;Tr/Rm Wait Time
+91 SET TRWT=""
+92 IF TRGH]""
IF ORMDTTM]""
SET TRWT=$PIECE($$HDIFF^XLFDT(ORMDTTM,TRGH,2)/60,".")
+93 ;
+94 ;Disposition Date
+95 SET DCDT=EDVST.DCDt
SET DCTM=EDVST.DCTm
IF DCTM>0
SET DCTM="00000"_DCTM
SET DCTM=$EXTRACT(DCTM,$LENGTH(DCTM)-4,$LENGTH(DCTM))
+96 SET DCDTTM=DCDT_","_DCTM
IF DCDTTM=","
SET DCDTTM=""
IF DCDTTM="-1"
SET DCDTTM=""
+97 SET DDT=EDVST.PtDCDT
+98 IF INDEX="DISCH"
SET ODT=DCDTTM
IF DCDTTM=""
SET ODT="99999,99999"
+99 ;
+100 ;Rm/Disp Wait Time
+101 SET RDWT=""
+102 IF ORMDTTM]""
IF DCDTTM]""
SET RDWT=$PIECE($$HDIFF^XLFDT(DCDTTM,ORMDTTM,2)/60,".")
+103 ;
+104 ;LOS
+105 SET LOS=""
+106 IF ADDTTM]""
IF DCDTTM]""
SET LOS=$PIECE($$HDIFF^XLFDT(DCDTTM,ADDTTM,2)/60,".")
+107 ;
+108 ;Injury
+109 SET INJ=EDVST.Injury
+110 ;
+111 ;Consult
+112 SET CONS="NO"
+113 IF $$EDCNT^BEDDUTIS(OBJID)>0
SET CONS="YES"
+114 ;
+115 ;IENS
+116 SET VIEN=EDVST.VIEN
SET DFN=EDVST.PtDFN
SET AMERVSIT=EDVST.AMERVSIT
+117 ;
+118 ;PCP
+119 SET PCP=$$PPR^BEDDUTIL(VIEN,OBJID,DFN)
+120 ;
+121 ;Primary Provider
+122 SET PPRV=EDVST.DCPrv
+123 IF PPRV]""
SET PPRV=$$GET1^DIQ(200,PPRV_",",".01","I")
+124 ;
+125 ;Discharge Nurse
+126 SET DNRS=EDVST.DCNrs
+127 IF DNRS]""
SET DNRS=$$GET1^DIQ(200,DNRS_",",".01","I")
+128 ;
+129 ;Final Acuity
+130 SET FINA=EDVST.FinA
+131 ;
+132 ;Save Entry
+133 SET ^TMP("BEDDADT",$JOB,"CLOG",ODT,RCNT,0)=CDT_"^"_ARRMD_"^"_PTNAME_"^"_COMP_"^"_CHART_"^"_AGE_"^"_SEX_"^"_DOB_"^"_CLIN
+134 SET ^TMP("BEDDADT",$JOB,"CLOG",ODT,RCNT,1)=TRGA_"^"_DIAG_"^"_APRV_"^"_DISP_"^"_TRGDTM_"^"_CTWT_"^"_ROOM_"^"_XORMDT_"^"_TRWT_"^"_DDT_"^"_APRVDTM
+135 SET ^TMP("BEDDADT",$JOB,"CLOG",ODT,RCNT,2)=RDWT_"^"_LOS_"^"_INJ_"^"_CONS_"^"_PCP_"^"_AMERVSIT_"^"_OBJID_"^"_VIEN_"^"_DFN_"^"_PPRV_"^"_DNRS_"^"_FINA_"^"_PRMNRS_"^"_DCADDTM_"^"_CIMSEWTG
+136 ;
+137 QUIT
+138 ;
CI ;EP - Check in summary by hour
+1 ;
+2 NEW DISP,CIDT,CITM,CIDTTM,XCDTTM,XCIDT,XCITM
+3 ;
+4 ;Disposition
+5 SET DISP=EDVST.DispN
+6 ;
+7 ;Screen out Registered in Error entries
+8 IF DISP="REGISTERED IN ERROR"
QUIT
+9 ;
+10 SET CIDT=EDVST.CIDt
+11 SET CITM=EDVST.CITm
+12 SET CIDTTM=CIDT_","_CITM
IF $TRANSLATE(CIDTTM,",")=""
SET CIDTTM=""
+13 SET XCDTTM=$$HTE^XLFDT(CIDTTM)
+14 SET XCIDT=$PIECE(XCDTTM,"@")
IF XCIDT=""
QUIT
+15 SET XCITM=$PIECE($PIECE(XCDTTM,"@",2),":")
IF XCITM=""
SET XTM="."
+16 SET XCITM=" "_XCITM
IF XCITM'["."
SET XCITM=XCITM_":00"
+17 ;
+18 ;Check-In Hour
+19 SET ^TMP("BEDDADT",$JOB,"HOUR",XCIDT,XCITM)=$GET(^TMP("BEDDADT",$JOB,"HOUR",XCIDT,XCITM))+1
+20 ;
+21 QUIT
+22 ;
DI ;EP - Discharge summary by hour
+1 ;
+2 NEW DISP,CIDT,CITM,CIDTTM,XCDTTM,XCIDT,XCITM
+3 ;
+4 ;Disposition
+5 SET DISP=EDVST.DispN
+6 ;
+7 ;Screen out Registered in Error entries
+8 IF DISP="REGISTERED IN ERROR"
QUIT
+9 ;
+10 SET CIDT=EDVST.DCDt
+11 SET CITM=EDVST.DCTm
+12 SET CIDTTM=CIDT_","_CITM
IF $TRANSLATE(CIDTTM,",")=""
SET CIDTTM=""
+13 SET XCDTTM=$$HTE^XLFDT(CIDTTM)
+14 SET XCIDT=$PIECE(XCDTTM,"@")
IF XCIDT=""
QUIT
+15 SET XCITM=$PIECE($PIECE(XCDTTM,"@",2),":")
IF XCITM=""
SET XTM="."
+16 SET XCITM=" "_XCITM
IF XCITM'["."
SET XCITM=XCITM_":00"
+17 ;
+18 ;Check-In Hour
+19 SET ^TMP("BEDDADT",$JOB,"HOUR",XCIDT,XCITM)=$GET(^TMP("BEDDADT",$JOB,"HOUR",XCIDT,XCITM))+1
+20 ;
+21 QUIT
+22 ;
+23 ;Room Report by Date Range
+24 ;
RMRPT(BEGDT,ENDDT) ;EP - Assemble Room Information By Date Range
+1 ;
+2 ;Input:
+3 ; BEGDT - Report Beginning Date
+4 ; ENDDT - Report End Date
+5 ;
+6 ;Error Trapping
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDRPT D UNWIND^%ZTER"
+8 ;
+9 NEW DDATE,RIEN,RCNT
+10 ;
+11 SET BEGDT=$GET(BEGDT,"")
+12 SET ENDDT=$GET(ENDDT,"")
+13 ;
+14 ;Initialize Record Count
+15 SET RCNT=0
+16 ;
+17 ;Reset scratch global
+18 KILL ^TMP("BEDDRM",$JOB)
+19 ;
+20 ;Set in default dates if needed
+21 IF $GET(BEGDT)=""
IF $GET(ENDDT)=""
Begin DoDot:1
+22 SET BEGDT="T-1"
+23 SET ENDDT="T"
End DoDot:1
+24 ;
+25 ;Reformat inputed dates
+26 SET BEGDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(BEGDT),"5Y")
+27 SET ENDDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(ENDDT),"5Y")
+28 ;
+29 ;Set external parameters in scratch global
+30 SET ^TMP("BEDDRM",$JOB,"XBDT")=BEGDT
+31 SET ^TMP("BEDDRM",$JOB,"XEDT")=ENDDT
+32 ;
+33 SET BEGDT=$PIECE($$TODLH^BEDDUTIL(BEGDT),",")
+34 SET ENDDT=$PIECE($$TODLH^BEDDUTIL(ENDDT),",")
+35 ;
+36 ;Set internal parameters in scratch global
+37 SET ^TMP("BEDDRM",$JOB,"IBDT")=BEGDT
+38 SET ^TMP("BEDDRM",$JOB,"IEDT")=ENDDT
+39 ;
+40 ;Assemble list of entries
+41 SET DDATE=$SELECT($GET(BEGDT)]"":BEGDT-1,1:"")
+42 FOR
SET DDATE=$ORDER(^BEDD.EDRoomUseI("RdtIdx",DDATE))
IF ((DDATE>ENDDT)!(DDATE=""))
QUIT
Begin DoDot:1
+43 SET RIEN=""
FOR
SET RIEN=$ORDER(^BEDD.EDRoomUseI("RdtIdx",DDATE,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+44 ;
+45 SET RMUSE=##CLASS(BEDD.EDRoomUse).%OpenId(RIEN)
+46 ;
+47 ;Room Use Report
+48 DO RU
End DoDot:2
End DoDot:1
+49 ;
+50 QUIT
+51 ;
RU ;EP - Room Use Report
+1 ;
+2 NEW ROOM,RMDT,RMTM,RMDTTM,XRMDT,CHK
+3 ;
+4 ;Get ID
+5 SET EDID=RMUSE.EDID
+6 SET CHK=""
+7 IF EDID]""
Begin DoDot:1
+8 NEW EDVST,DISP
+9 SET EDVST=##CLASS(BEDD.EDVISIT).%OpenId(EDID)
+10 SET DISP=EDVST.DispN
+11 IF DISP="REGISTERED IN ERROR"
SET CHK=1
End DoDot:1
IF CHK
QUIT
+12 ;
+13 ;Room
+14 SET ROOM=RMUSE.RoomID
IF ROOM=""
SET ROOM="ROOM"
+15 ;
+16 ;Room Date/Time
+17 SET RMDT=RMUSE.RoomDt
+18 SET RMTM=RMUSE.RoomTime
+19 SET RMDTTM=RMDT_","_RMTM
IF $TRANSLATE(RMDTTM,",")=""
SET RMDTTM=""
+20 SET XRMDT=$$HTE^XLFDT(RMDTTM)
+21 SET XTM=$PIECE($PIECE(XRMDT,"@",2),":")
IF XTM=""
SET XTM="."
+22 SET XTM=" "_XTM
IF XTM'["."
SET XTM=XTM_":00"
+23 ;
+24 SET ^TMP("BEDDRM",$JOB,"ROOM",RMDT,XTM,ROOM)=$GET(^TMP("BEDDRM",$JOB,"ROOM",RMDT,XTM,ROOM))+1
+25 SET ^TMP("BEDDRM",$JOB,"RLST",ROOM)=$GET(^TMP("BEDDRM",$JOB,"RLST",ROOM))+1
+26 SET ^TMP("BEDDRM",$JOB,"RTOT",RMDT,ROOM)=$GET(^TMP("BEDDRM",$JOB,"RTOT",RMDT,ROOM))+1
+27 ;
+28 QUIT
+29 ;
DLST(BEGDT,ENDDT) ;EP - Assemble List of Discharges for Date Ranges
+1 ;
+2 ;Error Trapping
+3 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDRPT D UNWIND^%ZTER"
+4 ;
+5 NEW DDATE,DIEN
+6 ;
+7 ;Reset scratch global
+8 KILL ^TMP("BEDDDSC",$JOB)
+9 ;
+10 ;Set in default dates if needed
+11 IF $GET(BEGDT)=""
IF $GET(ENDDT)=""
Begin DoDot:1
+12 SET BEGDT="T-1"
+13 SET ENDDT="T"
End DoDot:1
+14 ;
+15 ;Reformat inputed dates
+16 SET BEGDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(BEGDT),"5Y")
+17 SET ENDDT=$$FMTE^XLFDT($$DATE^BEDDUTIL(ENDDT),"5Y")
+18 ;
+19 ;Set external parameters in scratch global
+20 SET ^TMP("BEDDDSC",$JOB,"XBDT")=BEGDT
+21 SET ^TMP("BEDDDSC",$JOB,"XEDT")=ENDDT
+22 ;
+23 SET BEGDT=$PIECE($$TODLH^BEDDUTIL(BEGDT),",")
+24 SET ENDDT=$PIECE($$TODLH^BEDDUTIL(ENDDT),",")
+25 ;
+26 ;Set internal parameters in scratch global
+27 SET ^TMP("BEDDDSC",$JOB,"IBDT")=BEGDT
+28 SET ^TMP("BEDDDSC",$JOB,"IEDT")=ENDDT
+29 ;
+30 ;Assemble list of discharges
+31 SET DDATE=$SELECT($GET(BEGDT)]"":BEGDT-1,1:"")
+32 FOR
SET DDATE=$ORDER(^BEDD.EDVISITI("DisIdx",DDATE))
IF ((DDATE>ENDDT)!(DDATE=""))
QUIT
Begin DoDot:1
+33 SET DIEN=""
FOR
SET DIEN=$ORDER(^BEDD.EDVISITI("DisIdx",DDATE,DIEN))
IF DIEN=""
QUIT
Begin DoDot:2
+34 NEW EDVST,DSCDT,AMERVSIT
+35 SET EDVST=##CLASS(BEDD.EDVISIT).%OpenId(DIEN)
+36 SET AMERVSIT=EDVST.AMERVSIT
+37 SET DSCDT=$$GETF^BEDDUTIL(9009080,AMERVSIT,6.2,"I")
+38 SET ^TMP("BEDDDSC",$JOB,"LST",DSCDT,DIEN)=""
End DoDot:2
End DoDot:1
+39 ;
+40 QUIT
+41 ;
ERR ;
+1 DO ^%ZTER
+2 QUIT
