BSDWKR3 ; IHS/ANMC/LJF - WORKLOAD COMPARISONS ; [ 01/05/2005 8:10 AM ]
;;5.3;PIMS;**1001,1007**;APR 26, 2002
;
;cmi/anch/maw 2/15/2007 added sort by clinic code PATCH 1007 item 1007.26
;
ASK ; -- ask user questions
NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,Y,BSDSEEN
;
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)
;
;cmi/anch/maw 2/15/2007 PATCH 1007 item 1007.26 added to ask for clinic code sort
N BSDCC
S BSDCC=$$READ^BDGF("Y","Sort by Clinic Code","NO")
;
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 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^BSDWKR3","WORKLOAD COMPARISONS","BSDSUB;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
Q
;
START ;EP; -- re-entry for printing to paper
D INIT,PRINT Q
;
EN ; -- main entry point for BSDRM WORKLOAD COMPARISONS
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDRM WORKLOAD COMPARISONS")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(15)_"Monthly Comparisons on Completed Appointments by Type"
S VALMHDR(2)=$$SP(22)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
S VALMHDR(3)=$$SP(18)_"and corresponding dates from the previous year"
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDWKR3",$J),^TMP("BSD",$J)
NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
;
; -- loop by clinic
NEW CLN,X,Y
S CLN=0 F S CLN=$O(@BSDAR@(CLN)) Q:'CLN D
. Q:$D(^SC("AIHSPC",CLN)) ;quit if principal clinic
. S X=$O(^SC(CLN,"S",(BSDBD-.0001))) ;next appt in date range
. S Y=$O(^SC(CLN,"S",($$LAST(BSDBD)-.0001))) ;appt for last year
. I 'X,'Y Q ;quit if no appts
. Q:X>(BSDED+.24) ;quit if next appt after end
. ;
. ; run thru each date range and increment totals
. D INIT2(CLN,BSDBD,BSDED,1)
. D INIT2(CLN,$$LAST(BSDBD),$$LAST(BSDED),0)
. ;
. ; initialize ^tmp subtotals by month for those with no data
. D SETTMP(CLN,BSDBD,BSDED)
. ;
;
; put totals into display array
NEW S1,S2,S3,S4,LINE,I,LINE2,LINE3
S S1=0 F S S1=$O(^TMP("BSD",$J,S1)) Q:S1="" D
. ;
. D SET(S1,.VALMCNT) ;subtotal category name
. ;
. ; get monthly totals for category
. S S2=0 F S S2=$O(^TMP("BSD",$J,S1,0,0,S2)) Q:S2="" D
.. S S3=0 F S S3=$O(^TMP("BSD",$J,S1,0,0,S2,S3)) Q:S3="" D
... S LINE=$$PAD($$SP(3)_$$FMTE^XLFDT(S3),25) ;month/yr
... ;
... ; line up 5 type of appt columns
... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,0,S2,S3)),6)
... S LINE=$$PAD(LINE,73)_$J(^TMP("BSD",$J,S1,0,0,S2,S3),6) ;total
... D SET(LINE,.VALMCNT)
... ;
... ;net change & % change; returns LINE2, LINE3
... I S2'=S3 D NET(S1,0,S2,S3)
... I S2=S3 D SET(LINE2,.VALMCNT),SET(LINE3,.VALMCNT),SET("",.VALMCNT)
.. ;
. ;
. ; totals by clinic
. S S2=0 F S S2=$O(^TMP("BSD",$J,S1,0,S2)) Q:S2="" D
.. Q:S1=S2 ;if sort by clinic, don't repeat data
.. D SET($$SP(3)_S2,.VALMCNT) ;clinic name
.. ;
.. S S3=0 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 LINE=$$PAD($$SP(5)_$$FMTE^XLFDT(S4),25) ;month/yr
.... ;
.... ; line up 5 type of appt columns
.... F I=1:1:5 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)
.... ;
.... ; net change & % change; returns LINE2, LINE3
.... I S3'=S4 D NET(S1,S2,S3,S4)
.... I S3=S4 D SET(LINE2,.VALMCNT),SET(LINE3,.VALMCNT),SET("",.VALMCNT)
;
K ^TMP("BSD",$J)
Q
;
INIT2(CLN,BEG,END,FIRST) ; loop by date and increment totals
NEW NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,SUB2,MON
S NAME=$$GET1^DIQ(44,CLN,.01) ;set clinic's name
S SUB=$$SUB1(CLN,NAME) ;get subcategory for clinic
;
S APPT=BEG,END=END+.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["NO-SHOW" 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
.. ;
.. ; sort by comparison months in order (2991000,2981000)
.. S MON=$E(APPT,1,5)_"00" ;month for appt
.. ; appt month for date range chosen
.. S SUB2=$S(FIRST:MON,1:($E(MON,1,3)+1)_$E(MON,4,7))
.. ; increment totals
.. D INCR(SUB,TYPE,NAME,SUB2,MON)
Q
;
LAST(DATE) ; returns month and previous year
Q ($E(DATE,1,3)-1)_$E(DATE,4,7)
;
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
;
TYPE(C,D,N,P,S) ; -- return type of appt.
; returns column #: 1=sched, 2=same day, 3=walk-in, 4=overbook, 5=inpt
I S["INPAT" Q 5 ;inpatient
I $G(^SC(C,"S",D,1,N,"OB"))="O" Q 4 ;overbook
NEW X S X=$$VALI^XBDIQ1(2.98,P_","_D,9) I X=4 Q 3 ;walkin
I X=3,(D\1)=($P($G(^DPT(P,"S",D,0)),U,19)\1) Q 2 ;same day appt
I X=3 Q 1 ;scheduled
Q "??" ;error in case one slips thru
;
SETTMP(CLINIC,BEG,END) ; initialize ^tmp by month
NEW MON,X,SUB,NAME
S NAME=$$GET1^DIQ(44,CLN,.01) ;clinic name
S SUB=$$SUB1(CLN,NAME) ;subcategory name
S MON=$E(BEG,1,5)_"00" ;beginning month
;cmi/anch/maw 2/15/2007, changed sub to clinic code for sort if selected PATCH 1007, item 1007.26
I $G(BSDCC) D
. S CLNC=$$GET1^DIQ(44,CLN,8) ;clinic code
. N CLNCI,CLNCC
. S CLNCI=$$GET1^DIQ(44,CLN,8,"I")
. S CLNCC=$P($G(^DIC(40.7,CLNCI,0)),U,2)
. S SUB=CLNCC_" - "_CLNC
;
; for each month, fill in ^tmp for each type
F Q:MON>($E(END,1,5)_"00") D
. F I=0:1:5 D
.. S ^TMP("BSD",$J,SUB,I,0,MON,MON)=+$G(^TMP("BSD",$J,SUB,I,0,MON,MON))
.. S ^TMP("BSD",$J,SUB,I,0,MON,$$LAST(MON))=+$G(^TMP("BSD",$J,SUB,I,0,MON,$$LAST(MON)))
.. S ^TMP("BSD",$J,SUB,I,NAME,MON,MON)=+$G(^TMP("BSD",$J,SUB,I,NAME,MON,MON))
.. S ^TMP("BSD",$J,SUB,I,NAME,MON,$$LAST(MON))=+$G(^TMP("BSD",$J,SUB,I,NAME,MON,$$LAST(MON)))
. S X=$E(MON,4,5)+1 S:X>12 X=X-12 S:$L(X)=1 X="0"_X ;find next month
. ;IHS/ITSC/WAR 2/12/03 P50 per Linda LJF41
. ;S MON=$E(MON,1,3)_X_"00" ;IHS/ITSC/LJF 1/22/2003
. S MON=$E(MON,1,3) S:X="01" MON=MON+1 S MON=MON_X_"00" ;IHS/ITSC/LJF 1/22/2003 increment year, if needed
Q
;
INCR(SUB,TYPE,NAME,SUB2,MON) ; increment totals
S ^TMP("BSD",$J,SUB,0,0,SUB2,MON)=$G(^TMP("BSD",$J,SUB,0,0,SUB2,MON))+1
S ^TMP("BSD",$J,SUB,TYPE,0,SUB2,MON)=$G(^TMP("BSD",$J,SUB,TYPE,0,SUB2,MON))+1
S ^TMP("BSD",$J,SUB,0,NAME,SUB2,MON)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2,MON))+1
S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,MON)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,MON))+1
Q
;
NET(SUB,CLINIC,MON1,MON2) ; sets up net change & % change lines
; CLINIC=0 if called by category
NEW I,DIFF,PCNT,DIV
K LINE2,LINE3
S LINE2=$$PAD($$SP(15)_"Net Change",25)
S LINE3=$$PAD($$SP(15)_"% Change",25)
F I=1:1:5 D
. S DIFF=$G(^TMP("BSD",$J,SUB,I,CLINIC,MON1,MON1))-$G(^TMP("BSD",$J,SUB,I,CLINIC,MON1,MON2))
. S LINE2=LINE2_$$SP(2)_$J(DIFF,6)
. S DIV=+$G(^TMP("BSD",$J,SUB,I,CLINIC,MON1,MON1))
. S PCNT=$S(DIFF=0:"0",DIV=0:DIFF*100,1:(DIFF/DIV*100))
. S LINE3=LINE3_$$SP(2)_$J(PCNT_"%",6,0)
;
; set differences for total column
S DIFF=$G(^TMP("BSD",$J,SUB,0,CLINIC,MON1,MON1))-$G(^TMP("BSD",$J,SUB,0,CLINIC,MON1,MON2))
S LINE2=$$PAD(LINE2,73)_$J(DIFF,6)
S DIV=+$G(^TMP("BSD",$J,SUB,0,CLINIC,MON1,MON1))
;IHS/ITSC/WAR 9/23/04 PATCH #1001
;S PCNT=$S(DIFF=0:"0",DIV=0:0,1:DIFF\DIV*100)
S PCNT=$S(DIFF=0:"0",DIV=0:0,1:DIFF/DIV*100)
;IHS/ITSC/WAR 9/23/04 PATCH #1001
;S LINE3=$$PAD(LINE3,73)_$J(PCNT_"%",6)
S LINE3=$$PAD(LINE3,73)_$J(PCNT_"%",6,0)
Q
;
SET(LINE,NUM) ; -- sets display line into array
S NUM=NUM+1
S ^TMP("BSDWKR3",$J,NUM,0)=LINE
Q
;
PRINT ; print report to paper
U IO D HDG
NEW LINE
S LINE=0 F S LINE=$O(^TMP("BSDWKR3",$J,LINE)) Q:'LINE D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BSDWKR3",$J,LINE,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF,?30,"Workload Comparisons"
NEW I F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("-",80)
W !,"Category Name",?29,"SCHED",?35,"SAMEDAY",?44,"WALIKIN"
;IHS/ITSC/WAR 9/23/04 PATCH #1001
;W ?52,"OVERBK",?62,"INPT",70,"TOTAL SEEN"
W ?52,"OVERBK",?62,"INPT",?70,"TOTAL SEEN"
W !,$$REPEAT^XLFSTR("=",80)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
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)
BSDWKR3 ; IHS/ANMC/LJF - WORKLOAD COMPARISONS ; [ 01/05/2005 8:10 AM ]
+1 ;;5.3;PIMS;**1001,1007**;APR 26, 2002
+2 ;
+3 ;cmi/anch/maw 2/15/2007 added sort by clinic code PATCH 1007 item 1007.26
+4 ;
ASK ; -- ask user questions
+1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,Y,BSDSEEN
+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 ;cmi/anch/maw 2/15/2007 PATCH 1007 item 1007.26 added to ask for clinic code sort
+11 NEW BSDCC
+12 SET BSDCC=$$READ^BDGF("Y","Sort by Clinic Code","NO")
+13 ;
+14 SET BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search")
IF 'BSDBD
QUIT
+15 SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")
IF 'BSDED
QUIT
+16 ;
+17 SET BSDSEEN=$$READ^BDGF("YO","Assume Patient Seen if Appt NOT Checked In","NO","^D HELP2^BSDWKR1")
IF BSDSEEN=""
QUIT
IF BSDSEEN=U
QUIT
+18 ;
+19 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+20 DO ZIS^BDGF("PQ","START^BSDWKR3","WORKLOAD COMPARISONS","BSDSUB;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
+21 QUIT
+22 ;
START ;EP; -- re-entry for printing to paper
+1 DO INIT
DO PRINT
QUIT
+2 ;
EN ; -- main entry point for BSDRM WORKLOAD COMPARISONS
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BSDRM WORKLOAD COMPARISONS")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(15)_"Monthly Comparisons on Completed Appointments by Type"
+2 SET VALMHDR(2)=$$SP(22)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
+3 SET VALMHDR(3)=$$SP(18)_"and corresponding dates from the previous year"
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BSDWKR3",$JOB),^TMP("BSD",$JOB)
+2 NEW BSDAR
SET BSDAR=$SELECT(VAUTC:"^SC",1:"VAUTC")
+3 ;
+4 ; -- loop by clinic
+5 NEW CLN,X,Y
+6 SET CLN=0
FOR
SET CLN=$ORDER(@BSDAR@(CLN))
IF 'CLN
QUIT
Begin DoDot:1
+7 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLN))
QUIT
+8 ;next appt in date range
SET X=$ORDER(^SC(CLN,"S",(BSDBD-.0001)))
+9 ;appt for last year
SET Y=$ORDER(^SC(CLN,"S",($$LAST(BSDBD)-.0001)))
+10 ;quit if no appts
IF 'X
IF 'Y
QUIT
+11 ;quit if next appt after end
IF X>(BSDED+.24)
QUIT
+12 ;
+13 ; run thru each date range and increment totals
+14 DO INIT2(CLN,BSDBD,BSDED,1)
+15 DO INIT2(CLN,$$LAST(BSDBD),$$LAST(BSDED),0)
+16 ;
+17 ; initialize ^tmp subtotals by month for those with no data
+18 DO SETTMP(CLN,BSDBD,BSDED)
+19 ;
End DoDot:1
+20 ;
+21 ; put totals into display array
+22 NEW S1,S2,S3,S4,LINE,I,LINE2,LINE3
+23 SET S1=0
FOR
SET S1=$ORDER(^TMP("BSD",$JOB,S1))
IF S1=""
QUIT
Begin DoDot:1
+24 ;
+25 ;subtotal category name
DO SET(S1,.VALMCNT)
+26 ;
+27 ; get monthly totals for category
+28 SET S2=0
FOR
SET S2=$ORDER(^TMP("BSD",$JOB,S1,0,0,S2))
IF S2=""
QUIT
Begin DoDot:2
+29 SET S3=0
FOR
SET S3=$ORDER(^TMP("BSD",$JOB,S1,0,0,S2,S3))
IF S3=""
QUIT
Begin DoDot:3
+30 ;month/yr
SET LINE=$$PAD($$SP(3)_$$FMTE^XLFDT(S3),25)
+31 ;
+32 ; line up 5 type of appt columns
+33 FOR I=1:1:5
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,0,S2,S3)),6)
+34 ;total
SET LINE=$$PAD(LINE,73)_$JUSTIFY(^TMP("BSD",$JOB,S1,0,0,S2,S3),6)
+35 DO SET(LINE,.VALMCNT)
+36 ;
+37 ;net change & % change; returns LINE2, LINE3
+38 IF S2'=S3
DO NET(S1,0,S2,S3)
+39 IF S2=S3
DO SET(LINE2,.VALMCNT)
DO SET(LINE3,.VALMCNT)
DO SET("",.VALMCNT)
End DoDot:3
+40 ;
End DoDot:2
+41 ;
+42 ; totals by clinic
+43 SET S2=0
FOR
SET S2=$ORDER(^TMP("BSD",$JOB,S1,0,S2))
IF S2=""
QUIT
Begin DoDot:2
+44 ;if sort by clinic, don't repeat data
IF S1=S2
QUIT
+45 ;clinic name
DO SET($$SP(3)_S2,.VALMCNT)
+46 ;
+47 SET S3=0
FOR
SET S3=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3))
IF S3=""
QUIT
Begin DoDot:3
+48 SET S4=0
FOR
SET S4=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3,S4))
IF S4=""
QUIT
Begin DoDot:4
+49 ;month/yr
SET LINE=$$PAD($$SP(5)_$$FMTE^XLFDT(S4),25)
+50 ;
+51 ; line up 5 type of appt columns
+52 FOR I=1:1:5
SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,S2,S3,S4)),6)
+53 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,S2,S3,S4)),6)
+54 DO SET(LINE,.VALMCNT)
+55 ;
+56 ; net change & % change; returns LINE2, LINE3
+57 IF S3'=S4
DO NET(S1,S2,S3,S4)
+58 IF S3=S4
DO SET(LINE2,.VALMCNT)
DO SET(LINE3,.VALMCNT)
DO SET("",.VALMCNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+59 ;
+60 KILL ^TMP("BSD",$JOB)
+61 QUIT
+62 ;
INIT2(CLN,BEG,END,FIRST) ; loop by date and increment totals
+1 NEW NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,SUB2,MON
+2 ;set clinic's name
SET NAME=$$GET1^DIQ(44,CLN,.01)
+3 ;get subcategory for clinic
SET SUB=$$SUB1(CLN,NAME)
+4 ;
+5 SET APPT=BEG
SET END=END+.2400
+6 FOR
SET APPT=$ORDER(^SC(CLN,"S",APPT))
IF 'APPT!(APPT>END)
QUIT
Begin DoDot:1
+7 ;
+8 ; -- then find appts to count
+9 SET APPN=0
+10 FOR
SET APPN=$ORDER(^SC(CLN,"S",APPT,1,APPN))
IF 'APPN
QUIT
Begin DoDot:2
+11 ;patient ien
SET PAT=+^SC(CLN,"S",APPT,1,APPN,0)
+12 ;current status
SET STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100)
+13 IF STATUS["NO-SHOW"
QUIT
IF STATUS["CANCEL"
QUIT
IF STATUS="FUTURE"
QUIT
+14 IF STATUS="NON-COUNT"
QUIT
IF STATUS="DELETED"
QUIT
+15 IF BSDSEEN=0
IF STATUS="NO ACTION TAKEN"
QUIT
+16 ;
+17 ;type of appt
SET TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)
+18 ;
+19 ; sort by comparison months in order (2991000,2981000)
+20 ;month for appt
SET MON=$EXTRACT(APPT,1,5)_"00"
+21 ; appt month for date range chosen
+22 SET SUB2=$SELECT(FIRST:MON,1:($EXTRACT(MON,1,3)+1)_$EXTRACT(MON,4,7))
+23 ; increment totals
+24 DO INCR(SUB,TYPE,NAME,SUB2,MON)
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
LAST(DATE) ; returns month and previous year
+1 QUIT ($EXTRACT(DATE,1,3)-1)_$EXTRACT(DATE,4,7)
+2 ;
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 ;
TYPE(C,D,N,P,S) ; -- return type of appt.
+1 ; returns column #: 1=sched, 2=same day, 3=walk-in, 4=overbook, 5=inpt
+2 ;inpatient
IF S["INPAT"
QUIT 5
+3 ;overbook
IF $GET(^SC(C,"S",D,1,N,"OB"))="O"
QUIT 4
+4 ;walkin
NEW X
SET X=$$VALI^XBDIQ1(2.98,P_","_D,9)
IF X=4
QUIT 3
+5 ;same day appt
IF X=3
IF (D\1)=($PIECE($GET(^DPT(P,"S",D,0)),U,19)\1)
QUIT 2
+6 ;scheduled
IF X=3
QUIT 1
+7 ;error in case one slips thru
QUIT "??"
+8 ;
SETTMP(CLINIC,BEG,END) ; initialize ^tmp by month
+1 NEW MON,X,SUB,NAME
+2 ;clinic name
SET NAME=$$GET1^DIQ(44,CLN,.01)
+3 ;subcategory name
SET SUB=$$SUB1(CLN,NAME)
+4 ;beginning month
SET MON=$EXTRACT(BEG,1,5)_"00"
+5 ;cmi/anch/maw 2/15/2007, changed sub to clinic code for sort if selected PATCH 1007, item 1007.26
+6 IF $GET(BSDCC)
Begin DoDot:1
+7 ;clinic code
SET CLNC=$$GET1^DIQ(44,CLN,8)
+8 NEW CLNCI,CLNCC
+9 SET CLNCI=$$GET1^DIQ(44,CLN,8,"I")
+10 SET CLNCC=$PIECE($GET(^DIC(40.7,CLNCI,0)),U,2)
+11 SET SUB=CLNCC_" - "_CLNC
End DoDot:1
+12 ;
+13 ; for each month, fill in ^tmp for each type
+14 FOR
IF MON>($EXTRACT(END,1,5)_"00")
QUIT
Begin DoDot:1
+15 FOR I=0:1:5
Begin DoDot:2
+16 SET ^TMP("BSD",$JOB,SUB,I,0,MON,MON)=+$GET(^TMP("BSD",$JOB,SUB,I,0,MON,MON))
+17 SET ^TMP("BSD",$JOB,SUB,I,0,MON,$$LAST(MON))=+$GET(^TMP("BSD",$JOB,SUB,I,0,MON,$$LAST(MON)))
+18 SET ^TMP("BSD",$JOB,SUB,I,NAME,MON,MON)=+$GET(^TMP("BSD",$JOB,SUB,I,NAME,MON,MON))
+19 SET ^TMP("BSD",$JOB,SUB,I,NAME,MON,$$LAST(MON))=+$GET(^TMP("BSD",$JOB,SUB,I,NAME,MON,$$LAST(MON)))
End DoDot:2
+20 ;find next month
SET X=$EXTRACT(MON,4,5)+1
IF X>12
SET X=X-12
IF $LENGTH(X)=1
SET X="0"_X
+21 ;IHS/ITSC/WAR 2/12/03 P50 per Linda LJF41
+22 ;S MON=$E(MON,1,3)_X_"00" ;IHS/ITSC/LJF 1/22/2003
+23 ;IHS/ITSC/LJF 1/22/2003 increment year, if needed
SET MON=$EXTRACT(MON,1,3)
IF X="01"
SET MON=MON+1
SET MON=MON_X_"00"
End DoDot:1
+24 QUIT
+25 ;
INCR(SUB,TYPE,NAME,SUB2,MON) ; increment totals
+1 SET ^TMP("BSD",$JOB,SUB,0,0,SUB2,MON)=$GET(^TMP("BSD",$JOB,SUB,0,0,SUB2,MON))+1
+2 SET ^TMP("BSD",$JOB,SUB,TYPE,0,SUB2,MON)=$GET(^TMP("BSD",$JOB,SUB,TYPE,0,SUB2,MON))+1
+3 SET ^TMP("BSD",$JOB,SUB,0,NAME,SUB2,MON)=$GET(^TMP("BSD",$JOB,SUB,0,NAME,SUB2,MON))+1
+4 SET ^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,MON)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,MON))+1
+5 QUIT
+6 ;
NET(SUB,CLINIC,MON1,MON2) ; sets up net change & % change lines
+1 ; CLINIC=0 if called by category
+2 NEW I,DIFF,PCNT,DIV
+3 KILL LINE2,LINE3
+4 SET LINE2=$$PAD($$SP(15)_"Net Change",25)
+5 SET LINE3=$$PAD($$SP(15)_"% Change",25)
+6 FOR I=1:1:5
Begin DoDot:1
+7 SET DIFF=$GET(^TMP("BSD",$JOB,SUB,I,CLINIC,MON1,MON1))-$GET(^TMP("BSD",$JOB,SUB,I,CLINIC,MON1,MON2))
+8 SET LINE2=LINE2_$$SP(2)_$JUSTIFY(DIFF,6)
+9 SET DIV=+$GET(^TMP("BSD",$JOB,SUB,I,CLINIC,MON1,MON1))
+10 SET PCNT=$SELECT(DIFF=0:"0",DIV=0:DIFF*100,1:(DIFF/DIV*100))
+11 SET LINE3=LINE3_$$SP(2)_$JUSTIFY(PCNT_"%",6,0)
End DoDot:1
+12 ;
+13 ; set differences for total column
+14 SET DIFF=$GET(^TMP("BSD",$JOB,SUB,0,CLINIC,MON1,MON1))-$GET(^TMP("BSD",$JOB,SUB,0,CLINIC,MON1,MON2))
+15 SET LINE2=$$PAD(LINE2,73)_$JUSTIFY(DIFF,6)
+16 SET DIV=+$GET(^TMP("BSD",$JOB,SUB,0,CLINIC,MON1,MON1))
+17 ;IHS/ITSC/WAR 9/23/04 PATCH #1001
+18 ;S PCNT=$S(DIFF=0:"0",DIV=0:0,1:DIFF\DIV*100)
+19 SET PCNT=$SELECT(DIFF=0:"0",DIV=0:0,1:DIFF/DIV*100)
+20 ;IHS/ITSC/WAR 9/23/04 PATCH #1001
+21 ;S LINE3=$$PAD(LINE3,73)_$J(PCNT_"%",6)
+22 SET LINE3=$$PAD(LINE3,73)_$JUSTIFY(PCNT_"%",6,0)
+23 QUIT
+24 ;
SET(LINE,NUM) ; -- sets display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDWKR3",$JOB,NUM,0)=LINE
+3 QUIT
+4 ;
PRINT ; print report to paper
+1 USE IO
DO HDG
+2 NEW LINE
+3 SET LINE=0
FOR
SET LINE=$ORDER(^TMP("BSDWKR3",$JOB,LINE))
IF 'LINE
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDG
+5 WRITE !,^TMP("BSDWKR3",$JOB,LINE,0)
End DoDot:1
+6 DO ^%ZISC
DO EXIT
+7 QUIT
+8 ;
HDG ; heading for paper report
+1 DO HDR
WRITE @IOF,?30,"Workload Comparisons"
+2 NEW I
FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 WRITE !,$$REPEAT^XLFSTR("-",80)
+4 WRITE !,"Category Name",?29,"SCHED",?35,"SAMEDAY",?44,"WALIKIN"
+5 ;IHS/ITSC/WAR 9/23/04 PATCH #1001
+6 ;W ?52,"OVERBK",?62,"INPT",70,"TOTAL SEEN"
+7 WRITE ?52,"OVERBK",?62,"INPT",?70,"TOTAL SEEN"
+8 WRITE !,$$REPEAT^XLFSTR("=",80)
+9 QUIT
+10 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
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)
