Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBCLM

XBCLM.m

Go to the documentation of this file.
  1. XBCLM ; IHS/ADC/GTH - COLUMN LISTER ; [ 02/07/97 3:02 PM ]
  1. ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
  1. ;
  1. ; Thanks to Don Enos, OHPRD, for the original routine,
  1. ; 7 Feb 95.
  1. ;
  1. ; This routine displays a column number header followed by
  1. ; the passed string.
  1. ;
  1. ;
  1. EP(STR) ;PEP - Column Lister
  1. Q:$G(STR)=""
  1. NEW B,C1,C2,CH,CV,CV1,CV2,H,L,LC,X
  1. KILL DIR,DIRUT
  1. S CH=$S($L(STR)>80:3,1:2) ; set column header height
  1. S LC=$L(STR)\80
  1. S:($L(STR)/80)>LC LC=LC+1 ; set loop count
  1. W:$D(IOF) @IOF
  1. F L=1:1:LC D LINE Q:$$QUIT($L(STR))
  1. Q
  1. ;
  1. LINE ; WRITE HEADER AND ONE LINE
  1. KILL H
  1. F C1=1:1:CH D
  1. . F C2=1:1:80 D Q:(C2+((L-1)*80))'<$L(STR)
  1. .. S CV=(C2+((L-1)*80))
  1. .. S CV1=CV\100,CV2=(CV#100)\10
  1. .. S $E(H(C1),C2)=$S(C1=CH:$E(C2,$L(C2)),C1=(CH-1):CV2,1:CV1)
  1. .. Q
  1. . Q
  1. S X="",$P(X,"=",80)="="
  1. W !,X,!
  1. F C1=1:1:CH W H(C1),!
  1. S X="",$P(X,"-",80)="-"
  1. S B=(1+((L-1)*80))
  1. W X,!,$E(STR,B,B+79),!
  1. Q
  1. ;
  1. QUIT(L) ;
  1. NEW B,C1,C2,CH,CV,CV1,CV2,H,LC,X
  1. S X=$$DIR^XBDIR("E","<$L="_L_"> Press any key to continue")
  1. Q $S($D(DIRUT):1,1:0)
  1. ;