- 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 Mar 13, 2025@20:45:55 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
