TIUFPR ;SLC/MAM - Action Print List ;;3/7/00
;;1.0;TEXT INTEGRATION UTILITIES;**2,8,99**;Jun 20, 1997
;
CAPTION(RMSUFFIX) ; -- set up caption line of header
N X,COL,FLD
S $P(X," ",TIUF("RM"_RMSUFFIX)+1)=""
S COL="" F S COL=$O(VALMDDF(COL)) Q:COL="" S FLD=VALMDDF(COL) D
.S X=$$SETSTR^VALM1($P(FLD,U,4),X,+$P(FLD,U,2),$S($L($P(FLD,U,4))<$P(FLD,U,3):$L($P(FLD,U,4)),1:+$P(FLD,U,3)))
Q X
;
TBAR(RMSUFFIX) ; -- print caption/top bar
; Needs TIUFWD,TIUFCAP,RMSUFFIX
N X
D CRT(0,2)
S TIUFCAP=" "_$E(TIUFCAP,2,TIUF("RM"_RMSUFFIX))
S X=$E(TIUFCAP,1,VALM("FIXED"))_$E(TIUFCAP,VALMLFT,VALMLFT+TIUFWD-1-VALM("FIXED"))
W:"DX"'[$G(TIUFSTMP) ! W X
Q
;
CRT(DX,DY) ;
I DX'<0,DY'<0,$E(IOST,1,2)="C-" W $C(13) X IOXY
Q
;
PRTL ; Action Print List. Prints whole list of items, but if Template permits right/left scroll, prints only the present right/left portion of each item.
N DIR,DA,X,Y,TIUFANS,TIUFAR,TIUFCAP,RMSUFFIX,WHO,DTOUT,DIRUT,DIROUT
S WHO=$S(TIUFWHO="N":"M",1:TIUFWHO)
S TIUFAR=$S($G(TIUFSTMP)="D"!($G(TIUFSTMP)="X"):"^TMP(""TIUF3"",$J)",$G(TIUFSTMP)="T":"^TMP(""TIUF2"",$J)",1:"^TMP(""TIUF1"",$J)")
S RMSUFFIX=$S($D(TIUFSTMP):TIUFSTMP,1:TIUFTMPL),RMSUFFIX=RMSUFFIX_$S("TD"'[RMSUFFIX:WHO,1:"")
S TIUFCAP=$$CAPTION(RMSUFFIX)
D:VALMCC FULL^VALM1
S DIR("?",1)="You can print only those columns that appear on this screen, or you can print"
S DIR("?")="ALL columns including those you see by scrolling to the right"
D I $D(DIRUT) G PRTLX
. K DIRUT I $G(TIUFSTMP)="D" S TIUFANS=1 Q
. S DIR(0)="Y",DIR("A")=$S($G(TIUFSTMP)="":"Print Name and Type Only",1:"Print Item and Sequence Only"),DIR("B")="YES"
. I $G(TIUFSTMP)="",VALMLFT=49 D ^DIR S TIUFANS=Y Q
. I $G(TIUFSTMP)="T",VALMLFT=32 D ^DIR S TIUFANS=Y Q
. S TIUFANS=1
S %ZIS="Q" D ^%ZIS I POP G PRTLX
I '$D(IO("Q")),IO=IO(0) D CLEAR^VALM1 S X=0 X ^%ZOSF("RM")
I '$D(IO("Q")) G PRTL1
S ZTRTN="PRTL1^TIUFPR",ZTIO=ION,ZTDESC="TIUF Print List -- List Manager Action"
D SAVE,^%ZTLOAD G PRTLX
;
PRTL1 ;
N TIUFWD,TIUFPGE,TIUFLNS,TIUFHDR,NOSCRNS,NOPGES,TIUFOFPG,TIUFJ,FIRST,LAST,TIUFESC
S TIUFWD=IOM,TIUFPGE=1,TIUFLNS=IOSL-6
S TIUFHDR=VALMHDR(1),TIUFESC=0
I TIUFANS S NOSCRNS=1
E S NOSCRNS=$S($G(TIUFSTMP)="T":2,1:4)
S NOPGES=$$PAGE(VALMCNT,TIUFLNS),TIUFOFPG=NOPGES*NOSCRNS
U IO
F TIUFJ=1:1:NOPGES D Q:TIUFESC
. S FIRST=TIUFLNS*(TIUFJ-1)+1,LAST=FIRST+TIUFLNS-1
. D COLUMNS(FIRST,LAST,NOSCRNS,.TIUFPGE,RMSUFFIX)
PRTLX S VALMBCK="R" N IOSTBM D ^%ZISC D TERM S X=0 X ^%ZOSF("RM")
I $D(ZTQUEUED) S ZTREQ="@"
I $D(DTOUT) S VALMBCK="Q"
Q
;
TERM ; -- set up term characteristics
D HOME^%ZIS
S X="IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF;IOBON;IOBOFF;IOSGR0" D ENDR^%ZISS
Q
;
COLUMNS(FIRST,LAST,NOSCRNS,TIUFPAGE,RMSUFFIX) ; Writes columns for LM entries FIRST through LAST;
; Returns the display back to far left before quitting.
; NOSCRNS = Number of (left/right) screens to be printed (depends on LM Template Right Margin) and on users choice to print all or only first left/right screen.
N TIUFI,LINENO,TEXT
;TIUFESC is newed in PRTL; DON'T new it here.
S TIUFESC=0
F TIUFI=1:1:NOSCRNS D Q:TIUFESC
. D HDR,TBAR(RMSUFFIX)
. F LINENO=FIRST:1:LAST Q:LINENO>VALMCNT Q:TIUFESC S TEXT=$$EXTRACT($G(@TIUFAR@(LINENO,0))) W !,TEXT
. D FTR
. Q:TIUFESC
. D:NOSCRNS>1 RIGHT^TIUFL1("0^0^PL")
. S TIUFPGE=TIUFPGE+1
. Q
D:NOSCRNS>1 LEFT^TIUFL1("0^0^PL")
Q
;
; Requires TIUFWD
Q $S(X="":X,1:$E($E(X,1,+VALM("FIXED"))_$E(X,VALMLFT,VALMLFT+TIUFWD-1-VALM("FIXED"))_$J("",TIUFWD),1,TIUFWD))
;
HDR ; -- prt/display header
; Requires TIUFHDR, TIUFWD, TIUFPGE, TIUFIOFPG, TIUFAR, TITLE
N X,I,DX,DY,TITLE
; -- prt hdr line
W @IOF
I $E(IOST,1,2)="C-" S DX=0,DY=0 X IOXY ; -- position cursor
S TITLE=$S('$D(VALM("TITLE")):$E($P(TIUFNOD0,U),1,30),1:VALM("TITLE"))
W $J(" ",30-$L(TITLE))
I $E(IOST,1,2)="C-" W $C(13) S DX=30,DY=0 X IOXY ; -- position cursor
W $J("",((TIUFWD-80)/2)),$$MIXED^TIULS($$NOW^TIULO),$J("",10+((TIUFWD-80)/2)),"Page: ",$J(TIUFPGE,4)," of ",$J(TIUFOFPG,4)
W !,TIUFHDR,!
Q
;
FTR ; -- footer to print
N PAUSEANS
S TIUFESC=0
I $E(IOST,1,2)="C-" D XPAUSE(.PAUSEANS) S TIUFESC='PAUSEANS
Q
;
XPAUSE(Y) ; Pause with ^ to exit; omits carriage return that scrolls top line off
N DIR,X,DA
W ! S DIR(0)="E" D ^DIR
Q
;
PAGE(BEG,LINES) ; -- calc page #
; Requires TIUFAR
S BEG=$S($D(@TIUFAR@(BEG,0)):BEG,1:0)
Q (BEG\LINES)+((BEG#LINES)>0)
;
SAVE ; -- save to queue for PRTL
; TIU*1*99: add VALM(, VALMCC to list:
F X="TIUFSTMP","TIUFTMPL","TIUFXNOD","VALMDDF","TIUFWD","TIUF(","VALM(","VALMCC","VALMLFT","VALMWD","VALMCNT","VALMHDR(","TIUFWHO","TIUFANS","TIUFCAP","RMSUFFIX" S ZTSAVE(X)=""
F X="TIUFAR",$E(TIUFAR,1,$L(TIUFAR)-1)_"," S ZTSAVE(X)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFPR 4861 printed Dec 13, 2024@02:41:21 Page 2
TIUFPR ;SLC/MAM - Action Print List ;;3/7/00
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**2,8,99**;Jun 20, 1997
+2 ;
CAPTION(RMSUFFIX) ; -- set up caption line of header
+1 NEW X,COL,FLD
+2 SET $PIECE(X," ",TIUF("RM"_RMSUFFIX)+1)=""
+3 SET COL=""
FOR
SET COL=$ORDER(VALMDDF(COL))
if COL=""
QUIT
SET FLD=VALMDDF(COL)
Begin DoDot:1
+4 SET X=$$SETSTR^VALM1($PIECE(FLD,U,4),X,+$PIECE(FLD,U,2),$SELECT($LENGTH($PIECE(FLD,U,4))<$PIECE(FLD,U,3):$LENGTH($PIECE(FLD,U,4)),1:+$PIECE(FLD,U,3)))
End DoDot:1
+5 QUIT X
+6 ;
TBAR(RMSUFFIX) ; -- print caption/top bar
+1 ; Needs TIUFWD,TIUFCAP,RMSUFFIX
+2 NEW X
+3 DO CRT(0,2)
+4 SET TIUFCAP=" "_$EXTRACT(TIUFCAP,2,TIUF("RM"_RMSUFFIX))
+5 SET X=$EXTRACT(TIUFCAP,1,VALM("FIXED"))_$EXTRACT(TIUFCAP,VALMLFT,VALMLFT+TIUFWD-1-VALM("FIXED"))
+6 if "DX"'[$GET(TIUFSTMP)
WRITE !
WRITE X
+7 QUIT
+8 ;
CRT(DX,DY) ;
+1 IF DX'<0
IF DY'<0
IF $EXTRACT(IOST,1,2)="C-"
WRITE $CHAR(13)
XECUTE IOXY
+2 QUIT
+3 ;
PRTL ; Action Print List. Prints whole list of items, but if Template permits right/left scroll, prints only the present right/left portion of each item.
+1 NEW DIR,DA,X,Y,TIUFANS,TIUFAR,TIUFCAP,RMSUFFIX,WHO,DTOUT,DIRUT,DIROUT
+2 SET WHO=$SELECT(TIUFWHO="N":"M",1:TIUFWHO)
+3 SET TIUFAR=$SELECT($GET(TIUFSTMP)="D"!($GET(TIUFSTMP)="X"):"^TMP(""TIUF3"",$J)",$GET(TIUFSTMP)="T":"^TMP(""TIUF2"",$J)",1:"^TMP(""TIUF1"",$J)")
+4 SET RMSUFFIX=$SELECT($DATA(TIUFSTMP):TIUFSTMP,1:TIUFTMPL)
SET RMSUFFIX=RMSUFFIX_$SELECT("TD"'[RMSUFFIX:WHO,1:"")
+5 SET TIUFCAP=$$CAPTION(RMSUFFIX)
+6 if VALMCC
DO FULL^VALM1
+7 SET DIR("?",1)="You can print only those columns that appear on this screen, or you can print"
+8 SET DIR("?")="ALL columns including those you see by scrolling to the right"
+9 Begin DoDot:1
+10 KILL DIRUT
IF $GET(TIUFSTMP)="D"
SET TIUFANS=1
QUIT
+11 SET DIR(0)="Y"
SET DIR("A")=$SELECT($GET(TIUFSTMP)="":"Print Name and Type Only",1:"Print Item and Sequence Only")
SET DIR("B")="YES"
+12 IF $GET(TIUFSTMP)=""
IF VALMLFT=49
DO ^DIR
SET TIUFANS=Y
QUIT
+13 IF $GET(TIUFSTMP)="T"
IF VALMLFT=32
DO ^DIR
SET TIUFANS=Y
QUIT
+14 SET TIUFANS=1
End DoDot:1
IF $DATA(DIRUT)
GOTO PRTLX
+15 SET %ZIS="Q"
DO ^%ZIS
IF POP
GOTO PRTLX
+16 IF '$DATA(IO("Q"))
IF IO=IO(0)
DO CLEAR^VALM1
SET X=0
XECUTE ^%ZOSF("RM")
+17 IF '$DATA(IO("Q"))
GOTO PRTL1
+18 SET ZTRTN="PRTL1^TIUFPR"
SET ZTIO=ION
SET ZTDESC="TIUF Print List -- List Manager Action"
+19 DO SAVE
DO ^%ZTLOAD
GOTO PRTLX
+20 ;
PRTL1 ;
+1 NEW TIUFWD,TIUFPGE,TIUFLNS,TIUFHDR,NOSCRNS,NOPGES,TIUFOFPG,TIUFJ,FIRST,LAST,TIUFESC
+2 SET TIUFWD=IOM
SET TIUFPGE=1
SET TIUFLNS=IOSL-6
+3 SET TIUFHDR=VALMHDR(1)
SET TIUFESC=0
+4 IF TIUFANS
SET NOSCRNS=1
+5 IF '$TEST
SET NOSCRNS=$SELECT($GET(TIUFSTMP)="T":2,1:4)
+6 SET NOPGES=$$PAGE(VALMCNT,TIUFLNS)
SET TIUFOFPG=NOPGES*NOSCRNS
+7 USE IO
+8 FOR TIUFJ=1:1:NOPGES
Begin DoDot:1
+9 SET FIRST=TIUFLNS*(TIUFJ-1)+1
SET LAST=FIRST+TIUFLNS-1
+10 DO COLUMNS(FIRST,LAST,NOSCRNS,.TIUFPGE,RMSUFFIX)
End DoDot:1
if TIUFESC
QUIT
PRTLX SET VALMBCK="R"
NEW IOSTBM
DO ^%ZISC
DO TERM
SET X=0
XECUTE ^%ZOSF("RM")
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF $DATA(DTOUT)
SET VALMBCK="Q"
+3 QUIT
+4 ;
TERM ; -- set up term characteristics
+1 DO HOME^%ZIS
+2 SET X="IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF;IOBON;IOBOFF;IOSGR0"
DO ENDR^%ZISS
+3 QUIT
+4 ;
COLUMNS(FIRST,LAST,NOSCRNS,TIUFPAGE,RMSUFFIX) ; Writes columns for LM entries FIRST through LAST;
+1 ; Returns the display back to far left before quitting.
+2 ; NOSCRNS = Number of (left/right) screens to be printed (depends on LM Template Right Margin) and on users choice to print all or only first left/right screen.
+3 NEW TIUFI,LINENO,TEXT
+4 ;TIUFESC is newed in PRTL; DON'T new it here.
+5 SET TIUFESC=0
+6 FOR TIUFI=1:1:NOSCRNS
Begin DoDot:1
+7 DO HDR
DO TBAR(RMSUFFIX)
+8 FOR LINENO=FIRST:1:LAST
if LINENO>VALMCNT
QUIT
if TIUFESC
QUIT
SET TEXT=$$EXTRACT($GET(@TIUFAR@(LINENO,0)))
WRITE !,TEXT
+9 DO FTR
+10 if TIUFESC
QUIT
+11 if NOSCRNS>1
DO RIGHT^TIUFL1("0^0^PL")
+12 SET TIUFPGE=TIUFPGE+1
+13 QUIT
End DoDot:1
if TIUFESC
QUIT
+14 if NOSCRNS>1
DO LEFT^TIUFL1("0^0^PL")
+15 QUIT
+16 ;
+1 ; Requires TIUFWD
+2 QUIT $SELECT(X="":X,1:$EXTRACT($EXTRACT(X,1,+VALM("FIXED"))_$EXTRACT(X,VALMLFT,VALMLFT+TIUFWD-1-VALM("FIXED"))_$JUSTIFY("",TIUFWD),1,TIUFWD))
+3 ;
HDR ; -- prt/display header
+1 ; Requires TIUFHDR, TIUFWD, TIUFPGE, TIUFIOFPG, TIUFAR, TITLE
+2 NEW X,I,DX,DY,TITLE
+3 ; -- prt hdr line
+4 WRITE @IOF
+5 ; -- position cursor
IF $EXTRACT(IOST,1,2)="C-"
SET DX=0
SET DY=0
XECUTE IOXY
+6 SET TITLE=$SELECT('$DATA(VALM("TITLE")):$EXTRACT($PIECE(TIUFNOD0,U),1,30),1:VALM("TITLE"))
+7 WRITE $JUSTIFY(" ",30-$LENGTH(TITLE))
+8 ; -- position cursor
IF $EXTRACT(IOST,1,2)="C-"
WRITE $CHAR(13)
SET DX=30
SET DY=0
XECUTE IOXY
+9 WRITE $JUSTIFY("",((TIUFWD-80)/2)),$$MIXED^TIULS($$NOW^TIULO),$JUSTIFY("",10+((TIUFWD-80)/2)),"Page: ",$JUSTIFY(TIUFPGE,4)," of ",$JUSTIFY(TIUFOFPG,4)
+10 WRITE !,TIUFHDR,!
+11 QUIT
+12 ;
FTR ; -- footer to print
+1 NEW PAUSEANS
+2 SET TIUFESC=0
+3 IF $EXTRACT(IOST,1,2)="C-"
DO XPAUSE(.PAUSEANS)
SET TIUFESC='PAUSEANS
+4 QUIT
+5 ;
XPAUSE(Y) ; Pause with ^ to exit; omits carriage return that scrolls top line off
+1 NEW DIR,X,DA
+2 WRITE !
SET DIR(0)="E"
DO ^DIR
+3 QUIT
+4 ;
PAGE(BEG,LINES) ; -- calc page #
+1 ; Requires TIUFAR
+2 SET BEG=$SELECT($DATA(@TIUFAR@(BEG,0)):BEG,1:0)
+3 QUIT (BEG\LINES)+((BEG#LINES)>0)
+4 ;
SAVE ; -- save to queue for PRTL
+1 ; TIU*1*99: add VALM(, VALMCC to list:
+2 FOR X="TIUFSTMP","TIUFTMPL","TIUFXNOD","VALMDDF","TIUFWD","TIUF(","VALM(","VALMCC","VALMLFT","VALMWD","VALMCNT","VALMHDR(","TIUFWHO","TIUFANS","TIUFCAP","RMSUFFIX"
SET ZTSAVE(X)=""
+3 FOR X="TIUFAR",$EXTRACT(TIUFAR,1,$LENGTH(TIUFAR)-1)_","
SET ZTSAVE(X)=""
+4 QUIT
+5 ;
