BSDWKR4 ; IHS/ANMC/LJF - WORKLOAD SCHED VS SEEN ; [ 11/01/2004 3:05 PM ]
;;5.3;PIMS;**1001,1008**;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^BDGWKR1") Q:BSDDET=U ;cmi/maw 10/3/2007 orig line
S BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BDGWKR1") Q:BSDDET=U ;cmi/maw 10/3/2007 changed BDGWKR1 to BDGWKR4
;
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 Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
D ZIS^BDGF("PQ","START^BSDWKR4","SCHED VS. SEEN","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 SCHED VS SEEN")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
S VALMHDR(2)=$$SP(18)_"(Assumes patients seen if not flagged as no-shows)"
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDWKR4",$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
. ;IHS/ITSC/WAR 5/5/04 PATCH #1001 REM'd previous change,DIV ck not needed here
. ;Q:'$$GET1^DIQ(44,CLN,3.5,"I") ;No Div entered for this clinic
. ;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="NON-COUNT" Q:STATUS="DELETED" Q:STATUS="FUTURE"
... ;
... 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,BSDA
S S1=0 F S S1=$O(^TMP("BSD",$J,S1)) Q:S1="" D
. ;
. S LINE=$$PAD(S1,22) ;subtotal category name
. ; line up 5 type of appt columns
. K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I)),.LINE)
. 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,22)
... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,0,J)),.LINE)
... 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,22) ;clinic name
... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,S2)),.LINE)
... 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,22)
..... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,S2,J)),.LINE)
..... 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,22)
.... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,S2,S3,S4)),.LINE)
.... D SET(LINE,.VALMCNT)
.. D SET("",.VALMCNT)
;
S LINE=$$PAD("REPORT TOTALS",22)
K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,0,I)),.LINE)
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=overbook, 3=canceld, 4=no-show, 5=walkin
I S["NO-SHOW" Q 4 ;no-show
I S["CANCEL" Q 3 ;cancelled
I $G(^SC(C,"S",D,1,N,"OB"))="O" Q 2 ;overbook
NEW X S X=$$VALI^XBDIQ1(2.98,P_","_D,9) I X=4 Q 5 ;walkin
Q 1 ;rest must be scheduled
;
INCR(SUB,TYPE,NAME,SUB2,APPT) ; increment totals
NEW DATE S DATE=APPT\1
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
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
I (TYPE=3)!(TYPE=4) D INCR(SUB,1,NAME,SUB2,APPT) ;add to scheduled
Q
;
BLDLINE(I,NUM,LINE) ; build columns in display line
; Array BSDA killed by calling code
S BSDA(I)=NUM ;# of appts for type
S LINE=LINE_$$SP(2)_$J(NUM,6) ;add to display
I I=3 S LINE=LINE_$$SP(2)_$J(BSDA(1)+BSDA(2)-BSDA(3),6) ;# expected
I I=5 S LINE=$$PAD(LINE,73)_$J(BSDA(1)+BSDA(2)-BSDA(3)-BSDA(4)+BSDA(5),6) ;# seen
Q
;
SET(LINE,NUM) ; -- sets display line into array
S NUM=NUM+1
S ^TMP("BSDWKR4",$J,NUM,0)=LINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BSDWKR4",$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("BSDWKR4",$J,X)) Q:'X D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BSDWKR4",$J,X,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF,?30,"Scheduled vs. Actual Appointments"
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("-",80)
W !,"Category Names",?28,"SCHED + OVERBK - CANCEL = EXPECTED"
W ?51,"- NOSHOW + WALKIN = 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)
BSDWKR4 ; IHS/ANMC/LJF - WORKLOAD SCHED VS SEEN ; [ 11/01/2004 3:05 PM ]
+1 ;;5.3;PIMS;**1001,1008**;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 ;S BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BDGWKR1") Q:BSDDET=U ;cmi/maw 10/3/2007 orig line
+14 ;cmi/maw 10/3/2007 changed BDGWKR1 to BDGWKR4
SET BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BDGWKR1")
IF BSDDET=U
QUIT
+15 ;
+16 SET BSDSRT=$$READ^BDGF("SO^1:Morning vs. Afternoon;2:Pediatric vs. Adult Patients;3:Male vs. Female Patients","Select addition sort (optional)")
+17 ;optional=0
IF BSDSRT=U
QUIT
SET BSDSRT=+BSDSRT
+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^BSDWKR4","SCHED VS. SEEN","BSDDET;BSDSUB;BSDSRT;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 WORK STATS
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BSDRM SCHED VS SEEN")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
+2 SET VALMHDR(2)=$$SP(18)_"(Assumes patients seen if not flagged as no-shows)"
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BSDWKR4",$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 ;IHS/ITSC/WAR 5/5/04 PATCH #1001 REM'd previous change,DIV ck not needed here
+9 ;Q:'$$GET1^DIQ(44,CLN,3.5,"I") ;No Div entered for this clinic
+10 ;Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I"))))) ;this Div notd
+11 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLN))
QUIT
+12 ;set clinic's name
SET NAME=$$GET1^DIQ(44,CLN,.01)
+13 ;get subcategory for clinic
SET SUB=$$SUB1(CLN,NAME)
+14 ;
+15 ; -- then by appt date (within range)
+16 SET APPT=BSDBD
SET END=BSDED+.2400
+17 FOR
SET APPT=$ORDER(^SC(CLN,"S",APPT))
IF 'APPT!(APPT>END)
QUIT
Begin DoDot:2
+18 ;
+19 ; -- then find appts to count
+20 SET APPN=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="NON-COUNT"
QUIT
IF STATUS="DELETED"
QUIT
IF STATUS="FUTURE"
QUIT
+25 ;
+26 ;type of appt
SET TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)
+27 ;2nd sort
SET SUB2=$$SUB2(APPT,PAT)
+28 ;
+29 ; increment totals
+30 DO INCR(SUB,TYPE,NAME,SUB2,APPT)
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ;
+33 ; put totals into display array
+34 NEW S1,S2,S3,S4,X,LINE,I,J,BSDI,BSDJ,BSDA
+35 SET S1=0
FOR
SET S1=$ORDER(^TMP("BSD",$JOB,S1))
IF S1=""
QUIT
Begin DoDot:1
+36 ;
+37 ;subtotal category name
SET LINE=$$PAD(S1,22)
+38 ; line up 5 type of appt columns
+39 KILL BSDA
FOR I=1:1:5
DO BLDLINE(I,+$GET(^TMP("BSD",$JOB,S1,I)),.LINE)
+40 DO SET(LINE,.VALMCNT)
+41 ;
+42 ;total of 2nd sort for subtotal category
IF BSDSRT
Begin DoDot:2
+43 SET BSDI=$$SUB21(BSDSRT)
SET BSDJ=$$SUB22(BSDSRT)
+44 FOR J=BSDI,BSDJ
Begin DoDot:3
+45 SET LINE=$$PAD(" TOTAL "_J,22)
+46 KILL BSDA
FOR I=1:1:5
DO BLDLINE(I,+$GET(^TMP("BSD",$JOB,S1,I,0,J)),.LINE)
+47 DO SET(LINE,.VALMCNT)
End DoDot:3
End DoDot:2
+48 DO SET("",.VALMCNT)
+49 ;
+50 ; totals by clinic
+51 SET S2=0
FOR
SET S2=$ORDER(^TMP("BSD",$JOB,S1,0,S2))
IF S2=""
QUIT
Begin DoDot:2
+52 ;if sort by clinic, don't repeat data
IF S2'=S1
Begin DoDot:3
+53 ;clinic name
SET LINE=$$PAD($$SP(3)_S2,22)
+54 KILL BSDA
FOR I=1:1:5
DO BLDLINE(I,+$GET(^TMP("BSD",$JOB,S1,I,S2)),.LINE)
+55 DO SET(LINE,.VALMCNT)
+56 ;
+57 ; subtotal clinics by 2nd subcategory
+58 IF BSDSRT
Begin DoDot:4
+59 SET BSDI=$$SUB21(BSDSRT)
SET BSDJ=$$SUB22(BSDSRT)
+60 FOR J=BSDI,BSDJ
Begin DoDot:5
+61 SET LINE=$$PAD($$SP(4)_"TOTAL "_J,22)
+62 KILL BSDA
FOR I=1:1:5
DO BLDLINE(I,+$GET(^TMP("BSD",$JOB,S1,I,S2,J)),.LINE)
+63 DO SET(LINE,.VALMCNT)
End DoDot:5
End DoDot:4
End DoDot:3
+64 ;
+65 ; subtotal clinics by date
+66 SET S3=""
FOR
SET S3=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3))
IF S3=""
QUIT
Begin DoDot:3
+67 SET S4=0
FOR
SET S4=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3,S4))
IF S4=""
QUIT
Begin DoDot:4
+68 ;2nd category if used
SET X=$SELECT(S3=0:"",1:" - "_S3)
+69 SET LINE=$$PAD($$SP(4)_$$FMTE^XLFDT(S4)_X,22)
+70 KILL BSDA
FOR I=1:1:5
DO BLDLINE(I,+$GET(^TMP("BSD",$JOB,S1,I,S2,S3,S4)),.LINE)
+71 DO SET(LINE,.VALMCNT)
End DoDot:4
End DoDot:3
+72 DO SET("",.VALMCNT)
End DoDot:2
End DoDot:1
+73 ;
+74 SET LINE=$$PAD("REPORT TOTALS",22)
+75 KILL BSDA
FOR I=1:1:5
DO BLDLINE(I,+$GET(^TMP("BSD",$JOB,0,I)),.LINE)
+76 DO SET("",.VALMCNT)
DO SET(LINE,.VALMCNT)
+77 ;
+78 KILL ^TMP("BSD",$JOB)
+79 QUIT
+80 ;
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 #: 1=sched, 2=overbook, 3=canceld, 4=no-show, 5=walkin
+2 ;no-show
IF S["NO-SHOW"
QUIT 4
+3 ;cancelled
IF S["CANCEL"
QUIT 3
+4 ;overbook
IF $GET(^SC(C,"S",D,1,N,"OB"))="O"
QUIT 2
+5 ;walkin
NEW X
SET X=$$VALI^XBDIQ1(2.98,P_","_D,9)
IF X=4
QUIT 5
+6 ;rest must be scheduled
QUIT 1
+7 ;
INCR(SUB,TYPE,NAME,SUB2,APPT) ; increment totals
+1 NEW DATE
SET DATE=APPT\1
+2 SET ^TMP("BSD",$JOB,SUB)=$GET(^TMP("BSD",$JOB,SUB))+1
+3 SET ^TMP("BSD",$JOB,0,TYPE)=$GET(^TMP("BSD",$JOB,0,TYPE))+1
+4 SET ^TMP("BSD",$JOB,SUB,TYPE)=$GET(^TMP("BSD",$JOB,SUB,TYPE))+1
+5 SET ^TMP("BSD",$JOB,SUB,0,NAME)=$GET(^TMP("BSD",$JOB,SUB,0,NAME))+1
+6 SET ^TMP("BSD",$JOB,SUB,TYPE,NAME)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME))+1
+7 SET ^TMP("BSD",$JOB,SUB,0,0,SUB2)=$GET(^TMP("BSD",$JOB,SUB,0,0,SUB2))+1
+8 SET ^TMP("BSD",$JOB,SUB,TYPE,0,SUB2)=$GET(^TMP("BSD",$JOB,SUB,TYPE,0,SUB2))+1
+9 SET ^TMP("BSD",$JOB,SUB,0,NAME,SUB2)=$GET(^TMP("BSD",$JOB,SUB,0,NAME,SUB2))+1
+10 SET ^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2))+1
+11 IF BSDDET
SET ^TMP("BSD",$JOB,SUB,0,NAME,SUB2,DATE)=$GET(^TMP("BSD",$JOB,SUB,0,NAME,SUB2,DATE))+1
+12 IF BSDDET
SET ^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,DATE)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,DATE))+1
+13 ;add to scheduled
IF (TYPE=3)!(TYPE=4)
DO INCR(SUB,1,NAME,SUB2,APPT)
+14 QUIT
+15 ;
BLDLINE(I,NUM,LINE) ; build columns in display line
+1 ; Array BSDA killed by calling code
+2 ;# of appts for type
SET BSDA(I)=NUM
+3 ;add to display
SET LINE=LINE_$$SP(2)_$JUSTIFY(NUM,6)
+4 ;# expected
IF I=3
SET LINE=LINE_$$SP(2)_$JUSTIFY(BSDA(1)+BSDA(2)-BSDA(3),6)
+5 ;# seen
IF I=5
SET LINE=$$PAD(LINE,73)_$JUSTIFY(BSDA(1)+BSDA(2)-BSDA(3)-BSDA(4)+BSDA(5),6)
+6 QUIT
+7 ;
SET(LINE,NUM) ; -- sets display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDWKR4",$JOB,NUM,0)=LINE
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BSDWKR4",$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("BSDWKR4",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
DO HDG
+4 WRITE !,^TMP("BSDWKR4",$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,"Scheduled vs. Actual Appointments"
+2 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 WRITE !,$$REPEAT^XLFSTR("-",80)
+4 WRITE !,"Category Names",?28,"SCHED + OVERBK - CANCEL = EXPECTED"
+5 WRITE ?51,"- NOSHOW + WALKIN = 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)
