source: WorldVistAEHR/trunk/r/LIST_MANAGER-VALM/VALM1.m@ 700

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

initial load of WorldVistAEHR

File size: 4.7 KB
RevLine 
[613]1VALM1 ;ALB/MJK - Screen Manipulation Utilities ;06/27/2006
2 ;;1.0;List Manager;**5,6,8**;Aug 13, 1993;Build 1
3INSTR(STR,X,Y,LENGTH,ERASE) ; -- insert text
4 ; STR := string to insert
5 ; X := X coordinate
6 ; Y := Y coordinate
7 ; LENGTH := clear # of characters
8 ; ERASE := erase chars first
9 W IOSC
10 I $G(ERASE) S DY=Y-1,DX=X-1 X IOXY W $J("",LENGTH)
11 S DY=Y-1,DX=X-1 X IOXY W STR
12 W IORC
13 Q
14FLDUPD(STR,FLD,LINE,CON,COFF) ; -- update entry and field on screen
15 ; STR := string to insert
16 ; FLD := col name
17 ; LINE := entry # in list
18 D INSTR(.STR,+$P(VALMDDF(FLD),U,2),LINE-VALMBG+VALM("TM"),$P(VALMDDF(FLD),U,3),1)
19 Q
20SETFLD(STR,VAR,FLD) ; -- set field in var
21 ; input: STR := string to insert
22 ; VAR := destination string
23 ; FLD := col name
24 Q $$SETSTR(STR,VAR,+$P(VALMDDF(FLD),U,2),+$P(VALMDDF(FLD),U,3))
25SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
26 ; S := string to insert
27 ; V := destination string
28 ; X := insert @ col X
29 ; L := clear # of chars (length)
30 Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
31FULL ; set full scrolling region
32 I '$D(IOSTBM) D TERM^VALM0
33 I IOSTBM]"" S IOTM=1,IOBM=IOSL W IOSC W @IOSTBM W IORC
34 S X=VALMWD X ^%ZOSF("RM")
35 Q
36CLEAR ; -- clear screen
37 D FULL,ERASE W @IOF
38 Q
39ERASE ;
40 W $G(VALMSGR),$G(IOSGR0)
41 Q
42FDATE(Y) ; -- return formatted date
43 ; input: Y := field name
44 ; output: [returned] := formatted date only
45 Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
46FTIME(Y) ; -- return formatted date/time
47 ; input: Y := internal date/time
48 ; output: [returned] := formatted date and time
49 D DD^%DT
50 Q Y
51FDTTM(Y) ; -- return formatted date/time
52 ; input: Y := internal date/time
53 ; output: [returned] := formatted date and time
54 N VALMY
55 S VALMY=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
56 D DD^%DT
57 Q VALMY_$S($P(Y,"@",2)]"":"@"_$P(Y,"@",2),1:"")
58NOW() ; -- return now
59 D NOW^%DTC
60 Q $$FTIME(%)
61RANGE ; -- change date range
62 G RANGE^VALM11
63WAIT ; "Enter RETURN to continue"
64 N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
65 W ! S DIR(0)="E" S DIR("A")="Enter RETURN to continue" D ^DIR W !
66 Q
67GOON() ; "Enter RETURN to continue or '^' to exit"
68 N DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
69 W ! S DIR(0)="E" D ^DIR W !
70 Q +Y
71PAUSE ;
72 W ! S DIR(0)="E" D ^DIR K DIR W !
73 Q
74PRT ; -- prt screen (PS)
75 N VALMESC
76 S VALMBCK="R"
77 D:VALMCC FULL
78 S %ZIS="Q" D ^%ZIS G PRTQ:POP
79 I $D(IO("Q")) D G PRTQ
80 . S ZTRTN="PRTS^VALM1",ZTDESC="List Manager: Print Screen"
81 . D SAVE,^%ZTLOAD
82 I IO=IO(0) D CLEAR S X=0 X ^%ZOSF("RM")
83 ; fall through
84PRTS ;
85 N VALMCC,VALMCAP
86 I $D(ZTQUEUED) S ZTREQ="@"
87 S VALMCC=0,VALMCAP=$$CAPTION^VALM,VALMPG1=1
88 U IO D HDR^VALM,TBAR^VALM,LIST^VALM,LBAR^VALM,FTR
89 ; fall through
90PRTQ ;
91 D CHKLONG
92 D:'$D(ZTQUEUED) ^%ZISC
93 D TERM^VALM0 S X=0 X ^%ZOSF("RM")
94 Q
95SAVE ; -- save to queue
96 F X="VALMIOXY","VALMEVL","VALMLFT","VALMPGE","VALMWD","VALMCNT","VALMBG","VALMDDF(","VALMHDR(","VALM(" S ZTSAVE(X)=""
97 F X="VALMAR",$S($E(VALMAR,$L(VALMAR))=")":$E(VALMAR,1,$L(VALMAR)-1)_",",1:VALMAR_"(") S ZTSAVE(X)=""
98 Q
99FTR ; -- footer to print
100 S VALMESC=""
101 I $E(IOST,1,2)="C-" S VALMESC='$$GOON
102 Q
103PRTL ; -- prt list (PL)
104 I $G(VALM("PRT"))]"",$O(^ORD(101,"B",VALM("PRT"),0)) S X=$O(^(0))_";ORD(101," D EN^XQOR G PRTQ
105 N VALMESC
106 S VALMBCK="R"
107 D:VALMCC FULL
108 S %ZIS="Q" D ^%ZIS G PRTQ:POP
109 I $D(IO("Q")) D G PRTLQ
110 . S ZTRTN="PRTLS^VALM1",ZTDESC="List Manager: Print List"
111 . D SAVE,^%ZTLOAD
112 I IO=IO(0) D CLEAR S X=0 X ^%ZOSF("RM")
113 ; fall through
114PRTLS ;
115 N VALMPGE,VALMESC,VALMCC,VALMI,VALMLNS,VALMCAP,VALMWD
116 I $D(ZTQUEUED) S ZTREQ="@"
117 S VALMWD=IOM,VALMLNS=VALM("LINES"),VALMPG1=1
118 S VALM("LINES")=IOSL-(VALM("TM")+3),VALMCC=0,VALMPGE=1,VALMCAP=$$CAPTION^VALM
119 U IO D HDR^VALM,TBAR^VALM
120 F VALMI=1:1:VALMCNT S X=$G(@VALMAR@($$GET^VALM4(VALMI),0)) W !,X I IOSL<($Y+6) D FTR G PRTLQ:VALMESC S VALMPGE=VALMPGE+1 D HDR^VALM,TBAR^VALM
121 D FTR
122 ; fall through
123PRTLQ ;
124 D CHKLONG
125 D:'$D(ZTQUEUED) ^%ZISC
126 D TERM^VALM0 S X=0 X ^%ZOSF("RM")
127 S:$D(VALMLNS) VALM("LINES")=VALMLNS
128 Q
129CHKLONG ;
130 Q:'$$TOOLONG
131 I '$D(ZTQUEUED) S VALMSG="Some printed item lines may have been truncated." Q:IO(0)=IO!$D(IO("Q"))
132 Q:$E(IOST,1,2)="C-"
133 I $Y+4>IOSL W @IOF
134 E W !
135 W !,">>> Warning: Some list items lines may have been truncated."
136 W !,">>> This list requires ",VALM("RM")," characters/line."
137 W !,">>> This device supports ",IOM," characters/line."
138 Q
139TOOLONG() ; Is the line length too long for the device?
140 Q:'$D(VALM("RM")) 0
141 Q:'$D(IOM) 0
142 Q $S(VALM("RM")>IOM:1,1:0)
143UPPER(X) ; -- convert to uppercase
144 Q $$UP^XLFSTR(X)
145LOWER(X) ;
146 N Y,C,Z,I
147 S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
148 F C=" ",",","/" S I=0 F S I=$F(Y,C,I) Q:'I S Y=$E(Y,1,I-1)_$TR($E(Y,I),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(Y,I+1,999)
149 Q Y
Note: See TracBrowser for help on using the repository browser.