source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUT5.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.7 KB
Line 
1KMPDUT5 ;OAK/RAK - CM Tools Utility Text Display ;2/17/04 10:49
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4DISPLAY(KMPDARRY,KMPDMRGN,KMPDNW,KMPDCLR,KMPDBX) ;display text
5 ;-------------------------------------------------------------------
6 ; If there is more than one page (screen) of text this api
7 ; allows the user to scroll back and forth between pages
8 ;
9 ; KMPDARRY - global or local array that contains word processing text
10 ; example: "^ASKV(673700,12,11,"
11 ; "TMP($J)"
12 ;
13 ; the following is an example of how the array might be set
14 ; up:
15 ; KMPDARRY($J,0)=number of lines
16 ; KMPDARRY($J,1,0)=text to display
17 ; KMPDARRY($J,2,0)=text to display
18 ; KMPDARRY($J,3,0)=text to display
19 ; KMPDARRY($J...
20 ;
21 ;
22 ; KMPDARRY must not be ^UTILITY($J,"W") - this routine uses
23 ; fileman to format text, therefore ^UTILITY($J,"W") is
24 ; used and then killed when routine complete
25 ;
26 ; optional parameters
27 ;
28 ; KMPDMRGN - margins for display of text in 4 up-arrow pieces
29 ; TM - top margin of screen area...... piece 1
30 ; BM - bottom margin of screen area... piece 2
31 ; LM - left margin.................... piece 3
32 ; RM - right margin................... piece 4
33 ; *** NOTE ***
34 ; if TM and BM are not passed the display will default to
35 ; full screen (0 to 22)
36 ;
37 ; KMPDNW - nowrap 0 - nowrap (display as entered)
38 ; 1 - wrap
39 ;
40 ; KMPDCLR - clear screen when exiting
41 ; 0 - clear screen
42 ; 1 - do not clear screen
43 ;
44 ; KMPDBX - this variable is in 2 up-arrow pieces
45 ; piece 1: 0 - do not draw a box (or window) around text
46 ; 1 - draw box
47 ; piece 2: header (if any) for box
48 ;
49 ; other variables
50 ;
51 ; FT - top margin for footer
52 ; FB - bottom margin for footer
53 ; LENGTH - length of text to display (RM-LM)
54 ; OS - operating system
55 ;--------------------------------------------------------------------
56 ;
57 Q:'$D(KMPDARRY)
58 ;
59 S KMPDMRGN=$G(KMPDMRGN),KMPDNW=+$G(KMPDNW)
60 S KMPDCLR=+$G(KMPDCLR),KMPDBX=$G(KMPDBX)
61 ; place array in correct format
62 I $E(KMPDARRY,$L(KMPDARRY))="," S $E(KMPDARRY,$L(KMPDARRY))=")"
63 I $E(KMPDARRY,$L(KMPDARRY))'=")" S KMPDARRY=KMPDARRY_")"
64 I $E(KMPDARRY)'="^" I $E(KMPDARRY,$L(KMPDARRY)-1,$L(KMPDARRY))="()" D
65 .S KMPDARRY=$E(KMPDARRY,1,$L(KMPDARRY)-2)
66 ;
67 N ASKI,KMPDOUT,BM,CLRSCR,FB,FT,I,LEN,LENGTH,LINES,LM,OS,PAGE,PAGES,RM,TM
68 N DIR,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DX,DY,X,Y,Z
69 N IOBM,IOECH,IOELALL,IOELEOL,IORVON,IORVOFF,IOTM,IOSTBM
70 ;
71 ; set up special terminal variables
72 S X="IOECH;IOELALL;IOELEOL;IORVON;IORVOFF;IOSTBM" D ENDR^%ZISS
73 S OS=$G(^%ZOSF("OS"))
74 S TM=+$P(KMPDMRGN,U),LM=+$P(KMPDMRGN,U,3),RM=+$P(KMPDMRGN,U,4)
75 S BM=+$P(KMPDMRGN,U,2) S:'BM!(BM>22) BM=$S(OS["MSM":22,1:23)
76 S:'RM RM=IOM S FB=BM,FT=(FB-1),BM=(FB-2),LENGTH=(RM-LM)
77 S DIWL=LM,DIWR=$S(RM:RM,1:IOM),KMPDNW=$S(KMPDNW=1:"",1:"N")
78 ; if full screen
79 I LM=0,(RM=IOM) S CLRSCR="F DY=BM:-1:TM X IOXY W IOELALL,!"
80 ; else partial screen
81 E S CLRSCR="S DX=LM F DY=BM:-1:TM X IOXY W $J("" "",LENGTH)"
82 ;
83 D LOOP
84 ;
85 K ^UTILITY($J,"W")
86 ;
87 Q
88 ;
89LOOP ;-- main loop
90 ;
91 ; use fileman to format text
92 K ^UTILITY($J,"W") S DIWF=KMPDNW,X=""
93 F I=0:0 S I=$O(@KMPDARRY@(I)) Q:'I D
94 .Q:'$D(@KMPDARRY@(I,0)) S X=@KMPDARRY@(I,0)
95 .I KMPDNW="N" S X=$E(X,1,LENGTH)
96 .D ^DIWP
97 ; quit if no data to display
98 Q:'$D(^UTILITY($J,"W",DIWL)) S LINES=$G(^(DIWL))
99 ; check for last line equal to null
100 I $G(^UTILITY($J,"W",DIWL,LINES,0))="" S LINES=LINES-1
101 S LEN=BM-TM+1,PAGES=LINES\LEN I LINES#LEN S PAGES=PAGES+1
102 ;
103 ; set up the PAGES() array - first piece = starting line
104 ; second piece = ending line
105 F I=1:1:PAGES D
106 .S PAGES(I)=$S(I=1:1,1:(I*LEN-LEN+1))
107 .I I=1 S $P(PAGES(I),U,2)=$S(LINES<LEN:LINES,1:LEN) Q
108 .S $P(PAGES(I),U,2)=(I*LEN)
109 ;
110 ; if KMPDBX draw box around text
111 ;I KMPDBX D KMPDBX^KMPDUTxxx((TM-1),(LM-1),(RM+1),FB,$P(KMPDBX,U,2))
112 S DX=LM,DY=TM,PAGE=1,KMPDOUT=0
113 ;
114 ; main loop that displays text to the screen and prompts
115 ; for the next page or previous page (if appropriate)
116 F D Q:KMPDOUT
117 .F I=$P(PAGES(PAGE),U):1:$P(PAGES(PAGE),U,2) D
118 ..Q:'$D(^UTILITY($J,"W",DIWL,I,0))
119 ..X IOXY W ^UTILITY($J,"W",DIWL,I,0),! S DY=DY+1
120 .D FTR S DY=DY+1 Q:KMPDOUT X CLRSCR
121 ; clear screen if no KMPDCLR
122 I 'KMPDCLR X CLRSCR F DY=22,23 X IOXY W IOELALL
123 ;
124 Q
125 ;
126FTR ;--footer
127 ;
128 N READ,READX S READ=""
129 F DY=(FB-1):-1:(FB-3) X IOXY W !
130 S DX=LM,DY=FT X IOXY W $$REPEAT^XLFSTR("_",LENGTH) ; I OS["MSM" W !
131 S DX=LM,DY=FB X IOXY
132 I PAGES=1 S READ="Q",READ("A")="Press <RET> to continue"
133 I PAGES>1 S READ="Q" D
134 .I PAGE<PAGES S READ=READ_"N"
135 .I PAGE>1 S READ=READ_"P"
136 ;
137 ; READ("A") - the prompt that appears in footer
138 ; if LENGTH>44 characters: [Q]uit, [N]ext screen, [P]revious Screen:
139 ; if LENGTH>28 characters: [Q]uit, [N]ext, [P]revious:
140 ; else....................: [Q], [N], [P]
141 I $G(READ("A"))']"" D
142 .I READ["Q" S READ("A")="[Q]" D
143 ..I LENGTH>28 S READ("A")=READ("A")_"uit"
144 .I READ["N" S READ("A")=READ("A")_", [N]" D
145 ..I LENGTH>44 S READ("A")=READ("A")_"ext Screen" Q
146 ..I LENGTH>28 S READ("A")=READ("A")_"ext"
147 .I READ["P" S READ("A")=READ("A")_", [P]" D
148 ..I LENGTH>44 S READ("A")=READ("A")_"revious Screen" Q
149 ..I LENGTH>28 S READ("A")=READ("A")_"revious"
150 S READ("A")=READ("A")_": "
151 ;
152 ;-footer loop
153 D Q:KMPDOUT
154 .S DX=LM,DY=FB X IOXY W $J(" ",$S(LENGTH<80:LENGTH,1:(LENGTH-1)))
155 .I OS["MSM" W !
156 .I OS["MSM" W ! F DY=(FB-1):-1:(FB-3) X IOXY W !
157 .;
158 .; if LENGTH>55 characters print pages
159 .I LENGTH>55 D
160 ..S DX=(RM-15),DY=FB X IOXY W " Page ",PAGE," of ",PAGES," "
161 ..I OS["MSM" W !
162 .S DX=LM,DY=FB X IOXY W READ("A")
163 .R READX:DTIME S:'$T READX="Q" S READX=$$UP^XLFSTR(READX)
164 .I READX="Q"!(READX="^")!(READ="E") S KMPDOUT=1 Q
165 .I READX="N",(READ["N") S PAGE=PAGE+1 Q
166 .I READX="P",(READ["P") S PAGE=PAGE-1 Q
167 .I READX["?" D HELP Q
168 .;
169 .; end of the screen - this just scrolls up a couple of lines and
170 .; seems to reset the screen coordinates for MSM
171 .I OS["MSM" F DY=(BM-1):-1:(BM-3) X IOXY W !
172 .W $C(7)
173 ;
174 Q
175 ;
176HELP ;-- clear screen, print help text, repaint screen
177 ;
178 N I,READX X CLRSCR S DY=TM,DX=$S(DIWL>7:DIWL,1:7) X IOXY
179 F I=1:1:$L(READ) S DY=DY+1 X IOXY D
180 .I $E(READ,I)="E" W "Enter 'E' (or '^') to exit.",!
181 .I $E(READ,I)="N" W "Enter 'N' to advance to the next screen.",!
182 .I $E(READ,I)="P" W "Enter 'P' to backup to the previous screen.",!
183 S DY=BM X IOXY R "Press <RET> to continue: ",READX:DTIME
184 ; repaint screen
185 X CLRSCR S DY=(TM-1)
186 F I=$P(PAGES(PAGE),U):1:$P(PAGES(PAGE),U,2) D
187 .Q:'$D(^UTILITY($J,"W",DIWL,I,0))
188 .S DX=DIWL,DY=DY+1 X IOXY W ^UTILITY($J,"W",DIWL,I,0),!
189 ;
190 Q
Note: See TracBrowser for help on using the repository browser.