KMPDUT5 ;OAK/RAK - CM Tools Utility Text Display ;2/17/04 10:49
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
DISPLAY(KMPDARRY,KMPDMRGN,KMPDNW,KMPDCLR,KMPDBX) ;display text
;-------------------------------------------------------------------
; If there is more than one page (screen) of text this api
; allows the user to scroll back and forth between pages
;
; KMPDARRY - global or local array that contains word processing text
; example: "^ASKV(673700,12,11,"
; "TMP($J)"
;
; the following is an example of how the array might be set
; up:
; KMPDARRY($J,0)=number of lines
; KMPDARRY($J,1,0)=text to display
; KMPDARRY($J,2,0)=text to display
; KMPDARRY($J,3,0)=text to display
; KMPDARRY($J...
;
;
; KMPDARRY must not be ^UTILITY($J,"W") - this routine uses
; fileman to format text, therefore ^UTILITY($J,"W") is
; used and then killed when routine complete
;
; optional parameters
;
; KMPDMRGN - margins for display of text in 4 up-arrow pieces
; TM - top margin of screen area...... piece 1
; BM - bottom margin of screen area... piece 2
; LM - left margin.................... piece 3
; RM - right margin................... piece 4
; *** NOTE ***
; if TM and BM are not passed the display will default to
; full screen (0 to 22)
;
; KMPDNW - nowrap 0 - nowrap (display as entered)
; 1 - wrap
;
; KMPDCLR - clear screen when exiting
; 0 - clear screen
; 1 - do not clear screen
;
; KMPDBX - this variable is in 2 up-arrow pieces
; piece 1: 0 - do not draw a box (or window) around text
; 1 - draw box
; piece 2: header (if any) for box
;
; other variables
;
; FT - top margin for footer
; FB - bottom margin for footer
; LENGTH - length of text to display (RM-LM)
; OS - operating system
;--------------------------------------------------------------------
;
Q:'$D(KMPDARRY)
;
S KMPDMRGN=$G(KMPDMRGN),KMPDNW=+$G(KMPDNW)
S KMPDCLR=+$G(KMPDCLR),KMPDBX=$G(KMPDBX)
; place array in correct format
I $E(KMPDARRY,$L(KMPDARRY))="," S $E(KMPDARRY,$L(KMPDARRY))=")"
I $E(KMPDARRY,$L(KMPDARRY))'=")" S KMPDARRY=KMPDARRY_")"
I $E(KMPDARRY)'="^" I $E(KMPDARRY,$L(KMPDARRY)-1,$L(KMPDARRY))="()" D
.S KMPDARRY=$E(KMPDARRY,1,$L(KMPDARRY)-2)
;
N ASKI,KMPDOUT,BM,CLRSCR,FB,FT,I,LEN,LENGTH,LINES,LM,OS,PAGE,PAGES,RM,TM
N DIR,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DX,DY,X,Y,Z
N IOBM,IOECH,IOELALL,IOELEOL,IORVON,IORVOFF,IOTM,IOSTBM
;
; set up special terminal variables
S X="IOECH;IOELALL;IOELEOL;IORVON;IORVOFF;IOSTBM" D ENDR^%ZISS
S OS=$G(^%ZOSF("OS"))
S TM=+$P(KMPDMRGN,U),LM=+$P(KMPDMRGN,U,3),RM=+$P(KMPDMRGN,U,4)
S BM=+$P(KMPDMRGN,U,2) S:'BM!(BM>22) BM=$S(OS["MSM":22,1:23)
S:'RM RM=IOM S FB=BM,FT=(FB-1),BM=(FB-2),LENGTH=(RM-LM)
S DIWL=LM,DIWR=$S(RM:RM,1:IOM),KMPDNW=$S(KMPDNW=1:"",1:"N")
; if full screen
I LM=0,(RM=IOM) S CLRSCR="F DY=BM:-1:TM X IOXY W IOELALL,!"
; else partial screen
E S CLRSCR="S DX=LM F DY=BM:-1:TM X IOXY W $J("" "",LENGTH)"
;
D LOOP
;
K ^UTILITY($J,"W")
;
Q
;
LOOP ;-- main loop
;
; use fileman to format text
K ^UTILITY($J,"W") S DIWF=KMPDNW,X=""
F I=0:0 S I=$O(@KMPDARRY@(I)) Q:'I D
.Q:'$D(@KMPDARRY@(I,0)) S X=@KMPDARRY@(I,0)
.I KMPDNW="N" S X=$E(X,1,LENGTH)
.D ^DIWP
; quit if no data to display
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=BM-TM+1,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)
;
; if KMPDBX draw box around text
;I KMPDBX D KMPDBX^KMPDUTxxx((TM-1),(LM-1),(RM+1),FB,$P(KMPDBX,U,2))
S DX=LM,DY=TM,PAGE=1,KMPDOUT=0
;
; main loop that displays text to the screen and prompts
; for the next page or previous page (if appropriate)
F D Q:KMPDOUT
.F I=$P(PAGES(PAGE),U):1:$P(PAGES(PAGE),U,2) D
..Q:'$D(^UTILITY($J,"W",DIWL,I,0))
..X IOXY W ^UTILITY($J,"W",DIWL,I,0),! S DY=DY+1
.D FTR S DY=DY+1 Q:KMPDOUT X CLRSCR
; clear screen if no KMPDCLR
I 'KMPDCLR X CLRSCR F DY=22,23 X IOXY W IOELALL
;
Q
;
FTR ;--footer
;
N READ,READX S READ=""
F DY=(FB-1):-1:(FB-3) X IOXY W !
S DX=LM,DY=FT X IOXY W $$REPEAT^XLFSTR("_",LENGTH) ; I OS["MSM" W !
S DX=LM,DY=FB X IOXY
I PAGES=1 S READ="Q",READ("A")="Press <RET> to continue"
I PAGES>1 S READ="Q" D
.I PAGE<PAGES S READ=READ_"N"
.I PAGE>1 S READ=READ_"P"
;
; READ("A") - the prompt that appears in footer
; if LENGTH>44 characters: [Q]uit, [N]ext screen, [P]revious Screen:
; if LENGTH>28 characters: [Q]uit, [N]ext, [P]revious:
; else....................: [Q], [N], [P]
I $G(READ("A"))']"" D
.I READ["Q" S READ("A")="[Q]" D
..I LENGTH>28 S READ("A")=READ("A")_"uit"
.I READ["N" S READ("A")=READ("A")_", [N]" D
..I LENGTH>44 S READ("A")=READ("A")_"ext Screen" Q
..I LENGTH>28 S READ("A")=READ("A")_"ext"
.I READ["P" S READ("A")=READ("A")_", [P]" D
..I LENGTH>44 S READ("A")=READ("A")_"revious Screen" Q
..I LENGTH>28 S READ("A")=READ("A")_"revious"
S READ("A")=READ("A")_": "
;
;-footer loop
D Q:KMPDOUT
.S DX=LM,DY=FB X IOXY W $J(" ",$S(LENGTH<80:LENGTH,1:(LENGTH-1)))
.I OS["MSM" W !
.I OS["MSM" W ! F DY=(FB-1):-1:(FB-3) X IOXY W !
.;
.; if LENGTH>55 characters print pages
.I LENGTH>55 D
..S DX=(RM-15),DY=FB X IOXY W " Page ",PAGE," of ",PAGES," "
..I OS["MSM" W !
.S DX=LM,DY=FB X IOXY W READ("A")
.R READX:DTIME S:'$T READX="Q" S READX=$$UP^XLFSTR(READX)
.I READX="Q"!(READX="^")!(READ="E") S KMPDOUT=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 Q
.;
.; end of the screen - this just scrolls up a couple of lines and
.; seems to reset the screen coordinates for MSM
.I OS["MSM" F DY=(BM-1):-1:(BM-3) X IOXY W !
.W $C(7)
;
Q
;
HELP ;-- clear screen, print help text, repaint screen
;
N I,READX X CLRSCR S DY=TM,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)="E" W "Enter 'E' (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=BM X IOXY R "Press <RET> to continue: ",READX:DTIME
; repaint screen
X CLRSCR S DY=(TM-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[HKMPDUT5 7014 printed Apr 09, 2024@20:46:33 Page 2
KMPDUT5 ;OAK/RAK - CM Tools Utility Text Display ;2/17/04 10:49
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
DISPLAY(KMPDARRY,KMPDMRGN,KMPDNW,KMPDCLR,KMPDBX) ;display text
+1 ;-------------------------------------------------------------------
+2 ; If there is more than one page (screen) of text this api
+3 ; allows the user to scroll back and forth between pages
+4 ;
+5 ; KMPDARRY - global or local array that contains word processing text
+6 ; example: "^ASKV(673700,12,11,"
+7 ; "TMP($J)"
+8 ;
+9 ; the following is an example of how the array might be set
+10 ; up:
+11 ; KMPDARRY($J,0)=number of lines
+12 ; KMPDARRY($J,1,0)=text to display
+13 ; KMPDARRY($J,2,0)=text to display
+14 ; KMPDARRY($J,3,0)=text to display
+15 ; KMPDARRY($J...
+16 ;
+17 ;
+18 ; KMPDARRY must not be ^UTILITY($J,"W") - this routine uses
+19 ; fileman to format text, therefore ^UTILITY($J,"W") is
+20 ; used and then killed when routine complete
+21 ;
+22 ; optional parameters
+23 ;
+24 ; KMPDMRGN - margins for display of text in 4 up-arrow pieces
+25 ; TM - top margin of screen area...... piece 1
+26 ; BM - bottom margin of screen area... piece 2
+27 ; LM - left margin.................... piece 3
+28 ; RM - right margin................... piece 4
+29 ; *** NOTE ***
+30 ; if TM and BM are not passed the display will default to
+31 ; full screen (0 to 22)
+32 ;
+33 ; KMPDNW - nowrap 0 - nowrap (display as entered)
+34 ; 1 - wrap
+35 ;
+36 ; KMPDCLR - clear screen when exiting
+37 ; 0 - clear screen
+38 ; 1 - do not clear screen
+39 ;
+40 ; KMPDBX - this variable is in 2 up-arrow pieces
+41 ; piece 1: 0 - do not draw a box (or window) around text
+42 ; 1 - draw box
+43 ; piece 2: header (if any) for box
+44 ;
+45 ; other variables
+46 ;
+47 ; FT - top margin for footer
+48 ; FB - bottom margin for footer
+49 ; LENGTH - length of text to display (RM-LM)
+50 ; OS - operating system
+51 ;--------------------------------------------------------------------
+52 ;
+53 if '$DATA(KMPDARRY)
QUIT
+54 ;
+55 SET KMPDMRGN=$GET(KMPDMRGN)
SET KMPDNW=+$GET(KMPDNW)
+56 SET KMPDCLR=+$GET(KMPDCLR)
SET KMPDBX=$GET(KMPDBX)
+57 ; place array in correct format
+58 IF $EXTRACT(KMPDARRY,$LENGTH(KMPDARRY))=","
SET $EXTRACT(KMPDARRY,$LENGTH(KMPDARRY))=")"
+59 IF $EXTRACT(KMPDARRY,$LENGTH(KMPDARRY))'=")"
SET KMPDARRY=KMPDARRY_")"
+60 IF $EXTRACT(KMPDARRY)'="^"
IF $EXTRACT(KMPDARRY,$LENGTH(KMPDARRY)-1,$LENGTH(KMPDARRY))="()"
Begin DoDot:1
+61 SET KMPDARRY=$EXTRACT(KMPDARRY,1,$LENGTH(KMPDARRY)-2)
End DoDot:1
+62 ;
+63 NEW ASKI,KMPDOUT,BM,CLRSCR,FB,FT,I,LEN,LENGTH,LINES,LM,OS,PAGE,PAGES,RM,TM
+64 NEW DIR,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DX,DY,X,Y,Z
+65 NEW IOBM,IOECH,IOELALL,IOELEOL,IORVON,IORVOFF,IOTM,IOSTBM
+66 ;
+67 ; set up special terminal variables
+68 SET X="IOECH;IOELALL;IOELEOL;IORVON;IORVOFF;IOSTBM"
DO ENDR^%ZISS
+69 SET OS=$GET(^%ZOSF("OS"))
+70 SET TM=+$PIECE(KMPDMRGN,U)
SET LM=+$PIECE(KMPDMRGN,U,3)
SET RM=+$PIECE(KMPDMRGN,U,4)
+71 SET BM=+$PIECE(KMPDMRGN,U,2)
if 'BM!(BM>22)
SET BM=$SELECT(OS["MSM":22,1:23)
+72 if 'RM
SET RM=IOM
SET FB=BM
SET FT=(FB-1)
SET BM=(FB-2)
SET LENGTH=(RM-LM)
+73 SET DIWL=LM
SET DIWR=$SELECT(RM:RM,1:IOM)
SET KMPDNW=$SELECT(KMPDNW=1:"",1:"N")
+74 ; if full screen
+75 IF LM=0
IF (RM=IOM)
SET CLRSCR="F DY=BM:-1:TM X IOXY W IOELALL,!"
+76 ; else partial screen
+77 IF '$TEST
SET CLRSCR="S DX=LM F DY=BM:-1:TM X IOXY W $J("" "",LENGTH)"
+78 ;
+79 DO LOOP
+80 ;
+81 KILL ^UTILITY($JOB,"W")
+82 ;
+83 QUIT
+84 ;
LOOP ;-- main loop
+1 ;
+2 ; use fileman to format text
+3 KILL ^UTILITY($JOB,"W")
SET DIWF=KMPDNW
SET X=""
+4 FOR I=0:0
SET I=$ORDER(@KMPDARRY@(I))
if 'I
QUIT
Begin DoDot:1
+5 if '$DATA(@KMPDARRY@(I,0))
QUIT
SET X=@KMPDARRY@(I,0)
+6 IF KMPDNW="N"
SET X=$EXTRACT(X,1,LENGTH)
+7 DO ^DIWP
End DoDot:1
+8 ; quit if no data to display
+9 if '$DATA(^UTILITY($JOB,"W",DIWL))
QUIT
SET LINES=$GET(^(DIWL))
+10 ; check for last line equal to null
+11 IF $GET(^UTILITY($JOB,"W",DIWL,LINES,0))=""
SET LINES=LINES-1
+12 SET LEN=BM-TM+1
SET PAGES=LINES\LEN
IF LINES#LEN
SET PAGES=PAGES+1
+13 ;
+14 ; set up the PAGES() array - first piece = starting line
+15 ; second piece = ending line
+16 FOR I=1:1:PAGES
Begin DoDot:1
+17 SET PAGES(I)=$SELECT(I=1:1,1:(I*LEN-LEN+1))
+18 IF I=1
SET $PIECE(PAGES(I),U,2)=$SELECT(LINES<LEN:LINES,1:LEN)
QUIT
+19 SET $PIECE(PAGES(I),U,2)=(I*LEN)
End DoDot:1
+20 ;
+21 ; if KMPDBX draw box around text
+22 ;I KMPDBX D KMPDBX^KMPDUTxxx((TM-1),(LM-1),(RM+1),FB,$P(KMPDBX,U,2))
+23 SET DX=LM
SET DY=TM
SET PAGE=1
SET KMPDOUT=0
+24 ;
+25 ; main loop that displays text to the screen and prompts
+26 ; for the next page or previous page (if appropriate)
+27 FOR
Begin DoDot:1
+28 FOR I=$PIECE(PAGES(PAGE),U):1:$PIECE(PAGES(PAGE),U,2)
Begin DoDot:2
+29 if '$DATA(^UTILITY($JOB,"W",DIWL,I,0))
QUIT
+30 XECUTE IOXY
WRITE ^UTILITY($JOB,"W",DIWL,I,0),!
SET DY=DY+1
End DoDot:2
+31 DO FTR
SET DY=DY+1
if KMPDOUT
QUIT
XECUTE CLRSCR
End DoDot:1
if KMPDOUT
QUIT
+32 ; clear screen if no KMPDCLR
+33 IF 'KMPDCLR
XECUTE CLRSCR
FOR DY=22,23
XECUTE IOXY
WRITE IOELALL
+34 ;
+35 QUIT
+36 ;
FTR ;--footer
+1 ;
+2 NEW READ,READX
SET READ=""
+3 FOR DY=(FB-1):-1:(FB-3)
XECUTE IOXY
WRITE !
+4 ; I OS["MSM" W !
SET DX=LM
SET DY=FT
XECUTE IOXY
WRITE $$REPEAT^XLFSTR("_",LENGTH)
+5 SET DX=LM
SET DY=FB
XECUTE IOXY
+6 IF PAGES=1
SET READ="Q"
SET READ("A")="Press <RET> to continue"
+7 IF PAGES>1
SET READ="Q"
Begin DoDot:1
+8 IF PAGE<PAGES
SET READ=READ_"N"
+9 IF PAGE>1
SET READ=READ_"P"
End DoDot:1
+10 ;
+11 ; READ("A") - the prompt that appears in footer
+12 ; if LENGTH>44 characters: [Q]uit, [N]ext screen, [P]revious Screen:
+13 ; if LENGTH>28 characters: [Q]uit, [N]ext, [P]revious:
+14 ; else....................: [Q], [N], [P]
+15 IF $GET(READ("A"))']""
Begin DoDot:1
+16 IF READ["Q"
SET READ("A")="[Q]"
Begin DoDot:2
+17 IF LENGTH>28
SET READ("A")=READ("A")_"uit"
End DoDot:2
+18 IF READ["N"
SET READ("A")=READ("A")_", [N]"
Begin DoDot:2
+19 IF LENGTH>44
SET READ("A")=READ("A")_"ext Screen"
QUIT
+20 IF LENGTH>28
SET READ("A")=READ("A")_"ext"
End DoDot:2
+21 IF READ["P"
SET READ("A")=READ("A")_", [P]"
Begin DoDot:2
+22 IF LENGTH>44
SET READ("A")=READ("A")_"revious Screen"
QUIT
+23 IF LENGTH>28
SET READ("A")=READ("A")_"revious"
End DoDot:2
End DoDot:1
+24 SET READ("A")=READ("A")_": "
+25 ;
+26 ;-footer loop
+27 Begin DoDot:1
+28 SET DX=LM
SET DY=FB
XECUTE IOXY
WRITE $JUSTIFY(" ",$SELECT(LENGTH<80:LENGTH,1:(LENGTH-1)))
+29 IF OS["MSM"
WRITE !
+30 IF OS["MSM"
WRITE !
FOR DY=(FB-1):-1:(FB-3)
XECUTE IOXY
WRITE !
+31 ;
+32 ; if LENGTH>55 characters print pages
+33 IF LENGTH>55
Begin DoDot:2
+34 SET DX=(RM-15)
SET DY=FB
XECUTE IOXY
WRITE " Page ",PAGE," of ",PAGES," "
+35 IF OS["MSM"
WRITE !
End DoDot:2
+36 SET DX=LM
SET DY=FB
XECUTE IOXY
WRITE READ("A")
+37 READ READX:DTIME
if '$TEST
SET READX="Q"
SET READX=$$UP^XLFSTR(READX)
+38 IF READX="Q"!(READX="^")!(READ="E")
SET KMPDOUT=1
QUIT
+39 IF READX="N"
IF (READ["N")
SET PAGE=PAGE+1
QUIT
+40 IF READX="P"
IF (READ["P")
SET PAGE=PAGE-1
QUIT
+41 IF READX["?"
DO HELP
QUIT
+42 ;
+43 ; end of the screen - this just scrolls up a couple of lines and
+44 ; seems to reset the screen coordinates for MSM
+45 IF OS["MSM"
FOR DY=(BM-1):-1:(BM-3)
XECUTE IOXY
WRITE !
+46 WRITE $CHAR(7)
End DoDot:1
if KMPDOUT
QUIT
+47 ;
+48 QUIT
+49 ;
HELP ;-- clear screen, print help text, repaint screen
+1 ;
+2 NEW I,READX
XECUTE CLRSCR
SET DY=TM
SET DX=$SELECT(DIWL>7:DIWL,1:7)
XECUTE IOXY
+3 FOR I=1:1:$LENGTH(READ)
SET DY=DY+1
XECUTE IOXY
Begin DoDot:1
+4 IF $EXTRACT(READ,I)="E"
WRITE "Enter 'E' (or '^') to exit.",!
+5 IF $EXTRACT(READ,I)="N"
WRITE "Enter 'N' to advance to the next screen.",!
+6 IF $EXTRACT(READ,I)="P"
WRITE "Enter 'P' to backup to the previous screen.",!
End DoDot:1
+7 SET DY=BM
XECUTE IOXY
READ "Press <RET> to continue: ",READX:DTIME
+8 ; repaint screen
+9 XECUTE CLRSCR
SET DY=(TM-1)
+10 FOR I=$PIECE(PAGES(PAGE),U):1:$PIECE(PAGES(PAGE),U,2)
Begin DoDot:1
+11 if '$DATA(^UTILITY($JOB,"W",DIWL,I,0))
QUIT
+12 SET DX=DIWL
SET DY=DY+1
XECUTE IOXY
WRITE ^UTILITY($JOB,"W",DIWL,I,0),!
End DoDot:1
+13 ;
+14 QUIT
