BSDWKR1 ; IHS/ANMC/LJF - WORKLOAD STATS; [ 01/04/2005 4:42 PM ]
;;5.3;PIMS;**1001**;APR 26, 2002
;
ASK ; -- ask user questions
NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDTT,BSDDET,BSDSUB,BSDSRT,BSDSEEN,Y
;
S BSDSUB=$$READ^BDGF("SO^C:Clinic;P:Principal Clinic;V:Provider;T:Team","Subtotal Report by","","^D HELP1^BSDWKR1")
Q:BSDSUB="" Q:BSDSUB=U
;
; get clinic arrays based on subtotal category
I (BSDSUB="C")!(BSDSUB="P") D CLINIC^BSDU(2) Q:$D(BSDQ)
I (BSDSUB="V")!(BSDSUB="T") D PCASK^BSDU(2,BSDSUB) Q:$D(BSDQ)
;
S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") Q:'BSDBD
S BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search") Q:'BSDED
;
S BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BSDWKR1") Q:BSDDET=U
;
S BSDSRT=$$READ^BDGF("SO^1:Morning vs. Afternoon;2:Pediatric vs. Adult Patients;3:Male vs. Female Patients","Select addition sort (optional)")
Q:BSDSRT=U S BSDSRT=+BSDSRT ;optional=0
;
S BSDSEEN=$$READ^BDGF("YO","Assume Patient Seen if Appt NOT Checked In","NO","^D HELP2^BSDWKR1") Q:BSDSEEN="" Q:BSDSEEN=U
;
S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
D ZIS^BDGF("PQ","START^BSDWKR1","WORKLOAD STATS","BSDDET;BSDSUB;BSDSRT;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
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 WORK STATS")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(25)_"Completed Appointments by Type"
S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDWKR1",$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
S CLN=0 F S CLN=$O(@BSDAR@(CLN)) Q:'CLN D
. ;IHS/ITSC/WAR 3/25/04 2 lines added to handle ALL/2 or more DIVs
. Q:'$$GET1^DIQ(44,CLN,3.5,"I") ;No Div entered for this clinic
. ;IHS/ITSC/WAR 12/29/04 PATCH 1001 fixed 'undefined' when selecting Prov or Team
. ;Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I"))))) ;this Div notd
. 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
. S SUB=$$SUB1(CLN,NAME) ;get subcategory for clinic
. ;
. ; -- 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
.. 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"
... I BSDSEEN=0 Q:STATUS="NO ACTION TAKEN"
... ;
... S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS) ;type of appt
... S SUB2=$$SUB2(APPT,PAT) ;2nd sort
... ;
... ; increment totals
... D INCR(SUB,TYPE,NAME,SUB2,APPT)
;
;
; put totals into display array
NEW S1,S2,S3,S4,X,LINE,I,J,BSDI,BSDJ
S S1=0 F S S1=$O(^TMP("BSD",$J,S1)) Q:S1="" D
. ;
. S LINE=$$PAD(S1,25) ;subtotal category name
. ; line up 5 type of appt columns
. F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I)),6)
. S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1)),6) ;add in total
. D SET(LINE,.VALMCNT)
. ;
. I BSDSRT D ;total of 2nd sort for subtotal category
.. S BSDI=$$SUB21(BSDSRT),BSDJ=$$SUB22(BSDSRT)
.. F J=BSDI,BSDJ D
... S LINE=$$PAD(" TOTAL "_J,25)
... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,0,J)),6)
... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,0,J)),6)
... D SET(LINE,.VALMCNT)
. D SET("",.VALMCNT)
. ;
. ; totals by clinic
. S S2=0 F S S2=$O(^TMP("BSD",$J,S1,0,S2)) Q:S2="" D
.. I S2'=S1 D ;if sort by clinic, don't repeat data
... S LINE=$$PAD($$SP(3)_S2,25) ;clinic name
... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,S2)),6)
... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,S2)),6)
... D SET(LINE,.VALMCNT)
... ;
... ; subtotal clinics by 2nd subcategory
... I BSDSRT D
.... S BSDI=$$SUB21(BSDSRT),BSDJ=$$SUB22(BSDSRT)
.... F J=BSDI,BSDJ D
..... S LINE=$$PAD($$SP(4)_"TOTAL "_J,25)
..... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,S2,J)),6)
..... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,S2,J)),6)
..... D SET(LINE,.VALMCNT)
.. ;
.. ; subtotal clinics by date
.. S S3="" F S S3=$O(^TMP("BSD",$J,S1,0,S2,S3)) Q:S3="" D
... S S4=0 F S S4=$O(^TMP("BSD",$J,S1,0,S2,S3,S4)) Q:S4="" D
.... S X=$S(S3=0:"",1:" - "_S3) ;2nd category if used
.... S LINE=$$PAD($$SP(4)_$$FMTE^XLFDT(S4)_X,25)
.... F I=1:1:6 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,S2,S3,S4)),6)
.... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,S2,S3,S4)),6)
.... D SET(LINE,.VALMCNT)
.. D SET("",.VALMCNT)
;
S LINE=$$PAD("REPORT TOTALS",25)
F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,0,I)),6)
S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,0)),6)
D SET("",.VALMCNT),SET(LINE,.VALMCNT)
;
K ^TMP("BSD",$J)
Q
;
SUB1(C,N) ; -- return name of subcategory for clinic C
I BSDSUB="P" Q $$PRIN^BSDU(CLN)
I BSDSUB="V" Q $P($$PRV^BSDU(CLN),U,2)
I BSDSUB="T" Q $P($$TEAM^BSDU(CLN),U,2)
Q N
;
SUB2(D,P) ; -- returns value of 2nd sort if asked for
I BSDSRT=0 Q 0
I BSDSRT=1 NEW X S X=$E($P(D,".",2),1,2) Q $S(X<12:"AM",1:"PM")
I BSDSRT=2 NEW X,Y S X=$$GET1^DIQ(2,P,.03,"I"),Y=$$FMDIFF^XLFDT(D,X)/365.25 Q $S(Y<15:"PEDS",1:"ADULT")
I BSDSRT=3 Q $$GET1^DIQ(2,P,.02)
Q "??" ;error in case one slips thru
;
SUB21(X) ; returns external category
Q $S(X=1:"AM",X=2:"PEDS",1:"MALE")
;
SUB22(X) ; returns 2nd value of 2nd subcategory
Q $S(X=1:"PM",X=2:"ADULT",1:"FEMALE")
;
TYPE(C,D,N,P,S) ; -- return type of appt.
; returns column #
; 1=sched, 2=same day, 3=walk-in, 4=overbook, 5=inpt, 6=no-show
I S["NO-SHOW" Q 6 ;no-show
I S["INPAT" Q 5 ;inpatient
NEW X S X=$P($G(^DPT(P,"S",D,0)),U,7) I X=4 Q 3 ;walkin
I X=9,(D\1)=($P($G(^SC(C,"S",D,1,N,0)),U,7)\1) Q 3 ;same day CR
I X=9,(D\1)'=($P($G(^SC(C,"S",D,1,N,0)),U,7)\1) Q 1 ;future CR
I X=3,(D\1)=($P($G(^SC(C,"S",D,1,N,0)),U,7)\1) Q 2 ;same day appt
I $G(^SC(C,"S",D,1,N,"OB"))="O" Q 4 ;sched overbook
I X=3 Q 1 ;scheduled
Q "??" ;error in case one slips thru
;
INCR(SUB,TYPE,NAME,SUB2,APPT) ; increment totals
NEW DATE S DATE=APPT\1
I TYPE'=6 S ^TMP("BSD",$J,0)=$G(^TMP("BSD",$J,0))+1
I TYPE'=6 S ^TMP("BSD",$J,SUB)=$G(^TMP("BSD",$J,SUB))+1
S ^TMP("BSD",$J,0,TYPE)=$G(^TMP("BSD",$J,0,TYPE))+1
S ^TMP("BSD",$J,SUB,TYPE)=$G(^TMP("BSD",$J,SUB,TYPE))+1
I TYPE'=6 S ^TMP("BSD",$J,SUB,0,NAME)=$G(^TMP("BSD",$J,SUB,0,NAME))+1
S ^TMP("BSD",$J,SUB,TYPE,NAME)=$G(^TMP("BSD",$J,SUB,TYPE,NAME))+1
S ^TMP("BSD",$J,SUB,0,0,SUB2)=$G(^TMP("BSD",$J,SUB,0,0,SUB2))+1
S ^TMP("BSD",$J,SUB,TYPE,0,SUB2)=$G(^TMP("BSD",$J,SUB,TYPE,0,SUB2))+1
S ^TMP("BSD",$J,SUB,0,NAME,SUB2)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2))+1
S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2))+1
I BSDDET S ^TMP("BSD",$J,SUB,0,NAME,SUB2,DATE)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2,DATE))+1
I BSDDET S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,DATE)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,DATE))+1
Q
;
SET(LINE,NUM) ; -- sets display line into array
S NUM=NUM+1
S ^TMP("BSDWKR1",$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 subtotal results any of 4 ways:",2,0)
D MSG^BDGF(" Choose C to subtotal by individual clinic;",1,0)
D MSG^BDGF(" Choose P to subtotal by principal clinic;",1,0)
D MSG^BDGF(" Choose V to subtotal by a clinic's provider;",1,0)
D MSG^BDGF(" Choose T to subtotal by a clinic's team.",1,0)
D MSG^BDGF("Clinics not affiliated with a principal clinic,",2,0)
D MSG^BDGF("provider or team, will be subtotaled under the",1,0)
D MSG^BDGF("""Unaffiliated"" designation.",1,1)
Q
;
HELP2 ;EP; help for assume patient seen question
D MSG^BDGF("Answer YES if you want the report to assume patients",2,0)
D MSG^BDGF("were seen even when their appointments were NOT",1,0)
D MSG^BDGF("checked-in or flagged as no-shows.",1,0)
D MSG^BDGF("Answer NO if only appointments with a check-in date/time",2,0)
D MSG^BDGF("are to be counted. No-shows are counted separately.",1,0)
D MSG^BDGF("The Appt. Management Report can list all appointments",1,0)
D MSG^BDGF("without an action status so the data can be cleaned up.",1,1)
Q
;
HELP3 ;EP; help for print individual dates question
D MSG^BDGF("Answer YES to have the report totals for each date",2,0)
D MSG^BDGF("within the date range you have selected.",1,0)
D MSG^BDGF("Answer NO to just have one set of totals for each",1,0)
D MSG^BDGF("clinic for the entire date range.",1,1)
Q
;
EXIT ; -- exit code
K ^TMP("BSDWKR1",$J)
Q
;
EXPND ; -- expand code
Q
;
PRINT ; print report to paper
U IO D HDG
NEW X S X=0 F S X=$O(^TMP("BSDWKR1",$J,X)) Q:'X D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BSDWKR1",$J,X,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF,?30,"Workload Statistics"
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("-",80)
W !,"Category Names",?28,"SCHED",?34,"SAMEDAY",?43,"WALKIN"
W ?51,"OVERBK",?61,"INPT",?70,"TOTAL SEEN"
W !,$$REPEAT^XLFSTR("=",80)
Q
;
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)
BSDWKR1 ; IHS/ANMC/LJF - WORKLOAD STATS; [ 01/04/2005 4:42 PM ]
+1 ;;5.3;PIMS;**1001**;APR 26, 2002
+2 ;
ASK ; -- ask user questions
+1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDTT,BSDDET,BSDSUB,BSDSRT,BSDSEEN,Y
+2 ;
+3 SET BSDSUB=$$READ^BDGF("SO^C:Clinic;P:Principal Clinic;V:Provider;T:Team","Subtotal Report by","","^D HELP1^BSDWKR1")
+4 IF BSDSUB=""
QUIT
IF BSDSUB=U
QUIT
+5 ;
+6 ; get clinic arrays based on subtotal category
+7 IF (BSDSUB="C")!(BSDSUB="P")
DO CLINIC^BSDU(2)
IF $DATA(BSDQ)
QUIT
+8 IF (BSDSUB="V")!(BSDSUB="T")
DO PCASK^BSDU(2,BSDSUB)
IF $DATA(BSDQ)
QUIT
+9 ;
+10 SET BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search")
IF 'BSDBD
QUIT
+11 SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")
IF 'BSDED
QUIT
+12 ;
+13 SET BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BSDWKR1")
IF BSDDET=U
QUIT
+14 ;
+15 SET BSDSRT=$$READ^BDGF("SO^1:Morning vs. Afternoon;2:Pediatric vs. Adult Patients;3:Male vs. Female Patients","Select addition sort (optional)")
+16 ;optional=0
IF BSDSRT=U
QUIT
SET BSDSRT=+BSDSRT
+17 ;
+18 SET BSDSEEN=$$READ^BDGF("YO","Assume Patient Seen if Appt NOT Checked In","NO","^D HELP2^BSDWKR1")
IF BSDSEEN=""
QUIT
IF BSDSEEN=U
QUIT
+19 ;
+20 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+21 DO ZIS^BDGF("PQ","START^BSDWKR1","WORKLOAD STATS","BSDDET;BSDSUB;BSDSRT;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
+22 QUIT
+23 ;
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 WORK STATS")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(25)_"Completed Appointments by Type"
+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("BSDWKR1",$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
+6 SET CLN=0
FOR
SET CLN=$ORDER(@BSDAR@(CLN))
IF 'CLN
QUIT
Begin DoDot:1
+7 ;IHS/ITSC/WAR 3/25/04 2 lines added to handle ALL/2 or more DIVs
+8 ;No Div entered for this clinic
IF '$$GET1^DIQ(44,CLN,3.5,"I")
QUIT
+9 ;IHS/ITSC/WAR 12/29/04 PATCH 1001 fixed 'undefined' when selecting Prov or Team
+10 ;Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I"))))) ;this Div notd
+11 ;this Div notd
IF $DATA(VAUTD)
IF (VAUTD'=1&('$DATA(VAUTD($$GET1^DIQ(44,CLN,3.5,"I")))))
QUIT
+12 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLN))
QUIT
+13 ;set clinic's name
SET NAME=$$GET1^DIQ(44,CLN,.01)
+14 ;get subcategory for clinic
SET SUB=$$SUB1(CLN,NAME)
+15 ;
+16 ; -- then by appt date (within range)
+17 SET APPT=BSDBD
SET END=BSDED+.2400
+18 FOR
SET APPT=$ORDER(^SC(CLN,"S",APPT))
IF 'APPT!(APPT>END)
QUIT
Begin DoDot:2
+19 ;
+20 ; -- then find appts to count
+21 SET APPN=0
+22 FOR
SET APPN=$ORDER(^SC(CLN,"S",APPT,1,APPN))
IF 'APPN
QUIT
Begin DoDot:3
+23 ;patient ien
SET PAT=+^SC(CLN,"S",APPT,1,APPN,0)
+24 ;current status
SET STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100)
+25 IF STATUS["CANCEL"
QUIT
IF STATUS="FUTURE"
QUIT
+26 IF STATUS="NON-COUNT"
QUIT
IF STATUS="DELETED"
QUIT
+27 IF BSDSEEN=0
IF STATUS="NO ACTION TAKEN"
QUIT
+28 ;
+29 ;type of appt
SET TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)
+30 ;2nd sort
SET SUB2=$$SUB2(APPT,PAT)
+31 ;
+32 ; increment totals
+33 DO INCR(SUB,TYPE,NAME,SUB2,APPT)
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 ;
+36 ; put totals into display array
+37 NEW S1,S2,S3,S4,X,LINE,I,J,BSDI,BSDJ
+38 SET S1=0
FOR
SET S1=$ORDER(^TMP("BSD",$JOB,S1))
IF S1=""
QUIT
Begin DoDot:1
+39 ;
+40 ;subtotal category name
SET LINE=$$PAD(S1,25)
+41 ; line up 5 type of appt columns
+42 FOR I=1:1:5
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I)),6)
+43 ;add in total
SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1)),6)
+44 DO SET(LINE,.VALMCNT)
+45 ;
+46 ;total of 2nd sort for subtotal category
IF BSDSRT
Begin DoDot:2
+47 SET BSDI=$$SUB21(BSDSRT)
SET BSDJ=$$SUB22(BSDSRT)
+48 FOR J=BSDI,BSDJ
Begin DoDot:3
+49 SET LINE=$$PAD(" TOTAL "_J,25)
+50 FOR I=1:1:5
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,0,J)),6)
+51 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,0,J)),6)
+52 DO SET(LINE,.VALMCNT)
End DoDot:3
End DoDot:2
+53 DO SET("",.VALMCNT)
+54 ;
+55 ; totals by clinic
+56 SET S2=0
FOR
SET S2=$ORDER(^TMP("BSD",$JOB,S1,0,S2))
IF S2=""
QUIT
Begin DoDot:2
+57 ;if sort by clinic, don't repeat data
IF S2'=S1
Begin DoDot:3
+58 ;clinic name
SET LINE=$$PAD($$SP(3)_S2,25)
+59 FOR I=1:1:5
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,S2)),6)
+60 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,S2)),6)
+61 DO SET(LINE,.VALMCNT)
+62 ;
+63 ; subtotal clinics by 2nd subcategory
+64 IF BSDSRT
Begin DoDot:4
+65 SET BSDI=$$SUB21(BSDSRT)
SET BSDJ=$$SUB22(BSDSRT)
+66 FOR J=BSDI,BSDJ
Begin DoDot:5
+67 SET LINE=$$PAD($$SP(4)_"TOTAL "_J,25)
+68 FOR I=1:1:5
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,S2,J)),6)
+69 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,S2,J)),6)
+70 DO SET(LINE,.VALMCNT)
End DoDot:5
End DoDot:4
End DoDot:3
+71 ;
+72 ; subtotal clinics by date
+73 SET S3=""
FOR
SET S3=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3))
IF S3=""
QUIT
Begin DoDot:3
+74 SET S4=0
FOR
SET S4=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3,S4))
IF S4=""
QUIT
Begin DoDot:4
+75 ;2nd category if used
SET X=$SELECT(S3=0:"",1:" - "_S3)
+76 SET LINE=$$PAD($$SP(4)_$$FMTE^XLFDT(S4)_X,25)
+77 FOR I=1:1:6
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,S2,S3,S4)),6)
+78 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,S2,S3,S4)),6)
+79 DO SET(LINE,.VALMCNT)
End DoDot:4
End DoDot:3
+80 DO SET("",.VALMCNT)
End DoDot:2
End DoDot:1
+81 ;
+82 SET LINE=$$PAD("REPORT TOTALS",25)
+83 FOR I=1:1:5
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,0,I)),6)
+84 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,0)),6)
+85 DO SET("",.VALMCNT)
DO SET(LINE,.VALMCNT)
+86 ;
+87 KILL ^TMP("BSD",$JOB)
+88 QUIT
+89 ;
SUB1(C,N) ; -- return name of subcategory for clinic C
+1 IF BSDSUB="P"
QUIT $$PRIN^BSDU(CLN)
+2 IF BSDSUB="V"
QUIT $PIECE($$PRV^BSDU(CLN),U,2)
+3 IF BSDSUB="T"
QUIT $PIECE($$TEAM^BSDU(CLN),U,2)
+4 QUIT N
+5 ;
SUB2(D,P) ; -- returns value of 2nd sort if asked for
+1 IF BSDSRT=0
QUIT 0
+2 IF BSDSRT=1
NEW X
SET X=$EXTRACT($PIECE(D,".",2),1,2)
QUIT $SELECT(X<12:"AM",1:"PM")
+3 IF BSDSRT=2
NEW X,Y
SET X=$$GET1^DIQ(2,P,.03,"I")
SET Y=$$FMDIFF^XLFDT(D,X)/365.25
QUIT $SELECT(Y<15:"PEDS",1:"ADULT")
+4 IF BSDSRT=3
QUIT $$GET1^DIQ(2,P,.02)
+5 ;error in case one slips thru
QUIT "??"
+6 ;
SUB21(X) ; returns external category
+1 QUIT $SELECT(X=1:"AM",X=2:"PEDS",1:"MALE")
+2 ;
SUB22(X) ; returns 2nd value of 2nd subcategory
+1 QUIT $SELECT(X=1:"PM",X=2:"ADULT",1:"FEMALE")
+2 ;
TYPE(C,D,N,P,S) ; -- return type of appt.
+1 ; returns column #
+2 ; 1=sched, 2=same day, 3=walk-in, 4=overbook, 5=inpt, 6=no-show
+3 ;no-show
IF S["NO-SHOW"
QUIT 6
+4 ;inpatient
IF S["INPAT"
QUIT 5
+5 ;walkin
NEW X
SET X=$PIECE($GET(^DPT(P,"S",D,0)),U,7)
IF X=4
QUIT 3
+6 ;same day CR
IF X=9
IF (D\1)=($PIECE($GET(^SC(C,"S",D,1,N,0)),U,7)\1)
QUIT 3
+7 ;future CR
IF X=9
IF (D\1)'=($PIECE($GET(^SC(C,"S",D,1,N,0)),U,7)\1)
QUIT 1
+8 ;same day appt
IF X=3
IF (D\1)=($PIECE($GET(^SC(C,"S",D,1,N,0)),U,7)\1)
QUIT 2
+9 ;sched overbook
IF $GET(^SC(C,"S",D,1,N,"OB"))="O"
QUIT 4
+10 ;scheduled
IF X=3
QUIT 1
+11 ;error in case one slips thru
QUIT "??"
+12 ;
INCR(SUB,TYPE,NAME,SUB2,APPT) ; increment totals
+1 NEW DATE
SET DATE=APPT\1
+2 IF TYPE'=6
SET ^TMP("BSD",$JOB,0)=$GET(^TMP("BSD",$JOB,0))+1
+3 IF TYPE'=6
SET ^TMP("BSD",$JOB,SUB)=$GET(^TMP("BSD",$JOB,SUB))+1
+4 SET ^TMP("BSD",$JOB,0,TYPE)=$GET(^TMP("BSD",$JOB,0,TYPE))+1
+5 SET ^TMP("BSD",$JOB,SUB,TYPE)=$GET(^TMP("BSD",$JOB,SUB,TYPE))+1
+6 IF TYPE'=6
SET ^TMP("BSD",$JOB,SUB,0,NAME)=$GET(^TMP("BSD",$JOB,SUB,0,NAME))+1
+7 SET ^TMP("BSD",$JOB,SUB,TYPE,NAME)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME))+1
+8 SET ^TMP("BSD",$JOB,SUB,0,0,SUB2)=$GET(^TMP("BSD",$JOB,SUB,0,0,SUB2))+1
+9 SET ^TMP("BSD",$JOB,SUB,TYPE,0,SUB2)=$GET(^TMP("BSD",$JOB,SUB,TYPE,0,SUB2))+1
+10 SET ^TMP("BSD",$JOB,SUB,0,NAME,SUB2)=$GET(^TMP("BSD",$JOB,SUB,0,NAME,SUB2))+1
+11 SET ^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2))+1
+12 IF BSDDET
SET ^TMP("BSD",$JOB,SUB,0,NAME,SUB2,DATE)=$GET(^TMP("BSD",$JOB,SUB,0,NAME,SUB2,DATE))+1
+13 IF BSDDET
SET ^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,DATE)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,DATE))+1
+14 QUIT
+15 ;
SET(LINE,NUM) ; -- sets display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDWKR1",$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 subtotal results any of 4 ways:",2,0)
+2 DO MSG^BDGF(" Choose C to subtotal by individual clinic;",1,0)
+3 DO MSG^BDGF(" Choose P to subtotal by principal clinic;",1,0)
+4 DO MSG^BDGF(" Choose V to subtotal by a clinic's provider;",1,0)
+5 DO MSG^BDGF(" Choose T to subtotal by a clinic's team.",1,0)
+6 DO MSG^BDGF("Clinics not affiliated with a principal clinic,",2,0)
+7 DO MSG^BDGF("provider or team, will be subtotaled under the",1,0)
+8 DO MSG^BDGF("""Unaffiliated"" designation.",1,1)
+9 QUIT
+10 ;
HELP2 ;EP; help for assume patient seen question
+1 DO MSG^BDGF("Answer YES if you want the report to assume patients",2,0)
+2 DO MSG^BDGF("were seen even when their appointments were NOT",1,0)
+3 DO MSG^BDGF("checked-in or flagged as no-shows.",1,0)
+4 DO MSG^BDGF("Answer NO if only appointments with a check-in date/time",2,0)
+5 DO MSG^BDGF("are to be counted. No-shows are counted separately.",1,0)
+6 DO MSG^BDGF("The Appt. Management Report can list all appointments",1,0)
+7 DO MSG^BDGF("without an action status so the data can be cleaned up.",1,1)
+8 QUIT
+9 ;
HELP3 ;EP; help for print individual dates question
+1 DO MSG^BDGF("Answer YES to have the report totals for each date",2,0)
+2 DO MSG^BDGF("within the date range you have selected.",1,0)
+3 DO MSG^BDGF("Answer NO to just have one set of totals for each",1,0)
+4 DO MSG^BDGF("clinic for the entire date range.",1,1)
+5 QUIT
+6 ;
EXIT ; -- exit code
+1 KILL ^TMP("BSDWKR1",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PRINT ; print report to paper
+1 USE IO
DO HDG
+2 NEW X
SET X=0
FOR
SET X=$ORDER(^TMP("BSDWKR1",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
DO HDG
+4 WRITE !,^TMP("BSDWKR1",$JOB,X,0)
End DoDot:1
+5 DO ^%ZISC
DO EXIT
+6 QUIT
+7 ;
HDG ; heading for paper report
+1 DO HDR
WRITE @IOF,?30,"Workload Statistics"
+2 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 WRITE !,$$REPEAT^XLFSTR("-",80)
+4 WRITE !,"Category Names",?28,"SCHED",?34,"SAMEDAY",?43,"WALKIN"
+5 WRITE ?51,"OVERBK",?61,"INPT",?70,"TOTAL SEEN"
+6 WRITE !,$$REPEAT^XLFSTR("=",80)
+7 QUIT
+8 ;
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)
