source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5.m@ 701

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1GMRCP5 ;SLC/DCM,RJS - Print Consult form 513 (main entry) ;5/14/98 11:09
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,13,12**;Dec 27, 1997
3 ;
4TIUEN(GMRCIEN) ;Entry point for TIU to print 513
5 ;
6 N GMRCPLEN,GMRCTASK,GMRCX
7 ;
8 F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
9 F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
10 ;
11 Q:'+GMRCIEN D PRNT^GMRCP5A(GMRCIEN,1,0,"",0)
12 ;
13 Q
14 ;
15GUI(ROOT,GMRCIFN) ;Entry point into routine for the GUI
16 ;
17 ; GMRCIFN = IFN of the record from file 123.
18 ;
19 N GMRCCPY,GMRCPLEN,GMRCX
20 ;
21 S GMRCPLEN=99998
22 S GMRCCPY="W"
23 F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
24 F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
25 ;
26 D PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,GMRCPLEN)
27 ;
28 S ROOT=$NA(^TMP("GMRC",$J,"SF513"))
29 ;
30 Q
31 ;
32EN(GMRCIFN,GMRCCPY,GMRCDEV,GMRCSTAT) ;Entry point into routine -GMRCIFN=IFN from file 123
33 ;GMRCIFN = IFN of the record from file 123.
34 ;
35 N GMRCPLEN,GMRCTASK
36 ;
37 S GMRCSTAT=0
38 F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
39 F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
40 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
41 ;
42 I $D(GMRCDEV) D Q
43 .S GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY,GMRCDEV)
44 .I GMRCTASK S GMRCSTAT="0^Queued as task # "_GMRCTASK
45 .E S GMRCSTAT="-1^Not Queued"
46 ;
47 I '$D(GMRCCPY) S GMRCCPY=$$CCOPY Q:(GMRCCPY=U)
48 Q:'$$DEVICE
49 ;
50 I $D(IO("Q")) D Q
51 .S GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY)
52 .I GMRCTASK S GMRCSTAT="0^Queued as task # "_GMRCTASK
53 .E S GMRCSTAT="-1^Not Queued"
54 .W " ",$P(GMRCSTAT,U,2) H 2
55 ;
56 D PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,0)
57 ;
58 Q
59 ;
60SEL ;Select the consult/request to print
61 K GMRCQUT,DTOUT,DIRUOUT,GMRCSEL
62 I '$D(^TMP("GMRCR",$J,"CS","AD")) W $C(7),!,"No Orders To Print!",! S GMRCQUT=1 Q
63 I $D(GMRC("NMBR")) S GMRCSEL=GMRC("NMBR") I $S(GMRCSEL<1:1,GMRCSEL>BLK:1,1:0) K GMRCSEL D AGAIN^GMRCSLMV(GMRC("NMBR"))
64 I '$O(^TMP("GMRCR",$J,"CS","AD")),BLK=1 S GMRCSEL=BLK
65 I $S('$D(GMRCSEL):1,'$L(GMRCSEL):1,1:0) D SEL^GMRCA2 I $D(DTOUT)!($D(DIRUOUT)) S GMRCQUT=1 Q
66 I $S(GMRCSEL<1:1,GMRCSEL>BLK:1,GMRCSEL="":1,1:0) W $C(7),!,"Select A Number In The Range 1 To "_BLK G SEL
67 I GMRCSEL="" S GMRCQUT=1 Q
68 S GMRCND=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
69 I $S('$L(GMRCND):1,1:0) S GMRCMSG="The Consult to print is not defined in the list to select from!" D EXAC^GMRCADC(GMRCMSG) S GMRCQUT=1 Q
70 Q
71 ;
72QUEUE(GMRCIFN,GMRCCPY,GMRCDEV) ;
73 ;
74 N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
75 N ZTSAVE,ZTSK,ZTUCI
76 ;
77 S ZTDESC="CONSULT/REQUEST PACKAGE PRINT FORM 513"
78 ;
79 I $D(GMRCDEV) S ZTIO=GMRCDEV
80 E S ZTIO=ION
81 ;
82 S ZTDTH=$H
83 S ZTRTN="PRNT^GMRCP5A("_(+GMRCIFN)_",0,1,"""_(GMRCCPY)_""",0)"
84 D ^%ZTLOAD
85 D:'$D(GMRCDEV) ^%ZISC
86 ;
87 Q $G(ZTSK)
88 ;
89CCOPY() ; Determine if this is a "Chart" copy or a "Working" copy
90 ;
91 N GMRCSTAT,GMRCX,GMRCDEF
92 ;
93 ; GMRCDEF=1 CHART
94 ; GMRCDEF=0 WORKING
95 ;
96 S GMRCSTAT=$G(^GMR(123,GMRCIFN,0)) Q:'$L(GMRCSTAT) ""
97 S GMRCSTAT=$P(GMRCSTAT,U,12)
98 S GMRCDEF=(GMRCSTAT=2)
99 ;
100 F D Q:$L(GMRCX)
101 .;
102 .W !,$$COPY(GMRCDEF)_" Copy (Y/N)? Y//"
103 .R GMRCX:DTIME E S GMRCX=U
104 .Q:(GMRCX[U)
105 .;
106 .S:'$L(GMRCX) GMRCX="Y"
107 .S GMRCX=$E(GMRCX,1)
108 .S GMRCX=$TR(GMRCX,"ynwc","YNWC")
109 .;
110 .I '("YNWC"[GMRCX) S GMRCX="?"
111 .;
112 .I GMRCX["?" D S GMRCX="" Q
113 ..W !
114 ..W !," Type 'Y' To Print A '"_$$COPY(GMRCDEF)_"' Copy Of The Form 513,"
115 ..W !," or Type 'N' To Print A '"_$$COPY('GMRCDEF)_"' Copy Of The Form 513,"
116 ..W !," or Type 'C' To Print A 'Chart' Copy Of The Form 513,"
117 ..W !," or Type 'W' To Print A 'Working' Copy Of The Form 513."
118 ..W !
119 ;
120 I (GMRCX="Y") Q $E($$COPY(GMRCDEF),1)
121 I (GMRCX="N") Q $E($$COPY('GMRCDEF),1)
122 Q GMRCX
123 ;
124COPY(X) Q:X "Chart" Q "Working"
125 ;
126DEVICE() ;Ask output device / set up output device print parameters
127 N POP,%ZIS,%IS
128 S POP=0,%ZIS="MQ" D ^%ZIS
129 Q $S(POP:0,IO="":0,1:1)
130 ;
131 ;
132SETUP ;
133 ;
134 N LINE,%ZIS,%IS,POP,IOP
135 ;
136 W !!,"Print consults printer setup page.",!
137 K IOP S %ZIS="MQ" D ^%ZIS Q:POP
138 ;
139 I $D(IO("Q")) D Q
140 .;
141 .N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
142 .N ZTSAVE,ZTSK,ZTUCI
143 .;
144 .S ZTDESC="CONSULT/REQUEST PACKAGE PRINTER TEST PAGE"
145 .S ZTIO=ION,ZTDTH=$H,ZTRTN="SETPRNT^GMRCP5"
146 .S ZTSAVE("DUZ")=""
147 .;
148 .D ^%ZTLOAD,^%ZISC
149 .;
150 .I ZTSK W !!,"Queued as task #",ZTSK
151 .E W !!," not queued."
152 ;
153SETPRNT ;
154 I $D(ZTQUEUED) S ZTREQ="@"
155 N LINE
156 U IO D
157 .W @IOF,1
158 .W !,2
159 .W !,3," *******CONSULTS PRINT SETUP PAGE*******"
160 .W !,4
161 .W !,5,?4,$$REPEAT^XLFSTR("*",70)
162 .W !,6,?4," Printed by: ",$$GET1^DIQ(200,+$G(DUZ),.01)," on "
163 .W $$FMTE^XLFDT($$NOW^XLFDT)
164 .W !,7,?4,$$REPEAT^XLFSTR("*",70)
165 .W !,8
166 .W !,9," Print Device: ",$G(ION)
167 .W !,10," Terminal Type: ",$G(IOST)
168 .W !,11," Defined lines per page for this device: ",+$G(IOSL)
169 .W !,12," Defined margin width for this device: ",+$G(IOM)
170 .W !,13
171 .W !,14," There should be numbers listed down the lefthand side of"
172 .W !,15," this page all the way to the bottom. The number at the"
173 .W !,16," bottom of the page is the number of lines the PRINTER"
174 .W !,17," thinks there are on a page. The COMPUTER thinks there are ",+$G(IOSL)
175 .W !,18," lines on a page. The number at the bottom of the page needs to"
176 .W !,19," be EQUAL to ",+$G(IOSL)," so the consults program can print"
177 .W !,20," without running off the end of the page. If the number at the"
178 .W !,21," bottom of the page is NOT EQUAL to ",+$G(IOSL)," then have"
179 .W !,22," someone in IRM adjust the"
180 .W !,23
181 .W !,24," DEVICE file (file 3.5) *PAGE LENGTH field (#11)"
182 .W !,25," for device: ",$G(ION)
183 .W !,26
184 .W !,27," and the TERMINAL TYPE file (file 3.2) PAGE LENGTH field (#3)"
185 .W !,28," for terminal type: ",$G(IOST)
186 .W !,29
187 .W !,30," to be a value EQUAL to the number at the bottom of the page."
188 .F LINE=31:1:100 W !,LINE
189 U IO(0) D ^%ZISC
190 ;
191 I $G(ZTSK) D KILL^%ZTLOAD
192 ;
193 Q
Note: See TracBrowser for help on using the repository browser.