BSDNAA.m

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)