- 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
