BSDNAA ; IHS/ANMC/LJF - NUM AVAIL APPT REPORT ; [ 02/10/2005 3:59 PM ]
;;5.3;PIMS;**1002**;APR 26, 2002
;
ASK ; -- ask user for clinics and device
NEW VAUTC,VAUTD,BSDNUM,X,POP,BSDATE
S X="Enter date to start 14 day range for viewing available appts."
S BSDATE=$$READ^BDGF("DO^::EX","Starting Date","TODAY",X) Q:BSDATE<1
D CLINIC^BSDU(2) Q:$D(BSDQ)
S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
;IHS/ITSC/WAR 1/10/05 PATCH #1002 Added VALMHDR* variable for printing
;D ZIS^BDGF("PQ","START^BSDNAA","NUM AVAIL APPT","BSDATE;VAUTC*;VAUTD*")
D ZIS^BDGF("PQ","START^BSDNAA","NUM AVAIL APPT","BSDATE;VAUTC*;VAUTD*;VALMHDR*")
Q
;
START ;EP; -- re-entry for printing to paper
D INIT,PRINT Q
;
EN ; -- main entry point for BSDRM NUM AVAIL APPT
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDRM NUM AVAIL APPT")
D EXIT,CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(20)_"NUMBER OF APPTS AVAILABLE BY CLINIC AND DATE"
S VALMHDR(2)=$$SP(25)_$$RANGE^BDGF(BSDATE,$$FMADD^XLFDT(BSDATE,13))
S VALMCAP=$$DAYS ;column headings
Q
;
INIT ; -- loop thru clinics selected and build display array
S VALMCNT=0 K ^TMP("BSDNAA",$J),^TMP("BSDNAA1",$J)
NEW ARRAY S ARRAY=$S(VAUTC:"^SC",1:"VAUTC")
;
; loop thru selected clinics and put in principal clinic order
NEW CLINIC,PC,ABBR
S CLINIC=0
F S CLINIC=$O(@ARRAY@(CLINIC)) Q:'CLINIC D
. Q:'$$OKAY(CLINIC) ;quit if inactive or no schedule
. 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:ABBR="" ABBR="??"_CLINIC
. S ^TMP("BSDNAA1",$J,PC,ABBR,CLINIC)="" ;put in pc/clinic order
;
; loop thru sorted list and count available appts
NEW PC,ABBR,CLINIC,LINE,DATE,SCHED,COUNT,END
S PC=0 F S PC=$O(^TMP("BSDNAA1",$J,PC)) Q:PC="" D
. D SET("Principal Clinic: "_PC,.VALMCNT)
. S ABBR=0 F S ABBR=$O(^TMP("BSDNAA1",$J,PC,ABBR)) Q:ABBR="" D
.. S CLINIC=0
.. F S CLINIC=$O(^TMP("BSDNAA1",$J,PC,ABBR,CLINIC)) Q:'CLINIC D
... S LINE=$$PAD(ABBR,8)_"|" ;begin line for display array
... ;
... ; now loop thru date range, count and put in display array
... S DATE=BSDATE-1,END=$$FMADD^XLFDT(BSDATE,13)
... F S DATE=$$FMADD^XLFDT(DATE,1) Q:DATE>END D
.... S SCHED=$G(^SC(CLINIC,"ST",DATE,1))
.... I SCHED="" S LINE=LINE_" 0 |" Q
.... S COUNT=$$COUNT(SCHED),LINE=LINE_$J(COUNT,3)_" |"
... D SET(LINE,.VALMCNT) ;add clinic's line to display array
;
K ^TMP("BSDNAA1",$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("BSDNAA",$J,NUM,0)=LINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BSDNAA",$J)
Q
;
EXPND ; -- expand code
Q
;
;
PRINT ; -- loop thru ^tmp and print
;IHS/ITSC/WAR 1/10/2005 PATCH 1002 Added next line for printing
U IO D HDR
NEW X,VALMHDR,BSDPG,BSDAYS
S BSDAYS=$$DAYS D HED
S X=0 F S X=$O(^TMP("BSDNAA",$J,X)) Q:'X D
. I $Y>(IOSL-4) D HED
. W !,^TMP("BSDNAA",$J,X,0)
D ^%ZISC,EXIT
Q
;
;
HED ; -- heading
;IHS/ITSC/WAR 1/10/2005 PATCH 1002 - split command for form feed.
;W @IOF S BSDPG=$G(BSDPG)+1
I +$G(BSDPG)>0 W @IOF
S BSDPG=$G(BSDPG)+1
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I) W:I=1 ?70,"Page ",BSDPG
W !,BSDAYS,!,$$REPEAT^XLFSTR("=",80)
Q
;
DAYS() ; -- creates array of date range
NEW X,DAYS,Y,END
S DAYS(BSDATE)="",X=BSDATE,END=$$FMADD^XLFDT(BSDATE,13)
F S X=$$FMADD^XLFDT(X,1) Q:X>END S DAYS(X)=""
S Y=$$SP(8)_"| "
S X=0 F S X=$O(DAYS(X)) Q:X="" S Y=Y_$E(X,6,7)_" | "
Q $G(Y)
;
OKAY(C) ; -- 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)
;
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)
BSDNAA ; IHS/ANMC/LJF - NUM AVAIL APPT REPORT ; [ 02/10/2005 3:59 PM ]
+1 ;;5.3;PIMS;**1002**;APR 26, 2002
+2 ;
ASK ; -- ask user for clinics and device
+1 NEW VAUTC,VAUTD,BSDNUM,X,POP,BSDATE
+2 SET X="Enter date to start 14 day range for viewing available appts."
+3 SET BSDATE=$$READ^BDGF("DO^::EX","Starting Date","TODAY",X)
IF BSDATE<1
QUIT
+4 DO CLINIC^BSDU(2)
IF $DATA(BSDQ)
QUIT
+5 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+6 ;IHS/ITSC/WAR 1/10/05 PATCH #1002 Added VALMHDR* variable for printing
+7 ;D ZIS^BDGF("PQ","START^BSDNAA","NUM AVAIL APPT","BSDATE;VAUTC*;VAUTD*")
+8 DO ZIS^BDGF("PQ","START^BSDNAA","NUM AVAIL APPT","BSDATE;VAUTC*;VAUTD*;VALMHDR*")
+9 QUIT
+10 ;
START ;EP; -- re-entry for printing to paper
+1 DO INIT
DO PRINT
QUIT
+2 ;
EN ; -- main entry point for BSDRM NUM AVAIL APPT
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BSDRM NUM AVAIL APPT")
+3 DO EXIT
DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(20)_"NUMBER OF APPTS AVAILABLE BY CLINIC AND DATE"
+2 SET VALMHDR(2)=$$SP(25)_$$RANGE^BDGF(BSDATE,$$FMADD^XLFDT(BSDATE,13))
+3 ;column headings
SET VALMCAP=$$DAYS
+4 QUIT
+5 ;
INIT ; -- loop thru clinics selected and build display array
+1 SET VALMCNT=0
KILL ^TMP("BSDNAA",$JOB),^TMP("BSDNAA1",$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
+6 SET CLINIC=0
+7 FOR
SET CLINIC=$ORDER(@ARRAY@(CLINIC))
IF 'CLINIC
QUIT
Begin DoDot:1
+8 ;quit if inactive or no schedule
IF '$$OKAY(CLINIC)
QUIT
+9 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLINIC))
QUIT
+10 ;get princ clinic name
SET PC=$$PRIN^BSDU(CLINIC)
+11 ;clinic's abbreviation
SET ABBR=$$GET1^DIQ(44,CLINIC,1)
+12 IF ABBR=""
SET ABBR="??"_CLINIC
+13 ;put in pc/clinic order
SET ^TMP("BSDNAA1",$JOB,PC,ABBR,CLINIC)=""
End DoDot:1
+14 ;
+15 ; loop thru sorted list and count available appts
+16 NEW PC,ABBR,CLINIC,LINE,DATE,SCHED,COUNT,END
+17 SET PC=0
FOR
SET PC=$ORDER(^TMP("BSDNAA1",$JOB,PC))
IF PC=""
QUIT
Begin DoDot:1
+18 DO SET("Principal Clinic: "_PC,.VALMCNT)
+19 SET ABBR=0
FOR
SET ABBR=$ORDER(^TMP("BSDNAA1",$JOB,PC,ABBR))
IF ABBR=""
QUIT
Begin DoDot:2
+20 SET CLINIC=0
+21 FOR
SET CLINIC=$ORDER(^TMP("BSDNAA1",$JOB,PC,ABBR,CLINIC))
IF 'CLINIC
QUIT
Begin DoDot:3
+22 ;begin line for display array
SET LINE=$$PAD(ABBR,8)_"|"
+23 ;
+24 ; now loop thru date range, count and put in display array
+25 SET DATE=BSDATE-1
SET END=$$FMADD^XLFDT(BSDATE,13)
+26 FOR
SET DATE=$$FMADD^XLFDT(DATE,1)
IF DATE>END
QUIT
Begin DoDot:4
+27 SET SCHED=$GET(^SC(CLINIC,"ST",DATE,1))
+28 IF SCHED=""
SET LINE=LINE_" 0 |"
QUIT
+29 SET COUNT=$$COUNT(SCHED)
SET LINE=LINE_$JUSTIFY(COUNT,3)_" |"
End DoDot:4
+30 ;add clinic's line to display array
DO SET(LINE,.VALMCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 KILL ^TMP("BSDNAA1",$JOB)
+33 QUIT
+34 ;
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("BSDNAA",$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("BSDNAA",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
+3 ;
PRINT ; -- loop thru ^tmp and print
+1 ;IHS/ITSC/WAR 1/10/2005 PATCH 1002 Added next line for printing
+2 USE IO
DO HDR
+3 NEW X,VALMHDR,BSDPG,BSDAYS
+4 SET BSDAYS=$$DAYS
DO HED
+5 SET X=0
FOR
SET X=$ORDER(^TMP("BSDNAA",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-4)
DO HED
+7 WRITE !,^TMP("BSDNAA",$JOB,X,0)
End DoDot:1
+8 DO ^%ZISC
DO EXIT
+9 QUIT
+10 ;
+11 ;
HED ; -- heading
+1 ;IHS/ITSC/WAR 1/10/2005 PATCH 1002 - split command for form feed.
+2 ;W @IOF S BSDPG=$G(BSDPG)+1
+3 IF +$GET(BSDPG)>0
WRITE @IOF
+4 SET BSDPG=$GET(BSDPG)+1
+5 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
IF I=1
WRITE ?70,"Page ",BSDPG
+6 WRITE !,BSDAYS,!,$$REPEAT^XLFSTR("=",80)
+7 QUIT
+8 ;
DAYS() ; -- creates array of date range
+1 NEW X,DAYS,Y,END
+2 SET DAYS(BSDATE)=""
SET X=BSDATE
SET END=$$FMADD^XLFDT(BSDATE,13)
+3 FOR
SET X=$$FMADD^XLFDT(X,1)
IF X>END
QUIT
SET DAYS(X)=""
+4 SET Y=$$SP(8)_"| "
+5 SET X=0
FOR
SET X=$ORDER(DAYS(X))
IF X=""
QUIT
SET Y=Y_$EXTRACT(X,6,7)_" | "
+6 QUIT $GET(Y)
+7 ;
OKAY(C) ; -- 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 ;
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)
