source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFPR.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1TIUFPR ;SLC/MAM - Action Print List ;;3/7/00
2 ;;1.0;TEXT INTEGRATION UTILITIES;**2,8,99**;Jun 20, 1997
3 ;
4CAPTION(RMSUFFIX) ; -- set up caption line of header
5 N X,COL,FLD
6 S $P(X," ",TIUF("RM"_RMSUFFIX)+1)=""
7 S COL="" F S COL=$O(VALMDDF(COL)) Q:COL="" S FLD=VALMDDF(COL) D
8 .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)))
9 Q X
10 ;
11TBAR(RMSUFFIX) ; -- print caption/top bar
12 ; Needs TIUFWD,TIUFCAP,RMSUFFIX
13 N X
14 D CRT(0,2)
15 S TIUFCAP=" "_$E(TIUFCAP,2,TIUF("RM"_RMSUFFIX))
16 S X=$E(TIUFCAP,1,VALM("FIXED"))_$E(TIUFCAP,VALMLFT,VALMLFT+TIUFWD-1-VALM("FIXED"))
17 W:"DX"'[$G(TIUFSTMP) ! W X
18 Q
19 ;
20CRT(DX,DY) ;
21 I DX'<0,DY'<0,$E(IOST,1,2)="C-" W $C(13) X IOXY
22 Q
23 ;
24PRTL ; 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.
25 N DIR,DA,X,Y,TIUFANS,TIUFAR,TIUFCAP,RMSUFFIX,WHO,DTOUT,DIRUT,DIROUT
26 S WHO=$S(TIUFWHO="N":"M",1:TIUFWHO)
27 S TIUFAR=$S($G(TIUFSTMP)="D"!($G(TIUFSTMP)="X"):"^TMP(""TIUF3"",$J)",$G(TIUFSTMP)="T":"^TMP(""TIUF2"",$J)",1:"^TMP(""TIUF1"",$J)")
28 S RMSUFFIX=$S($D(TIUFSTMP):TIUFSTMP,1:TIUFTMPL),RMSUFFIX=RMSUFFIX_$S("TD"'[RMSUFFIX:WHO,1:"")
29 S TIUFCAP=$$CAPTION(RMSUFFIX)
30 D:VALMCC FULL^VALM1
31 S DIR("?",1)="You can print only those columns that appear on this screen, or you can print"
32 S DIR("?")="ALL columns including those you see by scrolling to the right"
33 D I $D(DIRUT) G PRTLX
34 . K DIRUT I $G(TIUFSTMP)="D" S TIUFANS=1 Q
35 . S DIR(0)="Y",DIR("A")=$S($G(TIUFSTMP)="":"Print Name and Type Only",1:"Print Item and Sequence Only"),DIR("B")="YES"
36 . I $G(TIUFSTMP)="",VALMLFT=49 D ^DIR S TIUFANS=Y Q
37 . I $G(TIUFSTMP)="T",VALMLFT=32 D ^DIR S TIUFANS=Y Q
38 . S TIUFANS=1
39 S %ZIS="Q" D ^%ZIS I POP G PRTLX
40 I '$D(IO("Q")),IO=IO(0) D CLEAR^VALM1 S X=0 X ^%ZOSF("RM")
41 I '$D(IO("Q")) G PRTL1
42 S ZTRTN="PRTL1^TIUFPR",ZTIO=ION,ZTDESC="TIUF Print List -- List Manager Action"
43 D SAVE,^%ZTLOAD G PRTLX
44 ;
45PRTL1 ;
46 N TIUFWD,TIUFPGE,TIUFLNS,TIUFHDR,NOSCRNS,NOPGES,TIUFOFPG,TIUFJ,FIRST,LAST,TIUFESC
47 S TIUFWD=IOM,TIUFPGE=1,TIUFLNS=IOSL-6
48 S TIUFHDR=VALMHDR(1),TIUFESC=0
49 I TIUFANS S NOSCRNS=1
50 E S NOSCRNS=$S($G(TIUFSTMP)="T":2,1:4)
51 S NOPGES=$$PAGE(VALMCNT,TIUFLNS),TIUFOFPG=NOPGES*NOSCRNS
52 U IO
53 F TIUFJ=1:1:NOPGES D Q:TIUFESC
54 . S FIRST=TIUFLNS*(TIUFJ-1)+1,LAST=FIRST+TIUFLNS-1
55 . D COLUMNS(FIRST,LAST,NOSCRNS,.TIUFPGE,RMSUFFIX)
56PRTLX S VALMBCK="R" N IOSTBM D ^%ZISC D TERM S X=0 X ^%ZOSF("RM")
57 I $D(ZTQUEUED) S ZTREQ="@"
58 I $D(DTOUT) S VALMBCK="Q"
59 Q
60 ;
61TERM ; -- set up term characteristics
62 D HOME^%ZIS
63 S X="IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF;IOBON;IOBOFF;IOSGR0" D ENDR^%ZISS
64 Q
65 ;
66COLUMNS(FIRST,LAST,NOSCRNS,TIUFPAGE,RMSUFFIX) ; Writes columns for LM entries FIRST through LAST;
67 ; Returns the display back to far left before quitting.
68 ; 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.
69 N TIUFI,LINENO,TEXT
70 ;TIUFESC is newed in PRTL; DON'T new it here.
71 S TIUFESC=0
72 F TIUFI=1:1:NOSCRNS D Q:TIUFESC
73 . D HDR,TBAR(RMSUFFIX)
74 . F LINENO=FIRST:1:LAST Q:LINENO>VALMCNT Q:TIUFESC S TEXT=$$EXTRACT($G(@TIUFAR@(LINENO,0))) W !,TEXT
75 . D FTR
76 . Q:TIUFESC
77 . D:NOSCRNS>1 RIGHT^TIUFL1("0^0^PL")
78 . S TIUFPGE=TIUFPGE+1
79 . Q
80 D:NOSCRNS>1 LEFT^TIUFL1("0^0^PL")
81 Q
82 ;
83EXTRACT(X) ; -- extract string
84 ; Requires TIUFWD
85 Q $S(X="":X,1:$E($E(X,1,+VALM("FIXED"))_$E(X,VALMLFT,VALMLFT+TIUFWD-1-VALM("FIXED"))_$J("",TIUFWD),1,TIUFWD))
86 ;
87HDR ; -- prt/display header
88 ; Requires TIUFHDR, TIUFWD, TIUFPGE, TIUFIOFPG, TIUFAR, TITLE
89 N X,I,DX,DY,TITLE
90 ; -- prt hdr line
91 W @IOF
92 I $E(IOST,1,2)="C-" S DX=0,DY=0 X IOXY ; -- position cursor
93 S TITLE=$S('$D(VALM("TITLE")):$E($P(TIUFNOD0,U),1,30),1:VALM("TITLE"))
94 W $J(" ",30-$L(TITLE))
95 I $E(IOST,1,2)="C-" W $C(13) S DX=30,DY=0 X IOXY ; -- position cursor
96 W $J("",((TIUFWD-80)/2)),$$MIXED^TIULS($$NOW^TIULO),$J("",10+((TIUFWD-80)/2)),"Page: ",$J(TIUFPGE,4)," of ",$J(TIUFOFPG,4)
97 W !,TIUFHDR,!
98 Q
99 ;
100FTR ; -- footer to print
101 N PAUSEANS
102 S TIUFESC=0
103 I $E(IOST,1,2)="C-" D XPAUSE(.PAUSEANS) S TIUFESC='PAUSEANS
104 Q
105 ;
106XPAUSE(Y) ; Pause with ^ to exit; omits carriage return that scrolls top line off
107 N DIR,X,DA
108 W ! S DIR(0)="E" D ^DIR
109 Q
110 ;
111PAGE(BEG,LINES) ; -- calc page #
112 ; Requires TIUFAR
113 S BEG=$S($D(@TIUFAR@(BEG,0)):BEG,1:0)
114 Q (BEG\LINES)+((BEG#LINES)>0)
115 ;
116SAVE ; -- save to queue for PRTL
117 ; TIU*1*99: add VALM(, VALMCC to list:
118 F X="TIUFSTMP","TIUFTMPL","TIUFXNOD","VALMDDF","TIUFWD","TIUF(","VALM(","VALMCC","VALMLFT","VALMWD","VALMCNT","VALMHDR(","TIUFWHO","TIUFANS","TIUFCAP","RMSUFFIX" S ZTSAVE(X)=""
119 F X="TIUFAR",$E(TIUFAR,1,$L(TIUFAR)-1)_"," S ZTSAVE(X)=""
120 Q
121 ;
Note: See TracBrowser for help on using the repository browser.