TIUFPR.m

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

 ;

EXTRACT(X) ; -- extract string

 ; 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 ---TIUFPR   4861     printed  Mar 13, 2025@21:46:15                                                                                                                                                                                                      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      ;

EXTRACT(X) ; -- extract string

 +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       ;