BGPMUH01 ; IHS/MSC/MGH - MI measure NQF0495&NQF0497 ED-1 ;13-May-2011 16:00;MGH
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;ED meaningful use reports
;Uses entries in the emergency room package
ENTRY(RPT) ;PEP 0495 Median time admission to discharge from ED
N START,END,ERADMIT,IEN,ERDIS,DFN,ERVST,ERPRV,ERDX,EREND,ERPRIDX,DXCHK,POP,ADMIT,LIST,ADMOR
S START=BGPBDATE
S END=BGPEDATE_".2359"
;Collect the data from the ER visit
F S START=$O(^AMERVSIT("B",START)) Q:START=""!(START>END) D
.S IEN="" F S IEN=$O(^AMERVSIT("B",START,IEN)) Q:IEN="" D
..S ERADMIT=$P($G(^AMERVSIT(IEN,0)),U,1)
..Q:'ERADMIT
..S DFN=$P($G(^AMERVSIT(IEN,0)),U,2),ERVST=$P($G(^AMERVSIT(IEN,0)),U,3)
..Q:'DFN
..S BGPACTUP=$$ACTUPAP^BGPMUEPD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
..I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q
..S ERPRV=$P($G(^AMERVSIT(IEN,0)),U,6)
..S ERPRIDX=$P($G(^AMERVSIT(IEN,5.1)),U,2)
..Q:'ERPRIDX
..S ERDIS=$P($G(^AMERVSIT(IEN,6)),U,1),EREND=$P($G(^AMERVSIT(IEN,6)),U,2)
..Q:'EREND
..;Set the default population for count
..S POP=1
..;Find admission and see if it was for OBS
..S ADMIT=$$FINDADM(DFN,ERADMIT,EREND)
..I ADMIT D
...I ADMIT=2 D
....S POP=2
....D RECSAVE(RPT,POP,.LIST,ERADMIT)
...;Check to see if primary dx was for behavioral health
...S DXCHK=$$CKDX(ERPRIDX)
...I +DXCHK D
....S POP=3 ;visits of behavioral health
....D RECSAVE(RPT,POP,.LIST,ERADMIT)
...;Add to default population if not behavioral health or OBS
...I POP=1 D
....D RECSAVE(RPT,POP,.LIST,ERADMIT)
Q
FINDADM(DFN,ERADMIT,EREND) ;FIND AN ADMISSION
N ADMIT,MGVT,MVTDT,MTVED,MVTIEN,X,X1,X2,TRANS,OBS,WARD,MVTFAC,TRANS2,FAC,SPEC
N MVTED,SRC,UB
S ADMIT=0
S X1=ERADMIT,X2=1 D C^%DTC S MVTED=X
S MVTIEN="" F S MVTIEN=$O(^DGPM("C",DFN,MVTIEN)) Q:MVTIEN="" D
.;The movement must be an admission movement
.S MVTDT=$P($G(^DGPM(MVTIEN,0)),U,1)
.Q:MVTDT<ERADMIT!(MVTDT>MVTED)
.S TRANS=$P($G(^DGPM(MVTIEN,0)),U,2)
.I TRANS=1 D
..S SRC=$P($G(^DGPM(MVTIEN,"IHS")),U,6)
..Q:'SRC
..S UB=$P($G(^AUTTASRC(SRC,0)),U,2)
..Q:UB'=7
..S WARD=$P($G(^DGPM(MVTIEN,0)),U,6)
..;Quit if the ward itself is an observation ward
..I WARD'="" D
...S OBS=$$WARDCK(WARD)
...S:+OBS ADMIT=2
..;Next check for the specialty on the admission
..S SPEC=0
..S MVTFAC="" F S MVTFAC=$O(^DGPM("CA",MVTIEN,MVTFAC)) Q:MVTFAC=""!(+SPEC) D
...S TRANS2=$P($G(^DGPM(MVTFAC,0)),U,2)
...I TRANS2=6 D
....S FAC=$P($G(^DGPM(MVTFAC,0)),U,9)
....I FAC'="" D
.....S SPEC=$$SPEC(FAC)
.....S:+SPEC ADMIT=2
..S:'ADMIT ADMIT=1
Q ADMIT
CKDX(DX) ;Check for primary diagnosis of behavioral health issue
N RESULT,BGPTX,TAX
S RESULT=0
S TAX="BGPMU ED MENTAL DISORDERS"
S BGPTX=$O(^ATXAX("B",TAX,0)) ;get taxonomy ien
I BGPTX="" Q 0 ;not a valid taxonomy
S RESULT=$$ICD^ATXCHK(DX,BGPTX,9)
Q RESULT
;Observation specialties from the Specialty (#42.4) file are:
;
; 18 - Neurology Observation
; 23 - Spinal Cord Injury Observation
; 24 - Medical Observation
; 36 - Blind Rehab Observation
; 41 - Rehab Medicine Observation
; 65 - Surgical Observation
; 94 - Psychiatric Observation
WARDCK(WARD) ;ward check
N SPIFN,WSPEC
S WSPEC=0
Q:WARD="" 0
S SPIFN=$P($G(^DIC(42,WARD,0)),U,12)
Q:SPIFN="" 0
S WSPEC=$$SPEC^DGPMOBS(SPIFN)
I +WSPEC=-1 S WSPEC=0
Q WSPEC
SPEC(FAC) ;specialty check
N SPIFN,FSPEC
Q:FAC="" 0
S SPIFN=$P($G(^DIC(45.7,FAC,0)),U,2)
S FSPEC=$$SPEC^DGPMOBS(SPIFN)
I +FSPEC=-1 S FSPEC=0
Q FSPEC
RECSAVE(RPT,POP,LIST,ER) ;save record
I RPT=1 D
.D SAVE(.LIST,POP,ER)
I RPT=2 D
.S ADMOR=$$ORDER(DFN,ERADMIT,EREND)
.I +ADMOR D SAVE2(.LIST,POP,ER)
D TOTAL(.LIST,RPT,POP)
Q
SAVE(LIST,POP,ER) ;Save the result
N TIME,X1,X2,X3,CNT,RESULT
S CNT=$G(^TMP("BGPMU0495",$J,BGPMUTF,"POP",POP,"PAT","CNT"))
S CNT=CNT+1
S X1=EREND,X2=ERADMIT,X3=2
S TIME=$$FMDIFF^XLFDT(X1,X2,X3)
S LIST("ORDERED",POP,TIME,CNT)=TIME
S LIST("POP",POP,CNT)=TIME
I POP=1 S RESULT="ED:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER) S BGPICARE("MU.ED.0495.1",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
I POP=2 S RESULT="OS:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER) S BGPICARE("MU.ED.0495.2",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
I POP=3 S RESULT="MD:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER) S BGPICARE("MU.ED.0495.3",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
S ^TMP("BGPMU0495",$J,BGPMUTF,"POP",POP,"PAT","CNT")=CNT
S ^TMP("BGPMU0495",$J,BGPMUTF,"POP",POP,"PAT",CNT)=DFN_U_RESULT
Q
SAVE2(LIST,POP,ER) ;Save the result
N TIME,X1,X2,X3,CNT,RESULT
S CNT=$G(^TMP("BGPMU0497",$J,BGPMUTF,"POP",POP,"PAT","CNT"))
S CNT=CNT+1
S X1=EREND,X2=ADMOR,X3=2
S TIME=$$FMDIFF^XLFDT(X1,X2,X3)
S LIST("ORDERED",POP,TIME,CNT)=TIME
S LIST("POP",POP,CNT)=TIME
I POP=1 S RESULT="ED:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER) S BGPICARE("MU.ED.0497.1",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
I POP=2 S RESULT="MD:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER) S BGPICARE("MU.ED.0497.2",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
I POP=3 S RESULT="OS:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER) S BGPICARE("MU.ED.0497.3",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
S ^TMP("BGPMU0497",$J,BGPMUTF,"POP",POP,"PAT","CNT")=CNT
S ^TMP("BGPMU0497",$J,BGPMUTF,"POP",POP,"PAT",CNT)=DFN_U_RESULT
Q
ORDER(DFN,START,END) ;Find the admission order
;Admission order should be after the ER admit time and before the ER end time
N ADMIT,DISCH,PT,ORD,ORIEN,ORDIA,ORDLK,TXT,RET
S RET=""
S ADMIT=9999999-START,DISCH=9999999-END
S PT=DFN_";DPT("
S ORD=DISCH F S ORD=$O(^OR(100,"AR",PT,ORD)) Q:ORD=""!(ORD>ADMIT)!(+RET) D
.S ORIEN="" F S ORIEN=$O(^OR(100,"AR",PT,ORD,ORIEN)) Q:ORIEN="" D
..S ORDIA=$P($G(^OR(100,ORIEN,0)),U,5)
..S ORDLK=$P(ORDIA,";",1)
..S TXT=$P($G(^ORD(101.41,ORDLK,0)),U,1)
..I TXT["ADMIT" S RET=$P($G(^OR(100,ORIEN,0)),U,7)
Q RET
TOTAL(LIST,RPT,POP) ;Find the median
N CNT2,MIDDLE,MID1,MID2,WHOLE,CNT,MEDIAN,OFFSET,OFFSET2,I
S MIDDLE=""
I RPT=1 D
.S CNT=$G(^TMP("BGPMU0495",$J,BGPMUTF,"POP",POP,"PAT","CNT"))
I RPT=2 D
.S CNT=$G(^TMP("BGPMU0497",$J,BGPMUTF,"POP",POP,"PAT","CNT"))
S CNT2=CNT/2
I $P(CNT2,".",2)="" D
.;EVEN number of patients - average the middle two
.S WHOLE=$P(CNT2,".",1)
.S OFFSET=0
.;;;;;;I WHOLE="" S WHOLE=0,OFFSET=$O(LIST("ORDERED",POP,OFFSET))
.I WHOLE="" S WHOLE=1
.S TIME="" F S TIME=$O(LIST("ORDERED",POP,TIME)) Q:TIME=""!(+MIDDLE) D
..S PTCNT="" F S PTCNT=$O(LIST("ORDERED",POP,TIME,PTCNT)) Q:PTCNT=""!(+MIDDLE) D
...S OFFSET=OFFSET+1
...I OFFSET=WHOLE D
....S NXTPT=$O(LIST("ORDERED",POP,TIME,PTCNT))
....I NXTPT'="" S (MID1,MID2)=TIME ;Two middle patients had the same time
....E S MID1=TIME,MID2=$O(LIST("ORDERED",POP,TIME)) ;get next time for 2nd patient
....S MIDDLE=(MID1+MID2)/2
E D
.;ODD number of patients - use the middle patient's time
.S WHOLE=$P(CNT2,".",1)
.S OFFSET=0
.S TIME="" F S TIME=$O(LIST("ORDERED",POP,TIME)) Q:TIME=""!(+MIDDLE) D
..S PTCNT="" F S PTCNT=$O(LIST("ORDERED",POP,TIME,PTCNT)) Q:PTCNT=""!(+MIDDLE) D
...S OFFSET=OFFSET+1
...I OFFSET>WHOLE S MIDDLE=TIME
S MEDIAN=MIDDLE/60 ;get answer in minutes
I RPT=1 D
.S ^TMP("BGPMU0495",$J,BGPMUTF,"POP",POP)=MEDIAN_U_CNT
I RPT=2 D
.S ^TMP("BGPMU0497",$J,BGPMUTF,"POP",POP)=MEDIAN_U_CNT
Q
ENTRY2 ;PEP 0497 Time from provider order to discharge
BGPMUH01 ; IHS/MSC/MGH - MI measure NQF0495&NQF0497 ED-1 ;13-May-2011 16:00;MGH
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;ED meaningful use reports
+3 ;Uses entries in the emergency room package
ENTRY(RPT) ;PEP 0495 Median time admission to discharge from ED
+1 NEW START,END,ERADMIT,IEN,ERDIS,DFN,ERVST,ERPRV,ERDX,EREND,ERPRIDX,DXCHK,POP,ADMIT,LIST,ADMOR
+2 SET START=BGPBDATE
+3 SET END=BGPEDATE_".2359"
+4 ;Collect the data from the ER visit
+5 FOR
SET START=$ORDER(^AMERVSIT("B",START))
IF START=""!(START>END)
QUIT
Begin DoDot:1
+6 SET IEN=""
FOR
SET IEN=$ORDER(^AMERVSIT("B",START,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+7 SET ERADMIT=$PIECE($GET(^AMERVSIT(IEN,0)),U,1)
+8 IF 'ERADMIT
QUIT
+9 SET DFN=$PIECE($GET(^AMERVSIT(IEN,0)),U,2)
SET ERVST=$PIECE($GET(^AMERVSIT(IEN,0)),U,3)
+10 IF 'DFN
QUIT
+11 SET BGPACTUP=$$ACTUPAP^BGPMUEPD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
+12 IF 'BGPACTUP
IF '$GET(BGPXPXPX)
IF '$GET(BGPIISO)
QUIT
+13 SET ERPRV=$PIECE($GET(^AMERVSIT(IEN,0)),U,6)
+14 SET ERPRIDX=$PIECE($GET(^AMERVSIT(IEN,5.1)),U,2)
+15 IF 'ERPRIDX
QUIT
+16 SET ERDIS=$PIECE($GET(^AMERVSIT(IEN,6)),U,1)
SET EREND=$PIECE($GET(^AMERVSIT(IEN,6)),U,2)
+17 IF 'EREND
QUIT
+18 ;Set the default population for count
+19 SET POP=1
+20 ;Find admission and see if it was for OBS
+21 SET ADMIT=$$FINDADM(DFN,ERADMIT,EREND)
+22 IF ADMIT
Begin DoDot:3
+23 IF ADMIT=2
Begin DoDot:4
+24 SET POP=2
+25 DO RECSAVE(RPT,POP,.LIST,ERADMIT)
End DoDot:4
+26 ;Check to see if primary dx was for behavioral health
+27 SET DXCHK=$$CKDX(ERPRIDX)
+28 IF +DXCHK
Begin DoDot:4
+29 ;visits of behavioral health
SET POP=3
+30 DO RECSAVE(RPT,POP,.LIST,ERADMIT)
End DoDot:4
+31 ;Add to default population if not behavioral health or OBS
+32 IF POP=1
Begin DoDot:4
+33 DO RECSAVE(RPT,POP,.LIST,ERADMIT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
FINDADM(DFN,ERADMIT,EREND) ;FIND AN ADMISSION
+1 NEW ADMIT,MGVT,MVTDT,MTVED,MVTIEN,X,X1,X2,TRANS,OBS,WARD,MVTFAC,TRANS2,FAC,SPEC
+2 NEW MVTED,SRC,UB
+3 SET ADMIT=0
+4 SET X1=ERADMIT
SET X2=1
DO C^%DTC
SET MVTED=X
+5 SET MVTIEN=""
FOR
SET MVTIEN=$ORDER(^DGPM("C",DFN,MVTIEN))
IF MVTIEN=""
QUIT
Begin DoDot:1
+6 ;The movement must be an admission movement
+7 SET MVTDT=$PIECE($GET(^DGPM(MVTIEN,0)),U,1)
+8 IF MVTDT<ERADMIT!(MVTDT>MVTED)
QUIT
+9 SET TRANS=$PIECE($GET(^DGPM(MVTIEN,0)),U,2)
+10 IF TRANS=1
Begin DoDot:2
+11 SET SRC=$PIECE($GET(^DGPM(MVTIEN,"IHS")),U,6)
+12 IF 'SRC
QUIT
+13 SET UB=$PIECE($GET(^AUTTASRC(SRC,0)),U,2)
+14 IF UB'=7
QUIT
+15 SET WARD=$PIECE($GET(^DGPM(MVTIEN,0)),U,6)
+16 ;Quit if the ward itself is an observation ward
+17 IF WARD'=""
Begin DoDot:3
+18 SET OBS=$$WARDCK(WARD)
+19 IF +OBS
SET ADMIT=2
End DoDot:3
+20 ;Next check for the specialty on the admission
+21 SET SPEC=0
+22 SET MVTFAC=""
FOR
SET MVTFAC=$ORDER(^DGPM("CA",MVTIEN,MVTFAC))
IF MVTFAC=""!(+SPEC)
QUIT
Begin DoDot:3
+23 SET TRANS2=$PIECE($GET(^DGPM(MVTFAC,0)),U,2)
+24 IF TRANS2=6
Begin DoDot:4
+25 SET FAC=$PIECE($GET(^DGPM(MVTFAC,0)),U,9)
+26 IF FAC'=""
Begin DoDot:5
+27 SET SPEC=$$SPEC(FAC)
+28 IF +SPEC
SET ADMIT=2
End DoDot:5
End DoDot:4
End DoDot:3
+29 IF 'ADMIT
SET ADMIT=1
End DoDot:2
End DoDot:1
+30 QUIT ADMIT
CKDX(DX) ;Check for primary diagnosis of behavioral health issue
+1 NEW RESULT,BGPTX,TAX
+2 SET RESULT=0
+3 SET TAX="BGPMU ED MENTAL DISORDERS"
+4 ;get taxonomy ien
SET BGPTX=$ORDER(^ATXAX("B",TAX,0))
+5 ;not a valid taxonomy
IF BGPTX=""
QUIT 0
+6 SET RESULT=$$ICD^ATXCHK(DX,BGPTX,9)
+7 QUIT RESULT
+8 ;Observation specialties from the Specialty (#42.4) file are:
+9 ;
+10 ; 18 - Neurology Observation
+11 ; 23 - Spinal Cord Injury Observation
+12 ; 24 - Medical Observation
+13 ; 36 - Blind Rehab Observation
+14 ; 41 - Rehab Medicine Observation
+15 ; 65 - Surgical Observation
+16 ; 94 - Psychiatric Observation
WARDCK(WARD) ;ward check
+1 NEW SPIFN,WSPEC
+2 SET WSPEC=0
+3 IF WARD=""
QUIT 0
+4 SET SPIFN=$PIECE($GET(^DIC(42,WARD,0)),U,12)
+5 IF SPIFN=""
QUIT 0
+6 SET WSPEC=$$SPEC^DGPMOBS(SPIFN)
+7 IF +WSPEC=-1
SET WSPEC=0
+8 QUIT WSPEC
SPEC(FAC) ;specialty check
+1 NEW SPIFN,FSPEC
+2 IF FAC=""
QUIT 0
+3 SET SPIFN=$PIECE($GET(^DIC(45.7,FAC,0)),U,2)
+4 SET FSPEC=$$SPEC^DGPMOBS(SPIFN)
+5 IF +FSPEC=-1
SET FSPEC=0
+6 QUIT FSPEC
RECSAVE(RPT,POP,LIST,ER) ;save record
+1 IF RPT=1
Begin DoDot:1
+2 DO SAVE(.LIST,POP,ER)
End DoDot:1
+3 IF RPT=2
Begin DoDot:1
+4 SET ADMOR=$$ORDER(DFN,ERADMIT,EREND)
+5 IF +ADMOR
DO SAVE2(.LIST,POP,ER)
End DoDot:1
+6 DO TOTAL(.LIST,RPT,POP)
+7 QUIT
SAVE(LIST,POP,ER) ;Save the result
+1 NEW TIME,X1,X2,X3,CNT,RESULT
+2 SET CNT=$GET(^TMP("BGPMU0495",$JOB,BGPMUTF,"POP",POP,"PAT","CNT"))
+3 SET CNT=CNT+1
+4 SET X1=EREND
SET X2=ERADMIT
SET X3=2
+5 SET TIME=$$FMDIFF^XLFDT(X1,X2,X3)
+6 SET LIST("ORDERED",POP,TIME,CNT)=TIME
+7 SET LIST("POP",POP,CNT)=TIME
+8 IF POP=1
SET RESULT="ED:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER)
SET BGPICARE("MU.ED.0495.1",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
+9 IF POP=2
SET RESULT="OS:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER)
SET BGPICARE("MU.ED.0495.2",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
+10 IF POP=3
SET RESULT="MD:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER)
SET BGPICARE("MU.ED.0495.3",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
+11 SET ^TMP("BGPMU0495",$JOB,BGPMUTF,"POP",POP,"PAT","CNT")=CNT
+12 SET ^TMP("BGPMU0495",$JOB,BGPMUTF,"POP",POP,"PAT",CNT)=DFN_U_RESULT
+13 QUIT
SAVE2(LIST,POP,ER) ;Save the result
+1 NEW TIME,X1,X2,X3,CNT,RESULT
+2 SET CNT=$GET(^TMP("BGPMU0497",$JOB,BGPMUTF,"POP",POP,"PAT","CNT"))
+3 SET CNT=CNT+1
+4 SET X1=EREND
SET X2=ADMOR
SET X3=2
+5 SET TIME=$$FMDIFF^XLFDT(X1,X2,X3)
+6 SET LIST("ORDERED",POP,TIME,CNT)=TIME
+7 SET LIST("POP",POP,CNT)=TIME
+8 IF POP=1
SET RESULT="ED:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER)
SET BGPICARE("MU.ED.0497.1",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
+9 IF POP=2
SET RESULT="MD:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER)
SET BGPICARE("MU.ED.0497.2",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
+10 IF POP=3
SET RESULT="OS:"_(TIME/60)_" "_$$DATE^BGPMUUTL(ER)
SET BGPICARE("MU.ED.0497.3",BGPMUTF,CNT)=DFN_U_TIME_U_POP_U_U_RESULT
+11 SET ^TMP("BGPMU0497",$JOB,BGPMUTF,"POP",POP,"PAT","CNT")=CNT
+12 SET ^TMP("BGPMU0497",$JOB,BGPMUTF,"POP",POP,"PAT",CNT)=DFN_U_RESULT
+13 QUIT
ORDER(DFN,START,END) ;Find the admission order
+1 ;Admission order should be after the ER admit time and before the ER end time
+2 NEW ADMIT,DISCH,PT,ORD,ORIEN,ORDIA,ORDLK,TXT,RET
+3 SET RET=""
+4 SET ADMIT=9999999-START
SET DISCH=9999999-END
+5 SET PT=DFN_";DPT("
+6 SET ORD=DISCH
FOR
SET ORD=$ORDER(^OR(100,"AR",PT,ORD))
IF ORD=""!(ORD>ADMIT)!(+RET)
QUIT
Begin DoDot:1
+7 SET ORIEN=""
FOR
SET ORIEN=$ORDER(^OR(100,"AR",PT,ORD,ORIEN))
IF ORIEN=""
QUIT
Begin DoDot:2
+8 SET ORDIA=$PIECE($GET(^OR(100,ORIEN,0)),U,5)
+9 SET ORDLK=$PIECE(ORDIA,";",1)
+10 SET TXT=$PIECE($GET(^ORD(101.41,ORDLK,0)),U,1)
+11 IF TXT["ADMIT"
SET RET=$PIECE($GET(^OR(100,ORIEN,0)),U,7)
End DoDot:2
End DoDot:1
+12 QUIT RET
TOTAL(LIST,RPT,POP) ;Find the median
+1 NEW CNT2,MIDDLE,MID1,MID2,WHOLE,CNT,MEDIAN,OFFSET,OFFSET2,I
+2 SET MIDDLE=""
+3 IF RPT=1
Begin DoDot:1
+4 SET CNT=$GET(^TMP("BGPMU0495",$JOB,BGPMUTF,"POP",POP,"PAT","CNT"))
End DoDot:1
+5 IF RPT=2
Begin DoDot:1
+6 SET CNT=$GET(^TMP("BGPMU0497",$JOB,BGPMUTF,"POP",POP,"PAT","CNT"))
End DoDot:1
+7 SET CNT2=CNT/2
+8 IF $PIECE(CNT2,".",2)=""
Begin DoDot:1
+9 ;EVEN number of patients - average the middle two
+10 SET WHOLE=$PIECE(CNT2,".",1)
+11 SET OFFSET=0
+12 ;;;;;;I WHOLE="" S WHOLE=0,OFFSET=$O(LIST("ORDERED",POP,OFFSET))
+13 IF WHOLE=""
SET WHOLE=1
+14 SET TIME=""
FOR
SET TIME=$ORDER(LIST("ORDERED",POP,TIME))
IF TIME=""!(+MIDDLE)
QUIT
Begin DoDot:2
+15 SET PTCNT=""
FOR
SET PTCNT=$ORDER(LIST("ORDERED",POP,TIME,PTCNT))
IF PTCNT=""!(+MIDDLE)
QUIT
Begin DoDot:3
+16 SET OFFSET=OFFSET+1
+17 IF OFFSET=WHOLE
Begin DoDot:4
+18 SET NXTPT=$ORDER(LIST("ORDERED",POP,TIME,PTCNT))
+19 ;Two middle patients had the same time
IF NXTPT'=""
SET (MID1,MID2)=TIME
+20 ;get next time for 2nd patient
IF '$TEST
SET MID1=TIME
SET MID2=$ORDER(LIST("ORDERED",POP,TIME))
+21 SET MIDDLE=(MID1+MID2)/2
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 ;ODD number of patients - use the middle patient's time
+24 SET WHOLE=$PIECE(CNT2,".",1)
+25 SET OFFSET=0
+26 SET TIME=""
FOR
SET TIME=$ORDER(LIST("ORDERED",POP,TIME))
IF TIME=""!(+MIDDLE)
QUIT
Begin DoDot:2
+27 SET PTCNT=""
FOR
SET PTCNT=$ORDER(LIST("ORDERED",POP,TIME,PTCNT))
IF PTCNT=""!(+MIDDLE)
QUIT
Begin DoDot:3
+28 SET OFFSET=OFFSET+1
+29 IF OFFSET>WHOLE
SET MIDDLE=TIME
End DoDot:3
End DoDot:2
End DoDot:1
+30 ;get answer in minutes
SET MEDIAN=MIDDLE/60
+31 IF RPT=1
Begin DoDot:1
+32 SET ^TMP("BGPMU0495",$JOB,BGPMUTF,"POP",POP)=MEDIAN_U_CNT
End DoDot:1
+33 IF RPT=2
Begin DoDot:1
+34 SET ^TMP("BGPMU0497",$JOB,BGPMUTF,"POP",POP)=MEDIAN_U_CNT
End DoDot:1
+35 QUIT
ENTRY2 ;PEP 0497 Time from provider order to discharge
