BSDALS.m

BSDALS ; IHS/ANMC/LJF - SHORT APPT LIST - LT CODE ; 

 ;;5.3;PIMS;**1005**;MAY 28, 2004

 ;IHS/OIT/LJF 02/02/2006 PATCH 1005 screened out cancelled appointments

 ;

EN(SC,BSDATE) ;EP; -- main entry point for appt list list template

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDAM APPT LIST SHORT")

 D CLEAR^VALM1

 Q

 ;

HDR ;EP; -- header code

 S VALMHDR(1)=$$REPEAT^XLFSTR(" ",12)_$$CONF^BDGF

 NEW X S X=$$SP(15)_"Other Appts Already Scheduled for "

 S VALMHDR(2)=X_$$FMTE^XLFDT(BSDATE,5)

 Q

 ;

INIT ;EP; -- init variables and list array

 K ^TMP("BSDALS",$J) S VALMCNT=0

 NEW APDT,PAT,NODE,END,LINE

 S END=BSDATE+.2400,APDT=BSDATE-.0001

 F  S APDT=$O(^SC(SC,"S",APDT)) Q:'APDT!(APDT>END)  D

 . S PAT=0 F  S PAT=$O(^SC(SC,"S",APDT,1,PAT)) Q:'PAT  D

 .. S NODE=$G(^SC(SC,"S",APDT,1,PAT,0)) Q:NODE=""

 .. Q:$P(NODE,U,9)="C"                           ;cancelled ;IHS/OIT/LJF 02/03/2006 PATCH 1005

 .. S LINE="  "_$P($$FMTE^XLFDT(APDT),"@",2)     ;appt time

 .. S LINE=$$PAD(LINE,10)_$P(NODE,U,2)_" min"    ;appt length

 .. S LINE=$$PAD(LINE,20)_$E($P(NODE,U,4),1,59)  ;appt comments

 .. I $$WALKIN^BSDU2(+NODE,APDT) S LINE=$$PAD(LINE,20)_"Walk-in"

 .. S VALMCNT=VALMCNT+1

 .. S ^TMP("BSDALS",$J,VALMCNT,0)=LINE

 I VALMCNT=0 S ^TMP("BSDALS",$J,1,0)="No Appointments Scheduled",VALMCNT=1

 Q

 ;

HELP ;EP; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ;EP; -- exit code

 K ^TMP("BSDALS",$J)

 S VALMNOFF=1  ;suppress form feed before next question

 Q

 ;

EXPND ;EP; -- expand code

 Q

 ;

PAUSE ; -- end of action pause

 D PAUSE^BDGF Q

 ;

RESET ; -- update partition for return to list manager

 I $D(VALMQUIT) S VALMBCK="Q" Q

 D TERM^VALM0 S VALMBCK="R"

 D INIT,HDR Q

 ;

RESET2 ; -- update partition without recreating display array

 I $D(VALMQUIT) S VALMBCK="Q" Q

 D TERM^VALM0 S VALMBCK="R" D HDR 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)

BSDALS    ; IHS/ANMC/LJF - SHORT APPT LIST - LT CODE ; 

 +1       ;;5.3;PIMS;**1005**;MAY 28, 2004

 +2       ;IHS/OIT/LJF 02/02/2006 PATCH 1005 screened out cancelled appointments

 +3       ;

EN(SC,BSDATE) ;EP; -- main entry point for appt list list template

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BSDAM APPT LIST SHORT")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ;EP; -- header code

 +1        SET VALMHDR(1)=$$REPEAT^XLFSTR(" ",12)_$$CONF^BDGF

 +2        NEW X

           SET X=$$SP(15)_"Other Appts Already Scheduled for "

 +3        SET VALMHDR(2)=X_$$FMTE^XLFDT(BSDATE,5)

 +4        QUIT 

 +5       ;

INIT      ;EP; -- init variables and list array

 +1        KILL ^TMP("BSDALS",$JOB)

           SET VALMCNT=0

 +2        NEW APDT,PAT,NODE,END,LINE

 +3        SET END=BSDATE+.2400

           SET APDT=BSDATE-.0001

 +4        FOR 

               SET APDT=$ORDER(^SC(SC,"S",APDT))

               IF 'APDT!(APDT>END)

                   QUIT 

               Begin DoDot:1

 +5                SET PAT=0

                   FOR 

                       SET PAT=$ORDER(^SC(SC,"S",APDT,1,PAT))

                       IF 'PAT

                           QUIT 

                       Begin DoDot:2

 +6                        SET NODE=$GET(^SC(SC,"S",APDT,1,PAT,0))

                           IF NODE=""

                               QUIT 

 +7       ;cancelled ;IHS/OIT/LJF 02/03/2006 PATCH 1005

                           IF $PIECE(NODE,U,9)="C"

                               QUIT 

 +8       ;appt time

                           SET LINE="  "_$PIECE($$FMTE^XLFDT(APDT),"@",2)

 +9       ;appt length

                           SET LINE=$$PAD(LINE,10)_$PIECE(NODE,U,2)_" min"

 +10      ;appt comments

                           SET LINE=$$PAD(LINE,20)_$EXTRACT($PIECE(NODE,U,4),1,59)

 +11                       IF $$WALKIN^BSDU2(+NODE,APDT)

                               SET LINE=$$PAD(LINE,20)_"Walk-in"

 +12                       SET VALMCNT=VALMCNT+1

 +13                       SET ^TMP("BSDALS",$JOB,VALMCNT,0)=LINE

                       End DoDot:2

               End DoDot:1

 +14       IF VALMCNT=0

               SET ^TMP("BSDALS",$JOB,1,0)="No Appointments Scheduled"

               SET VALMCNT=1

 +15       QUIT 

 +16      ;

HELP      ;EP; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ;EP; -- exit code

 +1        KILL ^TMP("BSDALS",$JOB)

 +2       ;suppress form feed before next question

           SET VALMNOFF=1

 +3        QUIT 

 +4       ;

EXPND     ;EP; -- expand code

 +1        QUIT 

 +2       ;

PAUSE     ; -- end of action pause

 +1        DO PAUSE^BDGF

           QUIT 

 +2       ;

RESET     ; -- update partition for return to list manager

 +1        IF $DATA(VALMQUIT)

               SET VALMBCK="Q"

               QUIT 

 +2        DO TERM^VALM0

           SET VALMBCK="R"

 +3        DO INIT

           DO HDR

           QUIT 

 +4       ;

RESET2    ; -- update partition without recreating display array

 +1        IF $DATA(VALMQUIT)

               SET VALMBCK="Q"

               QUIT 

 +2        DO TERM^VALM0

           SET VALMBCK="R"

           DO HDR

           QUIT 

 +3       ;

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)