BSDWKR6 ;cmi/anch/maw - BSD Turn Around Time Report 2/20/2007 2:41:31 PM
;;5.3;PIMS;**1007,1010,1011,1012,1019**;FEB 27, 2007;Build 3
;
;
;cmi/anch/maw 2/20/2007 PATCH 1007 item 1007.24
;cmi/flag/maw 11/19/2009 PATCH 1011 mods for PIMC in formatting
;
ASK ; -- ask user questions
NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,Y
;
S BSDSUB="C"
;
; get clinic arrays based on subtotal category
;S BSDSRT=$$READ^BDGF("S^D:Detailed;S:Summary","Select type of report")
;
D CLINIC^BSDU(2) G EXIT:$D(BSDQ)
;I BSDSRT="S" D CLINIC^BSDU(2) G EXIT:$D(BSDQ)
;I BSDSRT="D" D ONE
G EXIT:$D(BSDQ)
;
S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") G EXIT:'BSDBD
S BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search") G EXIT:'BSDED
;
S BSDSRT=$$READ^BDGF("S^D:Detailed;S:Summary","Select type of report")
;
S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
D ZIS^BDGF("PQ","START^BSDWKR6","TURN AROUND TIME","BSDDET;BSDSUB;BSDSRT;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
Q
;
ONE() ;-- get one clinic
S VAUTC=0
S DIC="^SC("
S DIC(0)="AEMQZ"
S DIC("A")="Select Clinic: "
D ^DIC
I Y<0 S BSDQ=1 Q
S VAUTC(+Y)=$P(Y,U,2)
Q
;
START ;EP; -- re-entry for printing to paper
D INIT,PRINT Q
;
EN ; -- main entry point for BSDRM WORK STATS
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDRM TAT REPORT")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(31)_"Turn Around Time"
S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDWKR6",$J),^TMP("BSD",$J)
NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
;
; -- loop by clinic
NEW CLN,NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,SUB2,END,CHK,BSDCHKI,BSDCHKO,BSDCNT
S CLN=0 F S CLN=$O(@BSDAR@(CLN)) Q:'CLN D
. Q:'$$GET1^DIQ(44,CLN,3.5,"I") ;No Div entered for this clinic
. I $D(VAUTD) Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I"))))) ;this Div notd
. Q:$D(^SC("AIHSPC",CLN)) ;quit if principal clinic
. ;S NAME=$$GET1^DIQ(44,CLN,.01) ;set clinic's name
. ;D SET(NAME,.VALMCNT) ;setup the line with clinic name
. ;
. ; -- then by appt date (within range)
. S APPT=BSDBD,END=BSDED+.2400
. F S APPT=$O(^SC(CLN,"S",APPT)) Q:'APPT!(APPT>END) D
.. ;
.. ; -- then find appts to count
.. S APPN=0,BSDCNT=0
.. N APPDT
.. S APPDT=0
.. F S APPN=$O(^SC(CLN,"S",APPT,1,APPN)) Q:'APPN D
... S PAT=+^SC(CLN,"S",APPT,1,APPN,0) ;patient ien
... S STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100) ;current status
... Q:STATUS["CANCEL" Q:STATUS="FUTURE"
... Q:STATUS="NON-COUNT" Q:STATUS="DELETED"
... S CHK=$G(^SC(CLN,"S",APPT,1,APPN,"C")) ;checkin node
... S BSDCHKI=$$LPAD($P(CHK,U),12)
... Q:'$G(BSDCHKI)
... S BSDCHKO=$$LPAD($P(CHK,U,3),12)
... N APPNA,APPTA
... S APPNA=$$LPAD($P(APPT,".",2),4)
... S APPTA=$P(APPT,".")
... S ^TMP("BSD",$J,CLN,APPTA,"IN")=$G(^TMP("BSD",$J,CLN,APPTA,"IN"))+1
... S ^TMP("BSD","D",$J,CLN,APPT,PAT)=BSDCHKI_U_BSDCHKO_U_$$GETTAT(BSDCHKI,BSDCHKO)
... I BSDCHKO D
.... S ^TMP("BSD",$J,CLN,APPTA,"OUT")=$G(^TMP("BSD",$J,CLN,APPTA,"OUT"))+1
.... S ^TMP("BSD",$J,CLN,APPTA,"TAT")=$G(^TMP("BSD",$J,CLN,APPTA,"TAT"))+$$GETTAT(BSDCHKI,BSDCHKO)
N BSDDA
S BSDDA=0 F S BSDDA=$O(^TMP("BSD",$J,BSDDA)) Q:'BSDDA D
. S NAME=$$GET1^DIQ(44,BSDDA,.01) ;set clinic's name
. D SET(NAME,.VALMCNT) ;setup the line with clinic name
. N BSDIEN S BSDIEN=0 F S BSDIEN=$O(^TMP("BSD",$J,BSDDA,BSDIEN)) Q:'BSDIEN D
.. N BSDCNTI,BSDCNTO,BSDTAT
.. S BSDCNTI=$G(^TMP("BSD",$J,BSDDA,BSDIEN,"IN"))
.. S BSDCNTO=$G(^TMP("BSD",$J,BSDDA,BSDIEN,"OUT"))
.. S BSDTAT=$S($G(^TMP("BSD",$J,BSDDA,BSDIEN,"OUT")):$G(^TMP("BSD",$J,BSDDA,BSDIEN,"TAT"))/$G(^TMP("BSD",$J,BSDDA,BSDIEN,"OUT")),1:"")
.. S LINE=$$PAD($$FMTE^XLFDT(BSDIEN),20)
.. S LINE=LINE_$$PAD(BSDCNTI,20)
.. S LINE=LINE_$$PAD(BSDCNTO,18)
.. S LINE=LINE_$$PAD($$FMTT(BSDTAT),15)
.. D SET(LINE,.VALMCNT)
.. I BSDSRT="D" D
...S LINE=$$HDRD
...D SET(LINE,.VALMCNT)
...S LINE=$$REPEAT^XLFSTR("-",100)
...D SET(LINE,.VALMCNT)
...D DET(BSDDA,BSDIEN)
...D SET("",.VALMCNT)
I BSDSRT="S" K ^TMP("BSD",$J) Q
Q
;cmi/maw lines below no longer used
D SET("",.VALMCNT)
S LINE=$$HDRD
D SET(LINE,.VALMCNT)
S LINE=$$REPEAT^XLFSTR("-",100)
D SET(LINE,.VALMCNT)
N BSDDDA
S BSDDDA=0 F S BSDDDA=$O(^TMP("BSD","D",$J,BSDDDA)) Q:'BSDDDA D
. N BSDDIEN S BSDDIEN=0 F S BSDDIEN=$O(^TMP("BSD","D",$J,BSDDDA,BSDDIEN)) Q:'BSDDIEN D
.. N BSDDOEN S BSDDOEN=0 F S BSDDOEN=$O(^TMP("BSD","D",$J,BSDDDA,BSDDIEN,BSDDOEN)) Q:BSDDOEN="" D
... N BSDDATA,BSDCI,BSDCO,BSDT
... S BSDDATA=$G(^TMP("BSD","D",$J,BSDDDA,BSDDIEN,BSDDOEN))
... S BSDCI=$P(BSDDATA,U)
... S BSDCO=$P(BSDDATA,U,2)
... S BSDT=$P(BSDDATA,U,3)
... S LINE=$$PAD($E($P($G(^DPT(BSDDOEN,0)),U),1,18),20)
... S LINE=LINE_$$PAD($$HRN^AUPNPAT(BSDDOEN,DUZ(2)),8)
... S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDDIEN),20)
... S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCI),20)
... S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCO),20)
... S LINE=LINE_$$PAD($$FMTT(BSDT),11) ;cmi/maw 11/19/2009
... D SET(LINE,.VALMCNT)
K ^TMP("BSD",$J)
Q
;
DET(BSDDDA,BSDDDIEN) ;-- print out the details
N BSDEND
S BSDEND=BSDDDIEN+.9999
F S BSDDDIEN=$O(^TMP("BSD","D",$J,BSDDDA,BSDDDIEN)) Q:BSDDDIEN>BSDEND!('$G(BSDDDIEN)) D
.N BSDDOEN S BSDDOEN=0 F S BSDDOEN=$O(^TMP("BSD","D",$J,BSDDDA,BSDDDIEN,BSDDOEN)) Q:BSDDOEN="" D
.. N BSDDATA,BSDCI,BSDCO,BSDT
.. S BSDDATA=$G(^TMP("BSD","D",$J,BSDDDA,BSDDDIEN,BSDDOEN))
.. S BSDCI=$P(BSDDATA,U)
.. S BSDCO=$P(BSDDATA,U,2)
.. S BSDT=$P(BSDDATA,U,3)
.. S LINE=$$PAD($E($P($G(^DPT(BSDDOEN,0)),U),1,18),20)
.. S LINE=LINE_$$PAD($$HRN^AUPNPAT(BSDDOEN,DUZ(2)),8)
.. S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDDDIEN),20)
.. S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCI),20)
.. S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCO),20)
.. S LINE=LINE_$$PAD($$FMTT(BSDT),11) ;cmi/maw 11/19/2009
.. D SET(LINE,.VALMCNT)
Q
;
FMTT(T) ;-- reformat TAT
N LT,LTI,M
S LT=$L(T)
;S M=" min" cmi/maw 11/19/2009 PATCH 1011
S M=" H:min" ;cmi/maw 11/19/2009 PATCH 1011
S T=(T)\60_":"_$S($L((T)#60)<2:"0"_((T)#60),1:((T)#60)) ;cmi/maw 11/19/2009 PATCH 1011
S T=$E(T,1,4) ;cmi/maw 6/9/2010 PATCH 1012
I $L(T)=0 Q ""
I $L(T)=1 Q T_" "_M
I $L(T)=2 Q T_" "_M
I $L(T)=3 Q T_" "_M
I $L(T)=4 Q T_" "_M
Q T_M
;
LPAD(A,L) ;-- pad the length to 4 digits
I A="" Q ""
I $L(A)=12 Q A
I $L(A)=11 Q A_"0"
I $L(A)=10 Q A_"00"
I $L(A)=4 Q A
I $L(A)=3 Q A_"0"
I $L(A)=2 Q A_"00"
Q A_"000"
;
GETTAT(I,O) ;-- calculate turnaround time
I '$G(O) Q ""
N IT,OT,ITH,ITM,OTH,OTM,ET,BT,TS,H,M,S
S IT=$P(I,".",2)
S OT=$P(O,".",2)
S X=I
D H^%DTC
S ITH=%H
S ITM=%T
S X=O
D H^%DTC
S OTH=%H
S OTM=%T
S ET=OTH_","_OTM
S BT=ITH_","_ITM
;I $D(ET) S TS=(86400*($P(ET,",")-$P(BT,",")))+($P(ET,",",2)-$P(BT,",",2)),H=$P(TS/3600,".") S:H="" H=0 D
;.S TS=TS-(H*3600),M=$P(TS/60,".") S:M="" M=0 S TS=TS-(M*60),S=TS
I $D(ET) S TS=(86400*($P(ET,",")-$P(BT,",")))+($P(ET,",",2)-$P(BT,",",2)),H=$P(TS/3600,".") S:H="" H=0 D
.;S TS=TS-(H*3600),M=$P(TS/60,".") S:M="" M=0 S TS=TS-(M*60),S=TS
.S M=$P((TS/60),".") S:M="" M=0 ;cmi/maw 7/22/2010 patch 1012
Q $G(M) ;cmi/maw 11/19/2009 PATCH 1011
;Q +$G(H)_"."_+$G(M)_"."_+$G(S)
;Q OT-IT ;cmi/maw TODO fix this calculation
;
SET(LINE,NUM) ; -- sets display line into array
S NUM=NUM+1
S ^TMP("BSDWKR6",$J,NUM,0)=LINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
HELP1 ;EP; help for subtotal question
D MSG^BDGF("This report will display Turnaround Time for;",1,0)
D MSG^BDGF("clinic(s). Turnaround time is the difference",1,0)
D MSG^BDGF("between Checkin Time and Checkout Time. If there;",1,0)
D MSG^BDGF("is not a checkout time, turnaround time is blank;",1,0)
D MSG^BDGF(" Choose D to display a Detailed Report.",1,0)
D MSG^BDGF(" Choose S to display a Summary Report.",1,0)
Q
;
EXIT ; -- exit code
K ^TMP("BSDWKR6",$J),BSDQ,PAGE
Q
;
EXPND ; -- expand code
Q
;
PRINT ; print report to paper
S PAGE=1
U IO D HDG
NEW BSDX S BSDX=0 F S BSDX=$O(^TMP("BSDWKR6",$J,BSDX)) Q:'BSDX D
. I $Y>(IOSL-4) D
..S PAGE=PAGE+1
..;S Y=$$READ^BDGF("E","Press Return to Continue")
..I $E(IOST,1,1)="C" S Y=$$READ^BDGF("E","Press Return to Continue") ;ihs/cmi/maw 01/29/2016 PATCH 1019
..D HDG
. W !,^TMP("BSDWKR6",$J,BSDX,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF ;,?31,"Turnaround Time"
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I) I I=1 W ?70,$S($G(PAGE):"Page: "_$G(PAGE),1:"")
W !,$$REPEAT^XLFSTR("-",80)
W !,"Appt Date",?20,"Checked In",?40,"Checked Out",?58,"Avg TAT"
W !,$$REPEAT^XLFSTR("=",80)
Q
;
HDGD ;-- do the header for the detailed report
W !,$$REPEAT^XLFSTR("-",100)
W !,"Patient Name",?20,"Chart",?28,"Appointment",?42,"Checkin",?59,"Checkout",?78,"TAT"
W !,$$REPEAT^XLFSTR("=",100)
Q
;
HDRD() ;-- do the header
N LN
S LN=$$PAD("Patient Name",20)
S LN=LN_$$PAD("Chart",8)
S LN=LN_$$PAD("Appointment",20)
S LN=LN_$$PAD("Check In",20)
S LN=LN_$$PAD("Check Out",20)
S LN=LN_$$PAD("TAT",10)
Q LN
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
;
BSDWKR6 ;cmi/anch/maw - BSD Turn Around Time Report 2/20/2007 2:41:31 PM
+1 ;;5.3;PIMS;**1007,1010,1011,1012,1019**;FEB 27, 2007;Build 3
+2 ;
+3 ;
+4 ;cmi/anch/maw 2/20/2007 PATCH 1007 item 1007.24
+5 ;cmi/flag/maw 11/19/2009 PATCH 1011 mods for PIMC in formatting
+6 ;
ASK ; -- ask user questions
+1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,Y
+2 ;
+3 SET BSDSUB="C"
+4 ;
+5 ; get clinic arrays based on subtotal category
+6 ;S BSDSRT=$$READ^BDGF("S^D:Detailed;S:Summary","Select type of report")
+7 ;
+8 DO CLINIC^BSDU(2)
IF $DATA(BSDQ)
GOTO EXIT
+9 ;I BSDSRT="S" D CLINIC^BSDU(2) G EXIT:$D(BSDQ)
+10 ;I BSDSRT="D" D ONE
+11 IF $DATA(BSDQ)
GOTO EXIT
+12 ;
+13 SET BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search")
IF 'BSDBD
GOTO EXIT
+14 SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")
IF 'BSDED
GOTO EXIT
+15 ;
+16 SET BSDSRT=$$READ^BDGF("S^D:Detailed;S:Summary","Select type of report")
+17 ;
+18 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+19 DO ZIS^BDGF("PQ","START^BSDWKR6","TURN AROUND TIME","BSDDET;BSDSUB;BSDSRT;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
+20 QUIT
+21 ;
ONE() ;-- get one clinic
+1 SET VAUTC=0
+2 SET DIC="^SC("
+3 SET DIC(0)="AEMQZ"
+4 SET DIC("A")="Select Clinic: "
+5 DO ^DIC
+6 IF Y<0
SET BSDQ=1
QUIT
+7 SET VAUTC(+Y)=$PIECE(Y,U,2)
+8 QUIT
+9 ;
START ;EP; -- re-entry for printing to paper
+1 DO INIT
DO PRINT
QUIT
+2 ;
EN ; -- main entry point for BSDRM WORK STATS
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BSDRM TAT REPORT")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(31)_"Turn Around Time"
+2 SET VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BSDWKR6",$JOB),^TMP("BSD",$JOB)
+2 NEW BSDAR
SET BSDAR=$SELECT(VAUTC:"^SC",1:"VAUTC")
+3 ;
+4 ; -- loop by clinic
+5 NEW CLN,NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,SUB2,END,CHK,BSDCHKI,BSDCHKO,BSDCNT
+6 SET CLN=0
FOR
SET CLN=$ORDER(@BSDAR@(CLN))
IF 'CLN
QUIT
Begin DoDot:1
+7 ;No Div entered for this clinic
IF '$$GET1^DIQ(44,CLN,3.5,"I")
QUIT
+8 ;this Div notd
IF $DATA(VAUTD)
IF (VAUTD'=1&('$DATA(VAUTD($$GET1^DIQ(44,CLN,3.5,"I")))))
QUIT
+9 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLN))
QUIT
+10 ;S NAME=$$GET1^DIQ(44,CLN,.01) ;set clinic's name
+11 ;D SET(NAME,.VALMCNT) ;setup the line with clinic name
+12 ;
+13 ; -- then by appt date (within range)
+14 SET APPT=BSDBD
SET END=BSDED+.2400
+15 FOR
SET APPT=$ORDER(^SC(CLN,"S",APPT))
IF 'APPT!(APPT>END)
QUIT
Begin DoDot:2
+16 ;
+17 ; -- then find appts to count
+18 SET APPN=0
SET BSDCNT=0
+19 NEW APPDT
+20 SET APPDT=0
+21 FOR
SET APPN=$ORDER(^SC(CLN,"S",APPT,1,APPN))
IF 'APPN
QUIT
Begin DoDot:3
+22 ;patient ien
SET PAT=+^SC(CLN,"S",APPT,1,APPN,0)
+23 ;current status
SET STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100)
+24 IF STATUS["CANCEL"
QUIT
IF STATUS="FUTURE"
QUIT
+25 IF STATUS="NON-COUNT"
QUIT
IF STATUS="DELETED"
QUIT
+26 ;checkin node
SET CHK=$GET(^SC(CLN,"S",APPT,1,APPN,"C"))
+27 SET BSDCHKI=$$LPAD($PIECE(CHK,U),12)
+28 IF '$GET(BSDCHKI)
QUIT
+29 SET BSDCHKO=$$LPAD($PIECE(CHK,U,3),12)
+30 NEW APPNA,APPTA
+31 SET APPNA=$$LPAD($PIECE(APPT,".",2),4)
+32 SET APPTA=$PIECE(APPT,".")
+33 SET ^TMP("BSD",$JOB,CLN,APPTA,"IN")=$GET(^TMP("BSD",$JOB,CLN,APPTA,"IN"))+1
+34 SET ^TMP("BSD","D",$JOB,CLN,APPT,PAT)=BSDCHKI_U_BSDCHKO_U_$$GETTAT(BSDCHKI,BSDCHKO)
+35 IF BSDCHKO
Begin DoDot:4
+36 SET ^TMP("BSD",$JOB,CLN,APPTA,"OUT")=$GET(^TMP("BSD",$JOB,CLN,APPTA,"OUT"))+1
+37 SET ^TMP("BSD",$JOB,CLN,APPTA,"TAT")=$GET(^TMP("BSD",$JOB,CLN,APPTA,"TAT"))+$$GETTAT(BSDCHKI,BSDCHKO)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+38 NEW BSDDA
+39 SET BSDDA=0
FOR
SET BSDDA=$ORDER(^TMP("BSD",$JOB,BSDDA))
IF 'BSDDA
QUIT
Begin DoDot:1
+40 ;set clinic's name
SET NAME=$$GET1^DIQ(44,BSDDA,.01)
+41 ;setup the line with clinic name
DO SET(NAME,.VALMCNT)
+42 NEW BSDIEN
SET BSDIEN=0
FOR
SET BSDIEN=$ORDER(^TMP("BSD",$JOB,BSDDA,BSDIEN))
IF 'BSDIEN
QUIT
Begin DoDot:2
+43 NEW BSDCNTI,BSDCNTO,BSDTAT
+44 SET BSDCNTI=$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,"IN"))
+45 SET BSDCNTO=$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,"OUT"))
+46 SET BSDTAT=$SELECT($GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,"OUT")):$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,"TAT"))/$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,"OUT")),1:"")
+47 SET LINE=$$PAD($$FMTE^XLFDT(BSDIEN),20)
+48 SET LINE=LINE_$$PAD(BSDCNTI,20)
+49 SET LINE=LINE_$$PAD(BSDCNTO,18)
+50 SET LINE=LINE_$$PAD($$FMTT(BSDTAT),15)
+51 DO SET(LINE,.VALMCNT)
+52 IF BSDSRT="D"
Begin DoDot:3
+53 SET LINE=$$HDRD
+54 DO SET(LINE,.VALMCNT)
+55 SET LINE=$$REPEAT^XLFSTR("-",100)
+56 DO SET(LINE,.VALMCNT)
+57 DO DET(BSDDA,BSDIEN)
+58 DO SET("",.VALMCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+59 IF BSDSRT="S"
KILL ^TMP("BSD",$JOB)
QUIT
+60 QUIT
+61 ;cmi/maw lines below no longer used
+62 DO SET("",.VALMCNT)
+63 SET LINE=$$HDRD
+64 DO SET(LINE,.VALMCNT)
+65 SET LINE=$$REPEAT^XLFSTR("-",100)
+66 DO SET(LINE,.VALMCNT)
+67 NEW BSDDDA
+68 SET BSDDDA=0
FOR
SET BSDDDA=$ORDER(^TMP("BSD","D",$JOB,BSDDDA))
IF 'BSDDDA
QUIT
Begin DoDot:1
+69 NEW BSDDIEN
SET BSDDIEN=0
FOR
SET BSDDIEN=$ORDER(^TMP("BSD","D",$JOB,BSDDDA,BSDDIEN))
IF 'BSDDIEN
QUIT
Begin DoDot:2
+70 NEW BSDDOEN
SET BSDDOEN=0
FOR
SET BSDDOEN">EN=$ORDER(^TMP("BSD","D",$JOB,BSDDDA,BSDDIEN">EN,BSDDOEN">EN))
IF BSDDOEN=""
QUIT
Begin DoDot:3
+71 NEW BSDDATA,BSDCI,BSDCO,BSDT
+72 SET BSDDATA=$GET(^TMP("BSD","D",$JOB,BSDDDA,BSDDIEN,BSDDOEN))
+73 SET BSDCI=$PIECE(BSDDATA,U)
+74 SET BSDCO=$PIECE(BSDDATA,U,2)
+75 SET BSDT=$PIECE(BSDDATA,U,3)
+76 SET LINE=$$PAD($EXTRACT($PIECE($GET(^DPT(BSDDOEN,0)),U),1,18),20)
+77 SET LINE=LINE_$$PAD($$HRN^AUPNPAT(BSDDOEN,DUZ(2)),8)
+78 SET LINE=LINE_$$PAD($$FMTE^XLFDT(BSDDIEN),20)
+79 SET LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCI),20)
+80 SET LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCO),20)
+81 ;cmi/maw 11/19/2009
SET LINE=LINE_$$PAD($$FMTT(BSDT),11)
+82 DO SET(LINE,.VALMCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+83 KILL ^TMP("BSD",$JOB)
+84 QUIT
+85 ;
DET(BSDDDA,BSDDDIEN) ;-- print out the details
+1 NEW BSDEND
+2 SET BSDEND=BSDDDIEN+.9999
+3 FOR
SET BSDDDIEN=$ORDER(^TMP("BSD","D",$JOB,BSDDDA,BSDDDIEN))
IF BSDDDIEN>BSDEND!('$GET(BSDDDIEN))
QUIT
Begin DoDot:1
+4 NEW BSDDOEN
SET BSDDOEN=0
FOR
SET BSDDOEN">EN=$ORDER(^TMP("BSD","D",$JOB,BSDDDA,BSDDDIEN">EN,BSDDOEN">EN))
IF BSDDOEN=""
QUIT
Begin DoDot:2
+5 NEW BSDDATA,BSDCI,BSDCO,BSDT
+6 SET BSDDATA=$GET(^TMP("BSD","D",$JOB,BSDDDA,BSDDDIEN,BSDDOEN))
+7 SET BSDCI=$PIECE(BSDDATA,U)
+8 SET BSDCO=$PIECE(BSDDATA,U,2)
+9 SET BSDT=$PIECE(BSDDATA,U,3)
+10 SET LINE=$$PAD($EXTRACT($PIECE($GET(^DPT(BSDDOEN,0)),U),1,18),20)
+11 SET LINE=LINE_$$PAD($$HRN^AUPNPAT(BSDDOEN,DUZ(2)),8)
+12 SET LINE=LINE_$$PAD($$FMTE^XLFDT(BSDDDIEN),20)
+13 SET LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCI),20)
+14 SET LINE=LINE_$$PAD($$FMTE^XLFDT(BSDCO),20)
+15 ;cmi/maw 11/19/2009
SET LINE=LINE_$$PAD($$FMTT(BSDT),11)
+16 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
FMTT(T) ;-- reformat TAT
+1 NEW LT,LTI,M
+2 SET LT=$LENGTH(T)
+3 ;S M=" min" cmi/maw 11/19/2009 PATCH 1011
+4 ;cmi/maw 11/19/2009 PATCH 1011
SET M=" H:min"
+5 ;cmi/maw 11/19/2009 PATCH 1011
SET T=(T)\60_":"_$SELECT($LENGTH((T)#60)<2:"0"_((T)#60),1:((T)#60))
+6 ;cmi/maw 6/9/2010 PATCH 1012
SET T=$EXTRACT(T,1,4)
+7 IF $LENGTH(T)=0
QUIT ""
+8 IF $LENGTH(T)=1
QUIT T_" "_M
+9 IF $LENGTH(T)=2
QUIT T_" "_M
+10 IF $LENGTH(T)=3
QUIT T_" "_M
+11 IF $LENGTH(T)=4
QUIT T_" "_M
+12 QUIT T_M
+13 ;
LPAD(A,L) ;-- pad the length to 4 digits
+1 IF A=""
QUIT ""
+2 IF $LENGTH(A)=12
QUIT A
+3 IF $LENGTH(A)=11
QUIT A_"0"
+4 IF $LENGTH(A)=10
QUIT A_"00"
+5 IF $LENGTH(A)=4
QUIT A
+6 IF $LENGTH(A)=3
QUIT A_"0"
+7 IF $LENGTH(A)=2
QUIT A_"00"
+8 QUIT A_"000"
+9 ;
GETTAT(I,O) ;-- calculate turnaround time
+1 IF '$GET(O)
QUIT ""
+2 NEW IT,OT,ITH,ITM,OTH,OTM,ET,BT,TS,H,M,S
+3 SET IT=$PIECE(I,".",2)
+4 SET OT=$PIECE(O,".",2)
+5 SET X=I
+6 DO H^%DTC
+7 SET ITH=%H
+8 SET ITM=%T
+9 SET X=O
+10 DO H^%DTC
+11 SET OTH=%H
+12 SET OTM=%T
+13 SET ET=OTH_","_OTM
+14 SET BT=ITH_","_ITM
+15 ;I $D(ET) S TS=(86400*($P(ET,",")-$P(BT,",")))+($P(ET,",",2)-$P(BT,",",2)),H=$P(TS/3600,".") S:H="" H=0 D
+16 ;.S TS=TS-(H*3600),M=$P(TS/60,".") S:M="" M=0 S TS=TS-(M*60),S=TS
+17 IF $DATA(ET)
SET TS=(86400*($PIECE(ET,",")-$PIECE(BT,",")))+($PIECE(ET,",",2)-$PIECE(BT,",",2))
SET H=$PIECE(TS/3600,".")
IF H=""
SET H=0
Begin DoDot:1
+18 ;S TS=TS-(H*3600),M=$P(TS/60,".") S:M="" M=0 S TS=TS-(M*60),S=TS
+19 ;cmi/maw 7/22/2010 patch 1012
SET M=$PIECE((TS/60),".")
IF M=""
SET M=0
End DoDot:1
+20 ;cmi/maw 11/19/2009 PATCH 1011
QUIT $GET(M)
+21 ;Q +$G(H)_"."_+$G(M)_"."_+$G(S)
+22 ;Q OT-IT ;cmi/maw TODO fix this calculation
+23 ;
SET(LINE,NUM) ; -- sets display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDWKR6",$JOB,NUM,0)=LINE
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
HELP1 ;EP; help for subtotal question
+1 DO MSG^BDGF("This report will display Turnaround Time for;",1,0)
+2 DO MSG^BDGF("clinic(s). Turnaround time is the difference",1,0)
+3 DO MSG^BDGF("between Checkin Time and Checkout Time. If there;",1,0)
+4 DO MSG^BDGF("is not a checkout time, turnaround time is blank;",1,0)
+5 DO MSG^BDGF(" Choose D to display a Detailed Report.",1,0)
+6 DO MSG^BDGF(" Choose S to display a Summary Report.",1,0)
+7 QUIT
+8 ;
EXIT ; -- exit code
+1 KILL ^TMP("BSDWKR6",$JOB),BSDQ,PAGE
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PRINT ; print report to paper
+1 SET PAGE=1
+2 USE IO
DO HDG
+3 NEW BSDX
SET BSDX=0
FOR
SET BSDX=$ORDER(^TMP("BSDWKR6",$JOB,BSDX))
IF 'BSDX
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-4)
Begin DoDot:2
+5 SET PAGE=PAGE+1
+6 ;S Y=$$READ^BDGF("E","Press Return to Continue")
+7 ;ihs/cmi/maw 01/29/2016 PATCH 1019
IF $EXTRACT(IOST,1,1)="C"
SET Y=$$READ^BDGF("E","Press Return to Continue")
+8 DO HDG
End DoDot:2
+9 WRITE !,^TMP("BSDWKR6",$JOB,BSDX,0)
End DoDot:1
+10 DO ^%ZISC
DO EXIT
+11 QUIT
+12 ;
HDG ; heading for paper report
+1 ;,?31,"Turnaround Time"
DO HDR
WRITE @IOF
+2 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
IF I=1
WRITE ?70,$SELECT($GET(PAGE):"Page: "_$GET(PAGE),1:"")
+3 WRITE !,$$REPEAT^XLFSTR("-",80)
+4 WRITE !,"Appt Date",?20,"Checked In",?40,"Checked Out",?58,"Avg TAT"
+5 WRITE !,$$REPEAT^XLFSTR("=",80)
+6 QUIT
+7 ;
HDGD ;-- do the header for the detailed report
+1 WRITE !,$$REPEAT^XLFSTR("-",100)
+2 WRITE !,"Patient Name",?20,"Chart",?28,"Appointment",?42,"Checkin",?59,"Checkout",?78,"TAT"
+3 WRITE !,$$REPEAT^XLFSTR("=",100)
+4 QUIT
+5 ;
HDRD() ;-- do the header
+1 NEW LN
+2 SET LN=$$PAD("Patient Name",20)
+3 SET LN=LN_$$PAD("Chart",8)
+4 SET LN=LN_$$PAD("Appointment",20)
+5 SET LN=LN_$$PAD("Check In",20)
+6 SET LN=LN_$$PAD("Check Out",20)
+7 SET LN=LN_$$PAD("TAT",10)
+8 QUIT LN
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
+2 ;
