source: IHS-VA_UTILITIES-XB/trunk/XBCLM.m@ 1251

Last change on this file since 1251 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.0 KB
Line 
1XBCLM ; IHS/ADC/GTH - COLUMN LISTER ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Thanks to Don Enos, OHPRD, for the original routine,
5 ; 7 Feb 95.
6 ;
7 ; This routine displays a column number header followed by
8 ; the passed string.
9 ;
10 ;
11EP(STR) ;PEP - Column Lister
12 Q:$G(STR)=""
13 NEW B,C1,C2,CH,CV,CV1,CV2,H,L,LC,X
14 KILL DIR,DIRUT
15 S CH=$S($L(STR)>80:3,1:2) ; set column header height
16 S LC=$L(STR)\80
17 S:($L(STR)/80)>LC LC=LC+1 ; set loop count
18 W:$D(IOF) @IOF
19 F L=1:1:LC D LINE Q:$$QUIT($L(STR))
20 Q
21 ;
22LINE ; WRITE HEADER AND ONE LINE
23 KILL H
24 F C1=1:1:CH D
25 . F C2=1:1:80 D Q:(C2+((L-1)*80))'<$L(STR)
26 .. S CV=(C2+((L-1)*80))
27 .. S CV1=CV\100,CV2=(CV#100)\10
28 .. S $E(H(C1),C2)=$S(C1=CH:$E(C2,$L(C2)),C1=(CH-1):CV2,1:CV1)
29 .. Q
30 . Q
31 S X="",$P(X,"=",80)="="
32 W !,X,!
33 F C1=1:1:CH W H(C1),!
34 S X="",$P(X,"-",80)="-"
35 S B=(1+((L-1)*80))
36 W X,!,$E(STR,B,B+79),!
37 Q
38 ;
39QUIT(L) ;
40 NEW B,C1,C2,CH,CV,CV1,CV2,H,LC,X
41 S X=$$DIR^XBDIR("E","<$L="_L_"> Press any key to continue")
42 Q $S($D(DIRUT):1,1:0)
43 ;
Note: See TracBrowser for help on using the repository browser.