BSDTOD ;cmi/flag/maw - Time of Day Appointment fills up ;
;;5.3;PIMS;**1012**;APR 26, 2002
;
ASK ; -- ask user questions
NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDDET,BSDIND,Y
;
D CLINIC^BSDU(2) Q:$D(BSDQ) ;get clinic choices
;
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 Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
D ZIS^BDGF("PQ","START^BSDTOD","TOD FILL UP","BSDBD;BSDED;VAUTC*;VAUTD*")
Q
;
START ;EP; -- re-entry for printing to paper
D INIT,PRINT Q
;
EN ;EP; -- called by SD IHS COUNT APPTS MADE list template
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D MSG^BDGF("Counting Appointments . . . Please wait",2,0)
D EN^VALM("BSDRM TOD")
D EXIT,CLEAR^VALM1
Q
;
HDR ; -- header code
S X="Time of Day Clinic Appointments Fill Up for "_$$RANGE^BDGF(BSDBD,BSDED)
S VALMHDR(1)=$$SP(70-$L(X)\2)_X
;no column headings if no details
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDTOD",$J),^TMP("BSDTOD1",$J)
NEW ARRAY S ARRAY=$S(VAUTC:"^SC",1:"VAUTC")
;
; loop thru selected clinics and put in principal clinic order
NEW CLINIC,PC,ABBR,CLNE
S CLINIC=0
F S CLINIC=$O(@ARRAY@(CLINIC)) Q:'CLINIC D
. Q:$D(^SC("AIHSPC",CLINIC)) ;quit if principal clinic
. S PC=$$PRIN^BSDU(CLINIC) ;get princ clinic name
. S ABBR=$$GET1^DIQ(44,CLINIC,1) ;clinic's abbreviation
. S CLNE=$$GET1^DIQ(44,CLINIC,.01) ;clinic name
. S ^TMP("BSDTOD1",$J,PC,CLNE,CLINIC)="" ;put in pc/clinic order
;
; loop thru sorted list and count available appts
NEW PC,ABBR,CLINIC,CLINE,LINE,DATE,SCHED,COUNT,END
S PC=0 F S PC=$O(^TMP("BSDTOD1",$J,PC)) Q:PC="" D
. S ABBR=0 F S ABBR=$O(^TMP("BSDTOD1",$J,PC,ABBR)) Q:ABBR="" D
.. S CLINIC=0
.. F S CLINIC=$O(^TMP("BSDTOD1",$J,PC,ABBR,CLINIC)) Q:'CLINIC D
... ; now loop thru date range, count and put in display array
... S DATE=BSDBD-1,END=BSDED
... F S DATE=$$FMADD^XLFDT(DATE,1) Q:DATE>END D
.... Q:'$$OKAY(CLINIC,DATE) ;quit if inactive or no schedule
.... S SCHED=$G(^SC(CLINIC,"ST",DATE,1))
.... Q:$G(SCHED)=""
.... S COUNT=$$COUNT(SCHED)
.... Q:+$G(COUNT)>0
.... S BSDTOD=$$LASTAPPT(DATE,CLINIC)
.... Q:'$G(BSDTOD)
.... S CLINE=$$GET1^DIQ(44,CLINIC,.01)
.... S LINE=$$PAD(CLINE,21)
.... S LINE=LINE_$$PAD($$FMTE^XLFDT(DATE),28)
.... S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDTOD),22)
.... D SET(LINE,.VALMCNT) ;add clinic's line to display array
;
K ^TMP("BSDTOD1",$J)
Q
;
COUNT(LINE) ; returns # of avail appts in display line LINE
NEW I,CNT,J,X
I LINE["CANCELLED" Q 0
S LINE=$P(LINE,"|",2,999)
F I="|","[","]","*"," ","0" S LINE=$$STRIP^XLFSTR(LINE,I)
;
; -- count up appts left
S CNT=0 F I=1:1:9 Q:LINE="" D
. S X=LINE F J=1:1 Q:X="" S:$E(X)=I CNT=CNT+I S X=$E(X,2,99)
. S LINE=$$STRIP^XLFSTR(LINE,I)
Q +$G(CNT)
;
SET(LINE,NUM) ; put display line into display array
S NUM=NUM+1
S ^TMP("BSDTOD",$J,NUM,0)=LINE
Q
;
OKAY(C,BSDATE) ; -- active clinic with schedule? (yes=true)
NEW X
S X=$G(^SC(C,"I")) Q:'$D(^SC(C,"ST")) 0 Q:'$O(^("ST",BSDATE)) 0
Q $S($P(^SC(C,0),U,3)'="C":0,'X:1,(BSDATE>(X-1))&('$P(X,U,2)):0,1:1)
;
LASTAPPT(D,C) ;-- get the last appointment made for that date
I '$D(^SC(C,"S")) Q 0
N BSDA,BSDRR,BSDLAP,BSDI
S BSDCNT=0
S BSDA=D F S BSDA=$O(^SC(C,"S",BSDA)) Q:'BSDA!(BSDA>(D+.9999)) D
. S BSDI=0 F S BSDI=$O(^SC(C,"S",BSDA,1,BSDI)) Q:'BSDI D
.. S BSDLAP=$P($G(^SC(C,"S",BSDA,1,BSDI,0)),U,7)
.. Q:'$G(BSDLAP)
.. S BSDRR(BSDLAP)=""
I '$O(BSDRR("")) Q 0
Q $O(BSDRR(""),-1)
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BSDDAM",$J)
Q
;
EXPND ; -- expand code
Q
;
;
PRINT ;EP; --prints report to paper
NEW LINE
U IO D HDG
S LINE=0 F S LINE=$O(^TMP("BSDTOD",$J,LINE)) Q:'LINE D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BSDTOD",$J,LINE,0)
D ^%ZISC D EXIT
Q
;
HDG ; -- 2nd half of heading
NEW X
W @IOF,!!?25,"Time of Day Clinic Fills Up"
D HDR,MSG^BDGF(VALMHDR(1),0,1)
S X=$$PAD("Clinic",21)
S X=$$PAD(X_"Appointment Date",49)
S X=X_"Date/Time"
D MSG^BDGF(X,1,0),MSG^BDGF($$REPEAT^XLFSTR("=",80),1,1)
Q
;
;
PAD(D,L) ; -- 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)
;
PC(C) ; -- returns name of principal clinic
Q $$PRIN^BSDU(C)
;
HELP1 ;EP; called from DIR for Detailed Display question
D MSG^BDGF("Answer YES to include totals for each date in your",2,0)
D MSG^BDGF("date range in addition to the day of week averages.",1,0)
D MSG^BDGF("Answer NO to only display day of week data.",2,1)
Q
;
HELP2 ;EP; called by DIR for Include Individual Clinic Totals question
D MSG^BDGF("Answer YES to display data on each individual clinic",2,0)
D MSG^BDGF("as opposed to just principal clinic totals.",1,0)
D MSG^BDGF("Answer NO to only see principal clinic data.",2,1)
Q
;
XREFC(CLIN,DATE,PAT) ;EP; -- updates AIHSDAM xref when data is hard set
; Called by SDM1A and SDMM1
NEW MADE
S MADE=$P($G(^SC(CLIN,"S",DATE,1,PAT,0)),U,7)
I MADE]"" S ^SC("AIHSDAM",CLIN,MADE,DATE,PAT)=""
Q
;
BSDTOD ;cmi/flag/maw - Time of Day Appointment fills up ;
+1 ;;5.3;PIMS;**1012**;APR 26, 2002
+2 ;
ASK ; -- ask user questions
+1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDDET,BSDIND,Y
+2 ;
+3 ;get clinic choices
DO CLINIC^BSDU(2)
IF $DATA(BSDQ)
QUIT
+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 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+9 DO ZIS^BDGF("PQ","START^BSDTOD","TOD FILL UP","BSDBD;BSDED;VAUTC*;VAUTD*")
+10 QUIT
+11 ;
START ;EP; -- re-entry for printing to paper
+1 DO INIT
DO PRINT
QUIT
+2 ;
EN ;EP; -- called by SD IHS COUNT APPTS MADE list template
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO MSG^BDGF("Counting Appointments . . . Please wait",2,0)
+3 DO EN^VALM("BSDRM TOD")
+4 DO EXIT
DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; -- header code
+1 SET X="Time of Day Clinic Appointments Fill Up for "_$$RANGE^BDGF(BSDBD,BSDED)
+2 SET VALMHDR(1)=$$SP(70-$LENGTH(X)\2)_X
+3 ;no column headings if no details
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BSDTOD",$JOB),^TMP("BSDTOD1",$JOB)
+2 NEW ARRAY
SET ARRAY=$SELECT(VAUTC:"^SC",1:"VAUTC")
+3 ;
+4 ; loop thru selected clinics and put in principal clinic order
+5 NEW CLINIC,PC,ABBR,CLNE
+6 SET CLINIC=0
+7 FOR
SET CLINIC=$ORDER(@ARRAY@(CLINIC))
IF 'CLINIC
QUIT
Begin DoDot:1
+8 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLINIC))
QUIT
+9 ;get princ clinic name
SET PC=$$PRIN^BSDU(CLINIC)
+10 ;clinic's abbreviation
SET ABBR=$$GET1^DIQ(44,CLINIC,1)
+11 ;clinic name
SET CLNE=$$GET1^DIQ(44,CLINIC,.01)
+12 ;put in pc/clinic order
SET ^TMP("BSDTOD1",$JOB,PC,CLNE,CLINIC)=""
End DoDot:1
+13 ;
+14 ; loop thru sorted list and count available appts
+15 NEW PC,ABBR,CLINIC,CLINE,LINE,DATE,SCHED,COUNT,END
+16 SET PC=0
FOR
SET PC=$ORDER(^TMP("BSDTOD1",$JOB,PC))
IF PC=""
QUIT
Begin DoDot:1
+17 SET ABBR=0
FOR
SET ABBR=$ORDER(^TMP("BSDTOD1",$JOB,PC,ABBR))
IF ABBR=""
QUIT
Begin DoDot:2
+18 SET CLINIC=0
+19 FOR
SET CLINIC=$ORDER(^TMP("BSDTOD1",$JOB,PC,ABBR,CLINIC))
IF 'CLINIC
QUIT
Begin DoDot:3
+20 ; now loop thru date range, count and put in display array
+21 SET DATE=BSDBD-1
SET END=BSDED
+22 FOR
SET DATE=$$FMADD^XLFDT(DATE,1)
IF DATE>END
QUIT
Begin DoDot:4
+23 ;quit if inactive or no schedule
IF '$$OKAY(CLINIC,DATE)
QUIT
+24 SET SCHED=$GET(^SC(CLINIC,"ST",DATE,1))
+25 IF $GET(SCHED)=""
QUIT
+26 SET COUNT=$$COUNT(SCHED)
+27 IF +$GET(COUNT)>0
QUIT
+28 SET BSDTOD=$$LASTAPPT(DATE,CLINIC)
+29 IF '$GET(BSDTOD)
QUIT
+30 SET CLINE=$$GET1^DIQ(44,CLINIC,.01)
+31 SET LINE=$$PAD(CLINE,21)
+32 SET LINE=LINE_$$PAD($$FMTE^XLFDT(DATE),28)
+33 SET LINE=LINE_$$PAD($$FMTE^XLFDT(BSDTOD),22)
+34 ;add clinic's line to display array
DO SET(LINE,.VALMCNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 KILL ^TMP("BSDTOD1",$JOB)
+37 QUIT
+38 ;
COUNT(LINE) ; returns # of avail appts in display line LINE
+1 NEW I,CNT,J,X
+2 IF LINE["CANCELLED"
QUIT 0
+3 SET LINE=$PIECE(LINE,"|",2,999)
+4 FOR I="|","[","]","*"," ","0"
SET LINE=$$STRIP^XLFSTR(LINE,I)
+5 ;
+6 ; -- count up appts left
+7 SET CNT=0
FOR I=1:1:9
IF LINE=""
QUIT
Begin DoDot:1
+8 SET X=LINE
FOR J=1:1
IF X=""
QUIT
IF $EXTRACT(X)=I
SET CNT=CNT+I
SET X=$EXTRACT(X,2,99)
+9 SET LINE=$$STRIP^XLFSTR(LINE,I)
End DoDot:1
+10 QUIT +$GET(CNT)
+11 ;
SET(LINE,NUM) ; put display line into display array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDTOD",$JOB,NUM,0)=LINE
+3 QUIT
+4 ;
OKAY(C,BSDATE) ; -- active clinic with schedule? (yes=true)
+1 NEW X
+2 SET X=$GET(^SC(C,"I"))
IF '$DATA(^SC(C,"ST"))
QUIT 0
IF '$ORDER(^("ST",BSDATE))
QUIT 0
+3 QUIT $SELECT($PIECE(^SC(C,0),U,3)'="C":0,'X:1,(BSDATE>(X-1))&('$PIECE(X,U,2)):0,1:1)
+4 ;
LASTAPPT(D,C) ;-- get the last appointment made for that date
+1 IF '$DATA(^SC(C,"S"))
QUIT 0
+2 NEW BSDA,BSDRR,BSDLAP,BSDI
+3 SET BSDCNT=0
+4 SET BSDA=D
FOR
SET BSDA=$ORDER(^SC(C,"S",BSDA))
IF 'BSDA!(BSDA>(D+.9999))
QUIT
Begin DoDot:1
+5 SET BSDI=0
FOR
SET BSDI=$ORDER(^SC(C,"S",BSDA,1,BSDI))
IF 'BSDI
QUIT
Begin DoDot:2
+6 SET BSDLAP=$PIECE($GET(^SC(C,"S",BSDA,1,BSDI,0)),U,7)
+7 IF '$GET(BSDLAP)
QUIT
+8 SET BSDRR(BSDLAP)=""
End DoDot:2
End DoDot:1
+9 IF '$ORDER(BSDRR(""))
QUIT 0
+10 QUIT $ORDER(BSDRR(""),-1)
+11 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BSDDAM",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
+3 ;
PRINT ;EP; --prints report to paper
+1 NEW LINE
+2 USE IO
DO HDG
+3 SET LINE=0
FOR
SET LINE=$ORDER(^TMP("BSDTOD",$JOB,LINE))
IF 'LINE
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDG
+5 WRITE !,^TMP("BSDTOD",$JOB,LINE,0)
End DoDot:1
+6 DO ^%ZISC
DO EXIT
+7 QUIT
+8 ;
HDG ; -- 2nd half of heading
+1 NEW X
+2 WRITE @IOF,!!?25,"Time of Day Clinic Fills Up"
+3 DO HDR
DO MSG^BDGF(VALMHDR(1),0,1)
+4 SET X=$$PAD("Clinic",21)
+5 SET X=$$PAD(X_"Appointment Date",49)
+6 SET X=X_"Date/Time"
+7 DO MSG^BDGF(X,1,0)
DO MSG^BDGF($$REPEAT^XLFSTR("=",80),1,1)
+8 QUIT
+9 ;
+10 ;
PAD(D,L) ; -- 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 ;
PC(C) ; -- returns name of principal clinic
+1 QUIT $$PRIN^BSDU(C)
+2 ;
HELP1 ;EP; called from DIR for Detailed Display question
+1 DO MSG^BDGF("Answer YES to include totals for each date in your",2,0)
+2 DO MSG^BDGF("date range in addition to the day of week averages.",1,0)
+3 DO MSG^BDGF("Answer NO to only display day of week data.",2,1)
+4 QUIT
+5 ;
HELP2 ;EP; called by DIR for Include Individual Clinic Totals question
+1 DO MSG^BDGF("Answer YES to display data on each individual clinic",2,0)
+2 DO MSG^BDGF("as opposed to just principal clinic totals.",1,0)
+3 DO MSG^BDGF("Answer NO to only see principal clinic data.",2,1)
+4 QUIT
+5 ;
XREFC(CLIN,DATE,PAT) ;EP; -- updates AIHSDAM xref when data is hard set
+1 ; Called by SDM1A and SDMM1
+2 NEW MADE
+3 SET MADE=$PIECE($GET(^SC(CLIN,"S",DATE,1,PAT,0)),U,7)
+4 IF MADE]""
SET ^SC("AIHSDAM",CLIN,MADE,DATE,PAT)=""
+5 QUIT
+6 ;
