Routine: BSDWKR6

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*")

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)

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

HDR ; -- header code

 S VALMHDR(1)=$$SP(31)_"Turn Around Time"

 S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)

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

 ;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)

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)

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

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

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)

EXIT ; -- exit code

 K ^TMP("BSDWKR6",$J),BSDQ,PAGE

EXPND ; -- expand code

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

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)

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)

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       ;

BSDWKR6.m