BSDCLDOW.m

BSDCLDOW ; IHS/ANMC/LJF - CLINIC LIST-DAY OF WEEK ;  [ 12/18/2003  2:22 PM ]

 ;;5.3;PIMS;;APR 26, 2002

 ;

START ;EP; entry from SDCLDOW

 I $E(IOST,1,2)="C-" D EN Q   ;browse

 ;IHS/ITSC/WAR 11/13/03 added New 'BDGION' variable and S BDGION=ION

 ;    to remedy queing problem with printer. See line tag PRINT

 N BDGION S BDGION=ION

 D INIT,PRINT Q              ;print on paper

 ;

EN ; -- main entry point for BSDRM DAY OF WEEK

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDRM DAY OF WEEK")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 Q

 ;

INIT ; -- init variables and list array

 K ^TMP("BSDCLDOW",$J),^TMP("BSDCLDOW1",$J)

 D GUIR^XBLM("START^SDCLDOW","^TMP(""BSDCLDOW1"",$J,")

 NEW X S X=0 F  S X=$O(^TMP("BSDCLDOW1",$J,X)) Q:'X  D

 . S VALMCNT=X

 . S ^TMP("BSDCLDOW",$J,X,0)=^TMP("BSDCLDOW1",$J,X)

 K ^TMP("BSDCLDOW1",$J)

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BSDCLDOW",$J)

 D SDCLDOW^SDKILL K VAUTC,VAUTD

 Q

 ;

EXPND ; -- expand code

 Q

 ;

PRINT ; -- print display array on paper

 ;IHS/ITSC/WAR 11/13/03 added next line - queing was not working

 S IOP=BDGION D ^%ZIS

 U IO W @IOF

 NEW X S X=0 F  S X=$O(^TMP("BSDCLDOW",$J,X)) Q:'X  D

 . I $Y>(IOSL-4) D HDG

 . W !,^TMP("BSDCLDOW",$J,X,0)

 D ^%ZISC,EXIT

 Q

 ;

HDG ; -- reprint first 10 lines of display as heading

 W @IOF

 NEW Y F Y=1:1:10 W !,^TMP("BSDCLDOW",$J,Y,0)

 Q

BSDCLDOW  ; IHS/ANMC/LJF - CLINIC LIST-DAY OF WEEK ;  [ 12/18/2003  2:22 PM ]

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

START     ;EP; entry from SDCLDOW

 +1       ;browse

           IF $EXTRACT(IOST,1,2)="C-"

               DO EN

               QUIT 

 +2       ;IHS/ITSC/WAR 11/13/03 added New 'BDGION' variable and S BDGION=ION

 +3       ;    to remedy queing problem with printer. See line tag PRINT

 +4        NEW BDGION

           SET BDGION=ION

 +5       ;print on paper

           DO INIT

           DO PRINT

           QUIT 

 +6       ;

EN        ; -- main entry point for BSDRM DAY OF WEEK

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BSDRM DAY OF WEEK")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ;

INIT      ; -- init variables and list array

 +1        KILL ^TMP("BSDCLDOW",$JOB),^TMP("BSDCLDOW1",$JOB)

 +2        DO GUIR^XBLM("START^SDCLDOW","^TMP(""BSDCLDOW1"",$J,")

 +3        NEW X

           SET X=0

           FOR 

               SET X=$ORDER(^TMP("BSDCLDOW1",$JOB,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +4                SET VALMCNT=X

 +5                SET ^TMP("BSDCLDOW",$JOB,X,0)=^TMP("BSDCLDOW1",$JOB,X)

               End DoDot:1

 +6        KILL ^TMP("BSDCLDOW1",$JOB)

 +7        QUIT 

 +8       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

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

 +2        DO SDCLDOW^SDKILL

           KILL VAUTC,VAUTD

 +3        QUIT 

 +4       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

PRINT     ; -- print display array on paper

 +1       ;IHS/ITSC/WAR 11/13/03 added next line - queing was not working

 +2        SET IOP=BDGION

           DO ^%ZIS

 +3        USE IO

           WRITE @IOF

 +4        NEW X

           SET X=0

           FOR 

               SET X=$ORDER(^TMP("BSDCLDOW",$JOB,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +5                IF $Y>(IOSL-4)

                       DO HDG

 +6                WRITE !,^TMP("BSDCLDOW",$JOB,X,0)

               End DoDot:1

 +7        DO ^%ZISC

           DO EXIT

 +8        QUIT 

 +9       ;

HDG       ; -- reprint first 10 lines of display as heading

 +1        WRITE @IOF

 +2        NEW Y

           FOR Y=1:1:10

               WRITE !,^TMP("BSDCLDOW",$JOB,Y,0)

 +3        QUIT