- XBCLM ; IHS/ADC/GTH - COLUMN LISTER ; [ 02/07/97 3:02 PM ]
- ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- ;
- ; Thanks to Don Enos, OHPRD, for the original routine,
- ; 7 Feb 95.
- ;
- ; This routine displays a column number header followed by
- ; the passed string.
- ;
- ;
- EP(STR) ;PEP - Column Lister
- Q:$G(STR)=""
- NEW B,C1,C2,CH,CV,CV1,CV2,H,L,LC,X
- KILL DIR,DIRUT
- S CH=$S($L(STR)>80:3,1:2) ; set column header height
- S LC=$L(STR)\80
- S:($L(STR)/80)>LC LC=LC+1 ; set loop count
- W:$D(IOF) @IOF
- F L=1:1:LC D LINE Q:$$QUIT($L(STR))
- Q
- ;
- LINE ; WRITE HEADER AND ONE LINE
- KILL H
- F C1=1:1:CH D
- . F C2=1:1:80 D Q:(C2+((L-1)*80))'<$L(STR)
- .. S CV=(C2+((L-1)*80))
- .. S CV1=CV\100,CV2=(CV#100)\10
- .. S $E(H(C1),C2)=$S(C1=CH:$E(C2,$L(C2)),C1=(CH-1):CV2,1:CV1)
- .. Q
- . Q
- S X="",$P(X,"=",80)="="
- W !,X,!
- F C1=1:1:CH W H(C1),!
- S X="",$P(X,"-",80)="-"
- S B=(1+((L-1)*80))
- W X,!,$E(STR,B,B+79),!
- Q
- ;
- QUIT(L) ;
- NEW B,C1,C2,CH,CV,CV1,CV2,H,LC,X
- S X=$$DIR^XBDIR("E","<$L="_L_"> Press any key to continue")
- Q $S($D(DIRUT):1,1:0)
- ;
- XBCLM ; IHS/ADC/GTH - COLUMN LISTER ; [ 02/07/97 3:02 PM ]
- +1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- +2 ;
- +3 ; Thanks to Don Enos, OHPRD, for the original routine,
- +4 ; 7 Feb 95.
- +5 ;
- +6 ; This routine displays a column number header followed by
- +7 ; the passed string.
- +8 ;
- +9 ;
- EP(STR) ;PEP - Column Lister
- +1 IF $GET(STR)=""
- QUIT
- +2 NEW B,C1,C2,CH,CV,CV1,CV2,H,L,LC,X
- +3 KILL DIR,DIRUT
- +4 ; set column header height
- SET CH=$SELECT($LENGTH(STR)>80:3,1:2)
- +5 SET LC=$LENGTH(STR)\80
- +6 ; set loop count
- IF ($LENGTH(STR)/80)>LC
- SET LC=LC+1
- +7 IF $DATA(IOF)
- WRITE @IOF
- +8 FOR L=1:1:LC
- DO LINE
- IF $$QUIT($LENGTH(STR))
- QUIT
- +9 QUIT
- +10 ;
- LINE ; WRITE HEADER AND ONE LINE
- +1 KILL H
- +2 FOR C1=1:1:CH
- Begin DoDot:1
- +3 FOR C2=1:1:80
- Begin DoDot:2
- +4 SET CV=(C2+((L-1)*80))
- +5 SET CV1=CV\100
- SET CV2=(CV#100)\10
- +6 SET $EXTRACT(H(C1),C2)=$SELECT(C1=CH:$EXTRACT(C2,$LENGTH(C2)),C1=(CH-1):CV2,1:CV1)
- +7 QUIT
- End DoDot:2
- IF (C2+((L-1)*80))'<$LENGTH(STR)
- QUIT
- +8 QUIT
- End DoDot:1
- +9 SET X=""
- SET $PIECE(X,"=",80)="="
- +10 WRITE !,X,!
- +11 FOR C1=1:1:CH
- WRITE H(C1),!
- +12 SET X=""
- SET $PIECE(X,"-",80)="-"
- +13 SET B=(1+((L-1)*80))
- +14 WRITE X,!,$EXTRACT(STR,B,B+79),!
- +15 QUIT
- +16 ;
- QUIT(L) ;
- +1 NEW B,C1,C2,CH,CV,CV1,CV2,H,LC,X
- +2 SET X=$$DIR^XBDIR("E","<$L="_L_"> Press any key to continue")
- +3 QUIT $SELECT($DATA(DIRUT):1,1:0)
- +4 ;