KMPDU11 ;OAK/RAK - CM Tools Text Display Utility ;2/17/04 09:50
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
WP(KMPUAR,KMPUTM,KMPUBM,KMPULM,KMPURM,KMPUNW,KMPUXIT) ;-- word processing display.
;--------------------------------------------------------------------
; KMPUAR... Array containing word processing text.
; Example: ^KMPUTMP(1001,1,0)="This is the"
; ^KMPUTMP(1001,2,0)="text to display."
;
; Optional parameters:
;
; KMPUTM.. Top margin of screen area.
; KMPUBM.. Bottom margin of screen area.
; KMPULM.. Left margin.
; KMPURM.. Right margin.
; KMPUNW.. Nowrap:
; 0 - nowrap (print as entered)
; 1 - wrap
; KMPUXIT. Exit without 'continue' text. This allows the programmer
; to use their own display for continuing
; 0 - do not exit - display 'continue' text
; 1 - exit
;
; If more than one page this routine allows the user to scroll back
; and forth between pages. If KMPUTM and KMPUBM are not passed will
; default to full screen (0 to 22).
;--------------------------------------------------------------------
;
Q:'$D(KMPUAR)
;
N CLRSCR,I,KMPUI,KMPUOUT,LEN,LINES,PAGE,PAGES
N DIR,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,X,Y,Z
N IOBM,IOECH,IOELALL,IOELEOL,IORVON,IORVOFF,IOTM,IOSTBM
;
S KMPUXIT=+$G(KMPUXIT)
S KMPUTM=+$G(KMPUTM),KMPUBM=$S(+$G(KMPUBM):KMPUBM,1:22)
S KMPULM=+$G(KMPULM),KMPURM=+$G(KMPURM),KMPUNW=+$G(KMPUNW)
S:KMPUBM>22 KMPUBM=22 S DIWL=KMPULM,DIWR=$S(KMPURM:KMPURM,1:IOM)
S KMPUNW=$S(KMPUNW=1:"",1:"N")
S X="IOECH;IOELALL;IOELEOL;IORVON;IORVOFF;IOSTKMPUBM" D ENDR^%ZISS
; set CLRSCR (clear screen)
; clear full screen
I DIWL=0,(DIWR=IOM) D
.S CLRSCR="F DY=(KMPUBM-1):-1:KMPUTM X IOXY W IOELALL,!"
; clear left margin to end of screen
E I DIWR=IOM D
.S CLRSCR="S DX=DIWL F DY=(KMPUBM-1):-1:KMPUTM X IOXY W IOELEOL,!"
; clear left margin to right margin
E S CLRSCR="F DY=(KMPUBM-1):-1:KMPUTM F DX=DIWL:1:DIWR X IOXY W IOECH"
K ^UTILITY($J,"W") S DIWF=KMPUNW,X=""
; use fileman to format text
F KMPUI=0:0 S KMPUI=$O(@KMPUAR@(KMPUI)) Q:'KMPUI D
.Q:'$D(@KMPUAR@(KMPUI,0)) S X=@KMPUAR@(KMPUI,0) D ^DIWP
Q:'$D(^UTILITY($J,"W",DIWL)) S LINES=$G(^(DIWL))
; check for last line equal to null
I $G(^UTILITY($J,"W",DIWL,LINES,0))="" S LINES=LINES-1
S LEN=KMPUBM-KMPUTM,PAGES=LINES\LEN I LINES#LEN S PAGES=PAGES+1
;
; set up the pages() array - first piece = starting line
; second piece = ending line
F I=1:1:PAGES D
.S PAGES(I)=$S(I=1:1,1:(I*LEN-LEN+1))
.I I=1 S $P(PAGES(I),U,2)=$S(LINES<LEN:LINES,1:LEN) Q
.S $P(PAGES(I),U,2)=(I*LEN)
S DY=(KMPUTM-1),PAGE=1,KMPUOUT=0
; main loop
F D Q:KMPUOUT
.F KMPUI=$P(PAGES(PAGE),U):1:$P(PAGES(PAGE),U,2) D
..Q:'$D(^UTILITY($J,"W",DIWL,KMPUI,0))
..S DX=DIWL,DY=DY+1 X IOXY W ^UTILITY($J,"W",DIWL,KMPUI,0),!
.I 'KMPUXIT D FTR X CLRSCR Q:KMPUOUT S DY=DY-1
.E S KMPUOUT=1
F DY=22,23 X IOXY W IOELALL
K ^UTILITY($J,"W")
Q
;
FTR ;-- footer designed for wp subroutine above.
N READ,READX S READ=""
S DX=0,DY=22 X IOXY W $$REPEAT^XLFSTR("_",IOM)
I PAGES=1 S READ="X",READ("A")=$J(" ",28)_"Press <RET> to continue"
I PAGES>1 S READ="X",READ("A")="E[x]it" D
.I PAGE<PAGES S READ=READ_"N",READ("A")=READ("A")_", [N]ext Screen"
.I PAGE>1 S READ=READ_"P",READ("A")=READ("A")_", [P]revious Screen"
S READ("A")=READ("A")_": "
FTR1 ;-- read
S DX=0,DY=23 X IOXY W IOELALL
S DX=62 X IOXY W " Page ",PAGE," of ",PAGES," "
S DX=0 X IOXY W READ("A")
R READX:DTIME S READX=$$UP^XLFSTR(READX)
I READX="X"!(READX="^")!(READ="X") S KMPUOUT=1 Q
I READX="N",(READ["N") S PAGE=PAGE+1 Q
I READX="P",(READ["P") S PAGE=PAGE-1 Q
I READX["?" D HELP G FTR1
W *7
G FTR1
;
HELP ;-- clear screen, print help text, repaint screen.
N I,READX X CLRSCR S DY=KMPUTM,DX=$S(DIWL>7:DIWL,1:7) X IOXY
F I=1:1:$L(READ) S DY=DY+1 X IOXY D
.I $E(READ,I)="X" W "Enter 'X' (or '^') to exit.",!
.I $E(READ,I)="N" W "Enter 'N' to advance to the next screen.",!
.I $E(READ,I)="P" W "Enter 'P' to backup to the previous screen.",!
S DY=(KMPUBM-1) X IOXY R "Press <RET> to continue: ",READX:DTIME
; repaint screen.
X CLRSCR S DY=(KMPUTM-1)
F I=$P(PAGES(PAGE),U):1:$P(PAGES(PAGE),U,2) D
.Q:'$D(^UTILITY($J,"W",DIWL,I,0))
.S DX=DIWL,DY=DY+1 X IOXY W ^UTILITY($J,"W",DIWL,I,0),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDU11 4412 printed Apr 09, 2024@20:46:13 Page 2
KMPDU11 ;OAK/RAK - CM Tools Text Display Utility ;2/17/04 09:50
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
WP(KMPUAR,KMPUTM,KMPUBM,KMPULM,KMPURM,KMPUNW,KMPUXIT) ;-- word processing display.
+1 ;--------------------------------------------------------------------
+2 ; KMPUAR... Array containing word processing text.
+3 ; Example: ^KMPUTMP(1001,1,0)="This is the"
+4 ; ^KMPUTMP(1001,2,0)="text to display."
+5 ;
+6 ; Optional parameters:
+7 ;
+8 ; KMPUTM.. Top margin of screen area.
+9 ; KMPUBM.. Bottom margin of screen area.
+10 ; KMPULM.. Left margin.
+11 ; KMPURM.. Right margin.
+12 ; KMPUNW.. Nowrap:
+13 ; 0 - nowrap (print as entered)
+14 ; 1 - wrap
+15 ; KMPUXIT. Exit without 'continue' text. This allows the programmer
+16 ; to use their own display for continuing
+17 ; 0 - do not exit - display 'continue' text
+18 ; 1 - exit
+19 ;
+20 ; If more than one page this routine allows the user to scroll back
+21 ; and forth between pages. If KMPUTM and KMPUBM are not passed will
+22 ; default to full screen (0 to 22).
+23 ;--------------------------------------------------------------------
+24 ;
+25 if '$DATA(KMPUAR)
QUIT
+26 ;
+27 NEW CLRSCR,I,KMPUI,KMPUOUT,LEN,LINES,PAGE,PAGES
+28 NEW DIR,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,X,Y,Z
+29 NEW IOBM,IOECH,IOELALL,IOELEOL,IORVON,IORVOFF,IOTM,IOSTBM
+30 ;
+31 SET KMPUXIT=+$GET(KMPUXIT)
+32 SET KMPUTM=+$GET(KMPUTM)
SET KMPUBM=$SELECT(+$GET(KMPUBM):KMPUBM,1:22)
+33 SET KMPULM=+$GET(KMPULM)
SET KMPURM=+$GET(KMPURM)
SET KMPUNW=+$GET(KMPUNW)
+34 if KMPUBM>22
SET KMPUBM=22
SET DIWL=KMPULM
SET DIWR=$SELECT(KMPURM:KMPURM,1:IOM)
+35 SET KMPUNW=$SELECT(KMPUNW=1:"",1:"N")
+36 SET X="IOECH;IOELALL;IOELEOL;IORVON;IORVOFF;IOSTKMPUBM"
DO ENDR^%ZISS
+37 ; set CLRSCR (clear screen)
+38 ; clear full screen
+39 IF DIWL=0
IF (DIWR=IOM)
Begin DoDot:1
+40 SET CLRSCR="F DY=(KMPUBM-1):-1:KMPUTM X IOXY W IOELALL,!"
End DoDot:1
+41 ; clear left margin to end of screen
+42 IF '$TEST
IF DIWR=IOM
Begin DoDot:1
+43 SET CLRSCR="S DX=DIWL F DY=(KMPUBM-1):-1:KMPUTM X IOXY W IOELEOL,!"
End DoDot:1
+44 ; clear left margin to right margin
+45 IF '$TEST
SET CLRSCR="F DY=(KMPUBM-1):-1:KMPUTM F DX=DIWL:1:DIWR X IOXY W IOECH"
+46 KILL ^UTILITY($JOB,"W")
SET DIWF=KMPUNW
SET X=""
+47 ; use fileman to format text
+48 FOR KMPUI=0:0
SET KMPUI=$ORDER(@KMPUAR@(KMPUI))
if 'KMPUI
QUIT
Begin DoDot:1
+49 if '$DATA(@KMPUAR@(KMPUI,0))
QUIT
SET X=@KMPUAR@(KMPUI,0)
DO ^DIWP
End DoDot:1
+50 if '$DATA(^UTILITY($JOB,"W",DIWL))
QUIT
SET LINES=$GET(^(DIWL))
+51 ; check for last line equal to null
+52 IF $GET(^UTILITY($JOB,"W",DIWL,LINES,0))=""
SET LINES=LINES-1
+53 SET LEN=KMPUBM-KMPUTM
SET PAGES=LINES\LEN
IF LINES#LEN
SET PAGES=PAGES+1
+54 ;
+55 ; set up the pages() array - first piece = starting line
+56 ; second piece = ending line
+57 FOR I=1:1:PAGES
Begin DoDot:1
+58 SET PAGES(I)=$SELECT(I=1:1,1:(I*LEN-LEN+1))
+59 IF I=1
SET $PIECE(PAGES(I),U,2)=$SELECT(LINES<LEN:LINES,1:LEN)
QUIT
+60 SET $PIECE(PAGES(I),U,2)=(I*LEN)
End DoDot:1
+61 SET DY=(KMPUTM-1)
SET PAGE=1
SET KMPUOUT=0
+62 ; main loop
+63 FOR
Begin DoDot:1
+64 FOR KMPUI=$PIECE(PAGES(PAGE),U):1:$PIECE(PAGES(PAGE),U,2)
Begin DoDot:2
+65 if '$DATA(^UTILITY($JOB,"W",DIWL,KMPUI,0))
QUIT
+66 SET DX=DIWL
SET DY=DY+1
XECUTE IOXY
WRITE ^UTILITY($JOB,"W",DIWL,KMPUI,0),!
End DoDot:2
+67 IF 'KMPUXIT
DO FTR
XECUTE CLRSCR
if KMPUOUT
QUIT
SET DY=DY-1
+68 IF '$TEST
SET KMPUOUT=1
End DoDot:1
if KMPUOUT
QUIT
+69 FOR DY=22,23
XECUTE IOXY
WRITE IOELALL
+70 KILL ^UTILITY($JOB,"W")
+71 QUIT
+72 ;
FTR ;-- footer designed for wp subroutine above.
+1 NEW READ,READX
SET READ=""
+2 SET DX=0
SET DY=22
XECUTE IOXY
WRITE $$REPEAT^XLFSTR("_",IOM)
+3 IF PAGES=1
SET READ="X"
SET READ("A")=$JUSTIFY(" ",28)_"Press <RET> to continue"
+4 IF PAGES>1
SET READ="X"
SET READ("A")="E[x]it"
Begin DoDot:1
+5 IF PAGE<PAGES
SET READ=READ_"N"
SET READ("A")=READ("A")_", [N]ext Screen"
+6 IF PAGE>1
SET READ=READ_"P"
SET READ("A")=READ("A")_", [P]revious Screen"
End DoDot:1
+7 SET READ("A")=READ("A")_": "
FTR1 ;-- read
+1 SET DX=0
SET DY=23
XECUTE IOXY
WRITE IOELALL
+2 SET DX=62
XECUTE IOXY
WRITE " Page ",PAGE," of ",PAGES," "
+3 SET DX=0
XECUTE IOXY
WRITE READ("A")
+4 READ READX:DTIME
SET READX=$$UP^XLFSTR(READX)
+5 IF READX="X"!(READX="^")!(READ="X")
SET KMPUOUT=1
QUIT
+6 IF READX="N"
IF (READ["N")
SET PAGE=PAGE+1
QUIT
+7 IF READX="P"
IF (READ["P")
SET PAGE=PAGE-1
QUIT
+8 IF READX["?"
DO HELP
GOTO FTR1
+9 WRITE *7
+10 GOTO FTR1
+11 ;
HELP ;-- clear screen, print help text, repaint screen.
+1 NEW I,READX
XECUTE CLRSCR
SET DY=KMPUTM
SET DX=$SELECT(DIWL>7:DIWL,1:7)
XECUTE IOXY
+2 FOR I=1:1:$LENGTH(READ)
SET DY=DY+1
XECUTE IOXY
Begin DoDot:1
+3 IF $EXTRACT(READ,I)="X"
WRITE "Enter 'X' (or '^') to exit.",!
+4 IF $EXTRACT(READ,I)="N"
WRITE "Enter 'N' to advance to the next screen.",!
+5 IF $EXTRACT(READ,I)="P"
WRITE "Enter 'P' to backup to the previous screen.",!
End DoDot:1
+6 SET DY=(KMPUBM-1)
XECUTE IOXY
READ "Press <RET> to continue: ",READX:DTIME
+7 ; repaint screen.
+8 XECUTE CLRSCR
SET DY=(KMPUTM-1)
+9 FOR I=$PIECE(PAGES(PAGE),U):1:$PIECE(PAGES(PAGE),U,2)
Begin DoDot:1
+10 if '$DATA(^UTILITY($JOB,"W",DIWL,I,0))
QUIT
+11 SET DX=DIWL
SET DY=DY+1
XECUTE IOXY
WRITE ^UTILITY($JOB,"W",DIWL,I,0),!
End DoDot:1
+12 QUIT
