source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDU11.m@ 1064

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1KMPDU11 ;OAK/RAK - CM Tools Text Display Utility ;2/17/04 09:50
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4WP(KMPUAR,KMPUTM,KMPUBM,KMPULM,KMPURM,KMPUNW,KMPUXIT) ;-- word processing display.
5 ;--------------------------------------------------------------------
6 ; KMPUAR... Array containing word processing text.
7 ; Example: ^KMPUTMP(1001,1,0)="This is the"
8 ; ^KMPUTMP(1001,2,0)="text to display."
9 ;
10 ; Optional parameters:
11 ;
12 ; KMPUTM.. Top margin of screen area.
13 ; KMPUBM.. Bottom margin of screen area.
14 ; KMPULM.. Left margin.
15 ; KMPURM.. Right margin.
16 ; KMPUNW.. Nowrap:
17 ; 0 - nowrap (print as entered)
18 ; 1 - wrap
19 ; KMPUXIT. Exit without 'continue' text. This allows the programmer
20 ; to use their own display for continuing
21 ; 0 - do not exit - display 'continue' text
22 ; 1 - exit
23 ;
24 ; If more than one page this routine allows the user to scroll back
25 ; and forth between pages. If KMPUTM and KMPUBM are not passed will
26 ; default to full screen (0 to 22).
27 ;--------------------------------------------------------------------
28 ;
29 Q:'$D(KMPUAR)
30 ;
31 N CLRSCR,I,KMPUI,KMPUOUT,LEN,LINES,PAGE,PAGES
32 N DIR,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,X,Y,Z
33 N IOBM,IOECH,IOELALL,IOELEOL,IORVON,IORVOFF,IOTM,IOSTBM
34 ;
35 S KMPUXIT=+$G(KMPUXIT)
36 S KMPUTM=+$G(KMPUTM),KMPUBM=$S(+$G(KMPUBM):KMPUBM,1:22)
37 S KMPULM=+$G(KMPULM),KMPURM=+$G(KMPURM),KMPUNW=+$G(KMPUNW)
38 S:KMPUBM>22 KMPUBM=22 S DIWL=KMPULM,DIWR=$S(KMPURM:KMPURM,1:IOM)
39 S KMPUNW=$S(KMPUNW=1:"",1:"N")
40 S X="IOECH;IOELALL;IOELEOL;IORVON;IORVOFF;IOSTKMPUBM" D ENDR^%ZISS
41 ; set CLRSCR (clear screen)
42 ; clear full screen
43 I DIWL=0,(DIWR=IOM) D
44 .S CLRSCR="F DY=(KMPUBM-1):-1:KMPUTM X IOXY W IOELALL,!"
45 ; clear left margin to end of screen
46 E I DIWR=IOM D
47 .S CLRSCR="S DX=DIWL F DY=(KMPUBM-1):-1:KMPUTM X IOXY W IOELEOL,!"
48 ; clear left margin to right margin
49 E S CLRSCR="F DY=(KMPUBM-1):-1:KMPUTM F DX=DIWL:1:DIWR X IOXY W IOECH"
50 K ^UTILITY($J,"W") S DIWF=KMPUNW,X=""
51 ; use fileman to format text
52 F KMPUI=0:0 S KMPUI=$O(@KMPUAR@(KMPUI)) Q:'KMPUI D
53 .Q:'$D(@KMPUAR@(KMPUI,0)) S X=@KMPUAR@(KMPUI,0) D ^DIWP
54 Q:'$D(^UTILITY($J,"W",DIWL)) S LINES=$G(^(DIWL))
55 ; check for last line equal to null
56 I $G(^UTILITY($J,"W",DIWL,LINES,0))="" S LINES=LINES-1
57 S LEN=KMPUBM-KMPUTM,PAGES=LINES\LEN I LINES#LEN S PAGES=PAGES+1
58 ;
59 ; set up the pages() array - first piece = starting line
60 ; second piece = ending line
61 F I=1:1:PAGES D
62 .S PAGES(I)=$S(I=1:1,1:(I*LEN-LEN+1))
63 .I I=1 S $P(PAGES(I),U,2)=$S(LINES<LEN:LINES,1:LEN) Q
64 .S $P(PAGES(I),U,2)=(I*LEN)
65 S DY=(KMPUTM-1),PAGE=1,KMPUOUT=0
66 ; main loop
67 F D Q:KMPUOUT
68 .F KMPUI=$P(PAGES(PAGE),U):1:$P(PAGES(PAGE),U,2) D
69 ..Q:'$D(^UTILITY($J,"W",DIWL,KMPUI,0))
70 ..S DX=DIWL,DY=DY+1 X IOXY W ^UTILITY($J,"W",DIWL,KMPUI,0),!
71 .I 'KMPUXIT D FTR X CLRSCR Q:KMPUOUT S DY=DY-1
72 .E S KMPUOUT=1
73 F DY=22,23 X IOXY W IOELALL
74 K ^UTILITY($J,"W")
75 Q
76 ;
77FTR ;-- footer designed for wp subroutine above.
78 N READ,READX S READ=""
79 S DX=0,DY=22 X IOXY W $$REPEAT^XLFSTR("_",IOM)
80 I PAGES=1 S READ="X",READ("A")=$J(" ",28)_"Press <RET> to continue"
81 I PAGES>1 S READ="X",READ("A")="E[x]it" D
82 .I PAGE<PAGES S READ=READ_"N",READ("A")=READ("A")_", [N]ext Screen"
83 .I PAGE>1 S READ=READ_"P",READ("A")=READ("A")_", [P]revious Screen"
84 S READ("A")=READ("A")_": "
85FTR1 ;-- read
86 S DX=0,DY=23 X IOXY W IOELALL
87 S DX=62 X IOXY W " Page ",PAGE," of ",PAGES," "
88 S DX=0 X IOXY W READ("A")
89 R READX:DTIME S READX=$$UP^XLFSTR(READX)
90 I READX="X"!(READX="^")!(READ="X") S KMPUOUT=1 Q
91 I READX="N",(READ["N") S PAGE=PAGE+1 Q
92 I READX="P",(READ["P") S PAGE=PAGE-1 Q
93 I READX["?" D HELP G FTR1
94 W *7
95 G FTR1
96 ;
97HELP ;-- clear screen, print help text, repaint screen.
98 N I,READX X CLRSCR S DY=KMPUTM,DX=$S(DIWL>7:DIWL,1:7) X IOXY
99 F I=1:1:$L(READ) S DY=DY+1 X IOXY D
100 .I $E(READ,I)="X" W "Enter 'X' (or '^') to exit.",!
101 .I $E(READ,I)="N" W "Enter 'N' to advance to the next screen.",!
102 .I $E(READ,I)="P" W "Enter 'P' to backup to the previous screen.",!
103 S DY=(KMPUBM-1) X IOXY R "Press <RET> to continue: ",READX:DTIME
104 ; repaint screen.
105 X CLRSCR S DY=(KMPUTM-1)
106 F I=$P(PAGES(PAGE),U):1:$P(PAGES(PAGE),U,2) D
107 .Q:'$D(^UTILITY($J,"W",DIWL,I,0))
108 .S DX=DIWL,DY=DY+1 X IOXY W ^UTILITY($J,"W",DIWL,I,0),!
109 Q
Note: See TracBrowser for help on using the repository browser.