BSDWKR7 ;cmi/anch/maw - BSD Chart Request and Routing Slip Report 2/20/2007 2:42:22 PM
;;5.3;PIMS;**1007**;FEB 27, 2007
;
;cmi/anch/maw 2/20/2007 PATCH 1007 item 1007.25
;
ASK ; -- ask user questions
NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDTT,BSDDET,BSDSUB,BSDSRT,BSDSEEN,Y
;
S BSDSUB="C"
;
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
;
; get clinic arrays based on subtotal category
I (BSDSUB="C")!(BSDSUB="P") D CLINIC^BSDU(2) Q:$D(BSDQ)
;
S BSDSRT=$$READ^BDGF("S^C:Clinic Name;P:Principal Clinic;O:Clinic Code;D:Date","Sort By","Clinic Name")
Q:BSDSRT=U
;
;S BSDDET=$$READ^BDGF("Y","Subtotal sort criteria as well","NO","^D HELP1^BSDWKR7") Q:BSDDET=U
;
S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
D ZIS^BDGF("PQ","START^BSDWKR7","ROUTING SLIP/CHART REQUEST","BSDDET;BSDSUB;BSDSRT;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 RS/CR REPORT")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(19)_"Routing Slips and Chart Requests by Month"
S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDWKR7",$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,BSDS,BSDSCD,BSDPC,BSDH
I BSDSRT="C" S BSDH="CLINIC NAME"
I BSDSRT="P" S BSDH="PRINCIPAL CLINIC"
I BSDSRT="O" S BSDH="CLINIC CODE"
I BSDSRT="D" S BSDH="DATE"
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
. S BSDSCD=$$GET1^DIQ(44,CLN,8) ;clinic code
. S BSDPC=$$GET1^DIQ(44,CLN,1916) ;principal 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 BSDSRT="C" S BSDS=NAME
... I BSDSRT="P" S BSDS=$S(BSDPC]"":BSDPC,1:NAME)
... I BSDSRT="O" S BSDS=BSDSCD
... I BSDSRT="D" S BSDS=$$FMTE^XLFDT($P(APPT,"."))
... S BSDMON=$E($P(APPT,"."),1,5) ;get the month so I can count
... ;
... S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS,BSDH) ;type of appt
... K BSDRSP
... I $P($G(^DPT(PAT,"S",APPT,0)),U,7) S BSDRSP=1
... ;
... ; increment totals
... I TYPE=3 D Q
.... D INCR(BSDS,BSDH,3,+$G(BSDRSP),BSDMON) ;count walkins
... D INCR(BSDS,BSDH,1,+$G(BSDRSP),BSDMON) ;count rs/sched
. ;
. ; -- then by appt date (within range)
. S APCR=BSDBD,END=BSDED+.2400
. F S APCR=$O(^SC(CLN,"C",APCR)) Q:'APCR!(APCR>END) D
.. ;
.. ; -- then find appts to count
.. S APCN=0
.. F S APCN=$O(^SC(CLN,"C",APCR,1,APCN)) Q:'APCN D
... S PAT=+^SC(CLN,"C",APCR,1,APCN,0) ;patient ien
... ;S STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APCR,100) ;current status
... ;Q:STATUS["CANCEL"
... ;Q:STATUS="FUTURE"
... ;Q:STATUS="NON-COUNT"
... ;Q:STATUS="DELETED"
... I BSDSRT="C" S BSDS=NAME
... I BSDSRT="P" S BSDS=$S(BSDPC]"":BSDPC,1:NAME)
... I BSDSRT="O" S BSDS=BSDSCD
... I BSDSRT="D" S BSDS=$$FMTE^XLFDT($P(APCR,"."))
... S BSDMON=$E($P(APCR,"."),1,5) ;get the month so I can count
... ;
... ;S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS,BSDH) ;type of appt
... K BSDRSP
... I $P($G(^DPT(PAT,"S",APCR,0)),U,7) S BSDRSP=1
... ;
... ; increment totals
... D INCR(BSDS,BSDH,2,+$G(BSDRSP),BSDMON)
;
;
N BSDDA,BSDRS
S BSDDA=0 F S BSDDA=$O(^TMP("BSD",$J,BSDDA)) Q:BSDDA="" D
. N BSDIEN
. S BSDIEN=0 F S BSDIEN=$O(^TMP("BSD",$J,BSDDA,BSDIEN)) Q:BSDIEN="" D
.. I BSDDA'="DATE" D SET("",.VALMCNT) ;cmi/anch/maw 8/14/2007 patch 1007
.. I BSDDA'="DATE" D SET(BSDIEN,.VALMCNT) ;cmi/anch/maw 8/14/2007 patch 1007
.. N BSDOEN
.. S BSDOEN=0 F S BSDOEN=$O(^TMP("BSD",$J,BSDDA,BSDIEN,BSDOEN)) Q:'BSDOEN D
... ;D SET($$MON(BSDOEN),.VALMCNT)
... ;TODO FIX IF DATE SORT
... N BSDCR,BSDSA,BSDWI,RS
... S BSDRS=+$G(^TMP("BSD",$J,BSDDA,BSDIEN,BSDOEN,"RS"))
... S BSDCR=+$G(^TMP("BSD",$J,BSDDA,BSDIEN,BSDOEN,2))
... S BSDSA=+$G(^TMP("BSD",$J,BSDDA,BSDIEN,BSDOEN,1))
... S BSDWI=+$G(^TMP("BSD",$J,BSDDA,BSDIEN,BSDOEN,3))
... I BSDDA'="DATE" S LINE=$$MON(BSDOEN)_$$SP(9)_$$PAD(BSDRS,20) ;cmi/anch/maw 8/14/2007 patch 1007 added month print here
... I BSDDA="DATE" S LINE=BSDIEN_$$SP(4)_$$PAD(BSDRS,20) ;cmi/anch/maw 8/14/2007 patch 1007 added date print here
... S LINE=LINE_$$PAD(BSDCR,20)
... S LINE=LINE_$$PAD(BSDSA,15)
... S LINE=LINE_$$PAD(BSDWI,10)
... D SET(LINE,.VALMCNT)
.. Q:BSDDA="DATE"
.. N BSDCRS,BSDCCR,BSDCSA,BSDCWI
.. S BSDCRS=+$G(^TMP("BSDS",$J,BSDDA,BSDIEN,"RS"))
.. S BSDCCR=+$G(^TMP("BSDS",$J,BSDDA,BSDIEN,2))
.. S BSDCSA=+$G(^TMP("BSDS",$J,BSDDA,BSDIEN,1))
.. S BSDCWI=+$G(^TMP("BSDS",$J,BSDDA,BSDIEN,3))
.. S LINE="Sub Total"_$$SP(8)_$$PAD(BSDCRS,20)
.. S LINE=LINE_$$PAD(BSDCCR,20)
.. S LINE=LINE_$$PAD(BSDCSA,15)
.. S LINE=LINE_$$PAD(BSDCWI,10)
.. D SET("",.VALMCNT)
.. D SET(LINE,.VALMCNT)
D SET("",.VALMCNT)
D SET("REPORT TOTALS",.VALMCNT)
N BSDRST,BSDCRT,BSDSAT,BSDWIT
S BSDRST=+$G(^TMP("BSDTOT",$J,"RS"))
S BSDCRT=+$G(^TMP("BSDTOT",$J,2))
S BSDSAT=+$G(^TMP("BSDTOT",$J,1))
S BSDWIT=+$G(^TMP("BSDTOT",$J,3))
I BSDH="DATE" D
. S LINE=$$SP(16)_$$PAD(BSDRST,20) ;cmi/anch/maw 8/14/2007 patch 1007
I BSDH'="DATE" D
. S LINE=$$SP(17)_$$PAD(BSDRST,20) ;cmi/anch/maw 8/14/2007 patch 1007
S LINE=LINE_$$PAD(BSDCRT,20)
S LINE=LINE_$$PAD(BSDSAT,15)
S LINE=LINE_$$PAD(BSDWIT,10)
D SET(LINE,.VALMCNT)
K ^TMP("BSD",$J)
K ^TMP("BSDTOT",$J)
K ^TMP("BSDS",$J)
Q
;
TYPE(C,D,N,P,S,H) ; -- return type of appt.
; returns column #
; 1=appt, 2=chart request, 3=walk-in
I S["NO-SHOW" Q 1 ;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 (D\1)=($P($G(^SC(C,"C",D,1,N,9999999)),U,7)\1) Q 2 ;same day CR
I H'="DATE",(D\1)'=($P($G(^SC(C,"C",D,1,N,9999999)),U,7)\1) Q 2 ;future CR
I X=3,(D\1)=($P($G(^DPT(P,"S",D,0)),U,19)\1) Q 1 ;same day appt
I H'="DATE",X=3,(D\1)'=($P($G(^DPT(P,"S",D,0)),U,19)\1) Q 1 ;future appt
I X=3 Q 1 ;scheduled
Q "??" ;error in case one slips thru
;
INCR(SUB,SUBH,TYPE,RS,MON) ; increment totals
Q:TYPE=5
I RS D
. S ^TMP("BSD",$J,SUBH,SUB,MON,"RS")=$G(^TMP("BSD",$J,SUBH,SUB,MON,"RS"))+1
. S ^TMP("BSDS",$J,SUBH,SUB,"RS")=$G(^TMP("BSDS",$J,SUBH,SUB,"RS"))+1
. S ^TMP("BSDTOT",$J,"RS")=$G(^TMP("BSDTOT",$J,"RS"))+1
S ^TMP("BSD",$J,SUBH,SUB,MON,TYPE)=$G(^TMP("BSD",$J,SUBH,SUB,MON,TYPE))+1
S ^TMP("BSDS",$J,SUBH,SUB,TYPE)=$G(^TMP("BSDS",$J,SUBH,SUB,TYPE))+1
S ^TMP("BSDTOT",$J,TYPE)=$G(^TMP("BSDTOT",$J,TYPE))+1
Q
;
SET(LINE,NUM) ; -- sets display line into array
S NUM=NUM+1
S ^TMP("BSDWKR7",$J,NUM,0)=LINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
HELP1 ;EP; help for print individual dates question
D MSG^BDGF("The report will subtotal by Chart requests,",2,0)
D MSG^BDGF("scheduled appointments, and walkins.",1,0)
D MSG^BDGF("Answer YES to have it subtotal by sort criteria",1,0)
D MSG^BDGF("as well.",1,1)
Q
;
EXIT ; -- exit code
K ^TMP("BSDWKR7",$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("BSDWKR7",$J,X)) Q:'X D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BSDWKR7",$J,X,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF,?30,"Routing Slip Statistics"
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("-",80)
W !,?10,"Routing Slips",?30,"Chart Requests",?50,"Sch Appts",?70,"Walkins"
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)
;
MON(MI) ;-- return external month
S MY=$E(MI,1,3)+1700
S MI=$E(MI,4,5)
I MI="01" S MO="Jan"
I MI="02" S MO="Feb"
I MI="03" S MO="Mar"
I MI="04" S MO="Apr"
I MI="05" S MO="May"
I MI="06" S MO="Jun"
I MI="07" S MO="Jul"
I MI="08" S MO="Aug"
I MI="09" S MO="Sep"
I MI="10" S MO="Oct"
I MI="11" S MO="Nov"
I MI="12" S MO="Dec"
Q MO_" "_MY
;
BSDWKR7 ;cmi/anch/maw - BSD Chart Request and Routing Slip Report 2/20/2007 2:42:22 PM
+1 ;;5.3;PIMS;**1007**;FEB 27, 2007
+2 ;
+3 ;cmi/anch/maw 2/20/2007 PATCH 1007 item 1007.25
+4 ;
ASK ; -- ask user questions
+1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDTT,BSDDET,BSDSUB,BSDSRT,BSDSEEN,Y
+2 ;
+3 SET BSDSUB="C"
+4 ;
+5 SET BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search")
IF 'BSDBD
QUIT
+6 SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")
IF 'BSDED
QUIT
+7 ;
+8 ; get clinic arrays based on subtotal category
+9 IF (BSDSUB="C")!(BSDSUB="P")
DO CLINIC^BSDU(2)
IF $DATA(BSDQ)
QUIT
+10 ;
+11 SET BSDSRT=$$READ^BDGF("S^C:Clinic Name;P:Principal Clinic;O:Clinic Code;D:Date","Sort By","Clinic Name")
+12 IF BSDSRT=U
QUIT
+13 ;
+14 ;S BSDDET=$$READ^BDGF("Y","Subtotal sort criteria as well","NO","^D HELP1^BSDWKR7") Q:BSDDET=U
+15 ;
+16 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+17 DO ZIS^BDGF("PQ","START^BSDWKR7","ROUTING SLIP/CHART REQUEST","BSDDET;BSDSUB;BSDSRT;BSDBD;BSDED;VAUTC*;VAUTD*")
+18 QUIT
+19 ;
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 RS/CR REPORT")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(19)_"Routing Slips and Chart Requests by Month"
+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("BSDWKR7",$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,BSDS,BSDSCD,BSDPC,BSDH
+6 IF BSDSRT="C"
SET BSDH="CLINIC NAME"
+7 IF BSDSRT="P"
SET BSDH="PRINCIPAL CLINIC"
+8 IF BSDSRT="O"
SET BSDH="CLINIC CODE"
+9 IF BSDSRT="D"
SET BSDH="DATE"
+10 SET CLN=0
FOR
SET CLN=$ORDER(@BSDAR@(CLN))
IF 'CLN
QUIT
Begin DoDot:1
+11 ;No Div entered for this clinic
IF '$$GET1^DIQ(44,CLN,3.5,"I")
QUIT
+12 ;this Div notd
IF $DATA(VAUTD)
IF (VAUTD'=1&('$DATA(VAUTD($$GET1^DIQ(44,CLN,3.5,"I")))))
QUIT
+13 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLN))
QUIT
+14 ;set clinic's name
SET NAME=$$GET1^DIQ(44,CLN,.01)
+15 ;clinic code
SET BSDSCD=$$GET1^DIQ(44,CLN,8)
+16 ;principal clinic
SET BSDPC=$$GET1^DIQ(44,CLN,1916)
+17 ;
+18 ; -- then by appt date (within range)
+19 SET APPT=BSDBD
SET END=BSDED+.2400
+20 FOR
SET APPT=$ORDER(^SC(CLN,"S",APPT))
IF 'APPT!(APPT>END)
QUIT
Begin DoDot:2
+21 ;
+22 ; -- then find appts to count
+23 SET APPN=0
+24 FOR
SET APPN=$ORDER(^SC(CLN,"S",APPT,1,APPN))
IF 'APPN
QUIT
Begin DoDot:3
+25 ;patient ien
SET PAT=+^SC(CLN,"S",APPT,1,APPN,0)
+26 ;current status
SET STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100)
+27 IF STATUS["CANCEL"
QUIT
+28 IF STATUS="FUTURE"
QUIT
+29 IF STATUS="NON-COUNT"
QUIT
+30 IF STATUS="DELETED"
QUIT
+31 IF BSDSRT="C"
SET BSDS=NAME
+32 IF BSDSRT="P"
SET BSDS=$SELECT(BSDPC]"":BSDPC,1:NAME)
+33 IF BSDSRT="O"
SET BSDS=BSDSCD
+34 IF BSDSRT="D"
SET BSDS=$$FMTE^XLFDT($PIECE(APPT,"."))
+35 ;get the month so I can count
SET BSDMON=$EXTRACT($PIECE(APPT,"."),1,5)
+36 ;
+37 ;type of appt
SET TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS,BSDH)
+38 KILL BSDRSP
+39 IF $PIECE($GET(^DPT(PAT,"S",APPT,0)),U,7)
SET BSDRSP=1
+40 ;
+41 ; increment totals
+42 IF TYPE=3
Begin DoDot:4
+43 ;count walkins
DO INCR(BSDS,BSDH,3,+$GET(BSDRSP),BSDMON)
End DoDot:4
QUIT
+44 ;count rs/sched
DO INCR(BSDS,BSDH,1,+$GET(BSDRSP),BSDMON)
End DoDot:3
End DoDot:2
+45 ;
+46 ; -- then by appt date (within range)
+47 SET APCR=BSDBD
SET END=BSDED+.2400
+48 FOR
SET APCR=$ORDER(^SC(CLN,"C",APCR))
IF 'APCR!(APCR>END)
QUIT
Begin DoDot:2
+49 ;
+50 ; -- then find appts to count
+51 SET APCN=0
+52 FOR
SET APCN=$ORDER(^SC(CLN,"C",APCR,1,APCN))
IF 'APCN
QUIT
Begin DoDot:3
+53 ;patient ien
SET PAT=+^SC(CLN,"C",APCR,1,APCN,0)
+54 ;S STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APCR,100) ;current status
+55 ;Q:STATUS["CANCEL"
+56 ;Q:STATUS="FUTURE"
+57 ;Q:STATUS="NON-COUNT"
+58 ;Q:STATUS="DELETED"
+59 IF BSDSRT="C"
SET BSDS=NAME
+60 IF BSDSRT="P"
SET BSDS=$SELECT(BSDPC]"":BSDPC,1:NAME)
+61 IF BSDSRT="O"
SET BSDS=BSDSCD
+62 IF BSDSRT="D"
SET BSDS=$$FMTE^XLFDT($PIECE(APCR,"."))
+63 ;get the month so I can count
SET BSDMON=$EXTRACT($PIECE(APCR,"."),1,5)
+64 ;
+65 ;S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS,BSDH) ;type of appt
+66 KILL BSDRSP
+67 IF $PIECE($GET(^DPT(PAT,"S",APCR,0)),U,7)
SET BSDRSP=1
+68 ;
+69 ; increment totals
+70 DO INCR(BSDS,BSDH,2,+$GET(BSDRSP),BSDMON)
End DoDot:3
End DoDot:2
End DoDot:1
+71 ;
+72 ;
+73 NEW BSDDA,BSDRS
+74 SET BSDDA=0
FOR
SET BSDDA=$ORDER(^TMP("BSD",$JOB,BSDDA))
IF BSDDA=""
QUIT
Begin DoDot:1
+75 NEW BSDIEN
+76 SET BSDIEN=0
FOR
SET BSDIEN=$ORDER(^TMP("BSD",$JOB,BSDDA,BSDIEN))
IF BSDIEN=""
QUIT
Begin DoDot:2
+77 ;cmi/anch/maw 8/14/2007 patch 1007
IF BSDDA'="DATE"
DO SET("",.VALMCNT)
+78 ;cmi/anch/maw 8/14/2007 patch 1007
IF BSDDA'="DATE"
DO SET(BSDIEN,.VALMCNT)
+79 NEW BSDOEN
+80 SET BSDOEN=0
FOR
SET BSDOEN">EN=$ORDER(^TMP("BSD",$JOB,BSDDA,BSDIEN">EN,BSDOEN">EN))
IF 'BSDOEN
QUIT
Begin DoDot:3
+81 ;D SET($$MON(BSDOEN),.VALMCNT)
+82 ;TODO FIX IF DATE SORT
+83 NEW BSDCR,BSDSA,BSDWI,RS
+84 SET BSDRS=+$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,BSDOEN,"RS"))
+85 SET BSDCR=+$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,BSDOEN,2))
+86 SET BSDSA=+$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,BSDOEN,1))
+87 SET BSDWI=+$GET(^TMP("BSD",$JOB,BSDDA,BSDIEN,BSDOEN,3))
+88 ;cmi/anch/maw 8/14/2007 patch 1007 added month print here
IF BSDDA'="DATE"
SET LINE=$$MON(BSDOEN)_$$SP(9)_$$PAD(BSDRS,20)
+89 ;cmi/anch/maw 8/14/2007 patch 1007 added date print here
IF BSDDA="DATE"
SET LINE=BSDIEN_$$SP(4)_$$PAD(BSDRS,20)
+90 SET LINE=LINE_$$PAD(BSDCR,20)
+91 SET LINE=LINE_$$PAD(BSDSA,15)
+92 SET LINE=LINE_$$PAD(BSDWI,10)
+93 DO SET(LINE,.VALMCNT)
End DoDot:3
+94 IF BSDDA="DATE"
QUIT
+95 NEW BSDCRS,BSDCCR,BSDCSA,BSDCWI
+96 SET BSDCRS=+$GET(^TMP("BSDS",$JOB,BSDDA,BSDIEN,"RS"))
+97 SET BSDCCR=+$GET(^TMP("BSDS",$JOB,BSDDA,BSDIEN,2))
+98 SET BSDCSA=+$GET(^TMP("BSDS",$JOB,BSDDA,BSDIEN,1))
+99 SET BSDCWI=+$GET(^TMP("BSDS",$JOB,BSDDA,BSDIEN,3))
+100 SET LINE="Sub Total"_$$SP(8)_$$PAD(BSDCRS,20)
+101 SET LINE=LINE_$$PAD(BSDCCR,20)
+102 SET LINE=LINE_$$PAD(BSDCSA,15)
+103 SET LINE=LINE_$$PAD(BSDCWI,10)
+104 DO SET("",.VALMCNT)
+105 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+106 DO SET("",.VALMCNT)
+107 DO SET("REPORT TOTALS",.VALMCNT)
+108 NEW BSDRST,BSDCRT,BSDSAT,BSDWIT
+109 SET BSDRST=+$GET(^TMP("BSDTOT",$JOB,"RS"))
+110 SET BSDCRT=+$GET(^TMP("BSDTOT",$JOB,2))
+111 SET BSDSAT=+$GET(^TMP("BSDTOT",$JOB,1))
+112 SET BSDWIT=+$GET(^TMP("BSDTOT",$JOB,3))
+113 IF BSDH="DATE"
Begin DoDot:1
+114 ;cmi/anch/maw 8/14/2007 patch 1007
SET LINE=$$SP(16)_$$PAD(BSDRST,20)
End DoDot:1
+115 IF BSDH'="DATE"
Begin DoDot:1
+116 ;cmi/anch/maw 8/14/2007 patch 1007
SET LINE=$$SP(17)_$$PAD(BSDRST,20)
End DoDot:1
+117 SET LINE=LINE_$$PAD(BSDCRT,20)
+118 SET LINE=LINE_$$PAD(BSDSAT,15)
+119 SET LINE=LINE_$$PAD(BSDWIT,10)
+120 DO SET(LINE,.VALMCNT)
+121 KILL ^TMP("BSD",$JOB)
+122 KILL ^TMP("BSDTOT",$JOB)
+123 KILL ^TMP("BSDS",$JOB)
+124 QUIT
+125 ;
TYPE(C,D,N,P,S,H) ; -- return type of appt.
+1 ; returns column #
+2 ; 1=appt, 2=chart request, 3=walk-in
+3 ;no-show
IF S["NO-SHOW"
QUIT 1
+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 (D\1)=($PIECE($GET(^SC(C,"C",D,1,N,9999999)),U,7)\1)
QUIT 2
+7 ;future CR
IF H'="DATE"
IF (D\1)'=($PIECE($GET(^SC(C,"C",D,1,N,9999999)),U,7)\1)
QUIT 2
+8 ;same day appt
IF X=3
IF (D\1)=($PIECE($GET(^DPT(P,"S",D,0)),U,19)\1)
QUIT 1
+9 ;future appt
IF H'="DATE"
IF X=3
IF (D\1)'=($PIECE($GET(^DPT(P,"S",D,0)),U,19)\1)
QUIT 1
+10 ;scheduled
IF X=3
QUIT 1
+11 ;error in case one slips thru
QUIT "??"
+12 ;
INCR(SUB,SUBH,TYPE,RS,MON) ; increment totals
+1 IF TYPE=5
QUIT
+2 IF RS
Begin DoDot:1
+3 SET ^TMP("BSD",$JOB,SUBH,SUB,MON,"RS")=$GET(^TMP("BSD",$JOB,SUBH,SUB,MON,"RS"))+1
+4 SET ^TMP("BSDS",$JOB,SUBH,SUB,"RS")=$GET(^TMP("BSDS",$JOB,SUBH,SUB,"RS"))+1
+5 SET ^TMP("BSDTOT",$JOB,"RS")=$GET(^TMP("BSDTOT",$JOB,"RS"))+1
End DoDot:1
+6 SET ^TMP("BSD",$JOB,SUBH,SUB,MON,TYPE)=$GET(^TMP("BSD",$JOB,SUBH,SUB,MON,TYPE))+1
+7 SET ^TMP("BSDS",$JOB,SUBH,SUB,TYPE)=$GET(^TMP("BSDS",$JOB,SUBH,SUB,TYPE))+1
+8 SET ^TMP("BSDTOT",$JOB,TYPE)=$GET(^TMP("BSDTOT",$JOB,TYPE))+1
+9 QUIT
+10 ;
SET(LINE,NUM) ; -- sets display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDWKR7",$JOB,NUM,0)=LINE
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
HELP1 ;EP; help for print individual dates question
+1 DO MSG^BDGF("The report will subtotal by Chart requests,",2,0)
+2 DO MSG^BDGF("scheduled appointments, and walkins.",1,0)
+3 DO MSG^BDGF("Answer YES to have it subtotal by sort criteria",1,0)
+4 DO MSG^BDGF("as well.",1,1)
+5 QUIT
+6 ;
EXIT ; -- exit code
+1 KILL ^TMP("BSDWKR7",$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("BSDWKR7",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
DO HDG
+4 WRITE !,^TMP("BSDWKR7",$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,"Routing Slip Statistics"
+2 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 WRITE !,$$REPEAT^XLFSTR("-",80)
+4 WRITE !,?10,"Routing Slips",?30,"Chart Requests",?50,"Sch Appts",?70,"Walkins"
+5 WRITE !,$$REPEAT^XLFSTR("=",80)
+6 QUIT
+7 ;
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 ;
MON(MI) ;-- return external month
+1 SET MY=$EXTRACT(MI,1,3)+1700
+2 SET MI=$EXTRACT(MI,4,5)
+3 IF MI="01"
SET MO="Jan"
+4 IF MI="02"
SET MO="Feb"
+5 IF MI="03"
SET MO="Mar"
+6 IF MI="04"
SET MO="Apr"
+7 IF MI="05"
SET MO="May"
+8 IF MI="06"
SET MO="Jun"
+9 IF MI="07"
SET MO="Jul"
+10 IF MI="08"
SET MO="Aug"
+11 IF MI="09"
SET MO="Sep"
+12 IF MI="10"
SET MO="Oct"
+13 IF MI="11"
SET MO="Nov"
+14 IF MI="12"
SET MO="Dec"
+15 QUIT MO_" "_MY
+16 ;
