source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5C.m@ 1766

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

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1GMRCP5C ;SLC/DCM,RJS - Print Consult form 513 (Assemble Segments And Print) ;4/30/98 09:41
2 ;;3.0;CONSULT/REQUEST TRACKING;**4**;Dec 27, 1997
3 ;
4 Q
5 ;
6ASSMBL(PAGELEN,PAGEWID) ;
7 ;
8 N GMRCHDR,GMRCPG,SUB,GMRCPAGE,GMRCDVL
9 ;
10 S GMRCDVL="",$P(GMRCDVL,"-",PAGEWID+1)=""
11 S ^TMP("GMRC",$J,"SF513")=$G(PAGELEN)
12 S GMRCPG=1,GMRCHDR=""
13 D CLRZONE(0)
14 D MERGE("HDR",0,1)
15 D MERGE("FTR",0,5)
16 ;
17 ;REQ add reason for request segment
18 ;
19 D FORMAT("REQ",PAGELEN,PAGEWID,2)
20 ;
21 ;PDIAG add provisional diagnosis segment
22 ;
23 D FORMAT("PDIAG",PAGELEN,PAGEWID,$$SIZE("PDIAG",1)+1)
24 ;
25 ;RES add tiu results segment
26 ;
27 D FORMAT("RES",PAGELEN,PAGEWID,6)
28 ;
29 ;ADD add addendum segment
30 ;
31 D FORMAT("ADD",PAGELEN,PAGEWID,4)
32 ;
33 ;SREP add service report segment
34 ;
35 D FORMAT("SREP",PAGELEN,PAGEWID,5)
36 ;
37 ;COM add comments segment
38 ;
39 D FORMAT("COM",PAGELEN,PAGEWID,5)
40 ;
41 I $D(GMRCPAGE(300000)) D OUTPUT(GMRCPG)
42 ;
43 Q
44 ;
45FORMAT(SUB,PAGELEN,PAGEWID,OFFSET) ;
46 ;
47 N LN,NDX
48 ;
49 I $$CHKPAGE("",0,PAGELEN,OFFSET) D CLRZONE(2)
50 I $O(^TMP("GMRC",$J,"OUTPUT",SUB,0)),$D(GMRCPAGE(300000)),'(SUB="RES") D BLDPAGE(3,GMRCDVL,PAGEWID)
51 ;
52 S NDX=0 F S NDX=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX)) Q:'NDX D
53 .I $$CHKPAGE(SUB,NDX,PAGELEN,OFFSET) D CLRZONE(2)
54 .D NEWSUB("F",SUB,NDX,PAGEWID)
55 .S LN=0 F S LN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN)) Q:'LN D
56 ..I $$CHKPAGE(SUB,NDX,PAGELEN,2)
57 ..D BLDPAGE(3,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,1)),SUB,NDX)
58 .D BLDPAGE(3," ",PAGEWID,"",SUB,NDX)
59 .D ADDFTR(SUB,NDX,PAGEWID)
60 ;
61 Q
62 ;
63NEWSUB(ZONE,SUB,NDX,PAGEWID) ;
64 ;
65 N FLN,NZONE
66 ;
67 S:(ZONE="H") NZONE=2
68 S:(ZONE="F") NZONE=4
69 Q:'$G(NZONE)
70 D CLRZONE(NZONE)
71 ;
72 S FLN=0 F S FLN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,FLN)) Q:'FLN D
73 .D BLDPAGE(NZONE,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,FLN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,FLN,1)),SUB,NDX)
74 Q
75 ;
76ADDFTR(SUB,NDX,PAGEWID) ;
77 ;
78 N FLN
79 D CLRZONE(4)
80 S FLN=0 F S FLN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,"F",FLN)) Q:'FLN D
81 .D BLDPAGE(3,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,"F",FLN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,"F",FLN,1)),SUB,NDX)
82 Q
83 ;
84NEWPAGE(SUB,NDX) ;
85 ;
86 N GMRCHDR
87 ;
88 D OUTPUT(GMRCPG)
89 ;
90 S GMRCPG=GMRCPG+1
91 D MERGE("HDR",1,1)
92 D MERGE("FTR",1,5)
93 ;
94 I $L(SUB) D NEWSUB("H",SUB,NDX,PAGEWID)
95 Q
96 ;
97CHKPAGE(SUB,NDX,PAGELEN,OFFSET) ;
98 ;
99 I ($$ROOM(PAGELEN)<OFFSET) D NEWPAGE(SUB,NDX) Q 1
100 Q 0
101 ;
102SIZE(SUB,NDX) ;
103 ;
104 Q $O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
105 ;
106ROOM(LEN) ;
107 ;
108 N LN,SIZE
109 S LN=0 F SIZE=0:1 S LN=$O(GMRCPAGE(LN)) Q:'LN
110 Q (LEN-SIZE-1)
111 ;
112MERGE(SUB,NDX,ZONE) ;
113 ;
114 N LN
115 S LN=0 F S LN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN)) Q:'LN D
116 .D BLDPAGE(ZONE,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,1)),SUB,NDX)
117 Q
118 ;
119BLDPAGE(ZONE,TEXT,PAGEWID,RUNTIME,SUB,NDX) ;
120 ;
121 N GMRCX,GMRCL,GMRCR1,GMRCR2,PTR,WORD
122 ;
123 I ($L(TEXT)<PAGEWID) D ADDLN(ZONE,TEXT,$G(RUNTIME)) Q
124 ;
125 F PTR=1:1 Q:(PTR>$L(TEXT," ")) I ($L($P(TEXT," ",PTR))>PAGEWID) D
126 .S WORD=$P(TEXT," ",PTR)
127 .S WORD=$E(WORD,1,PAGEWID)_" "_$E(WORD,(PAGEWID+1),$L(WORD))
128 .S $P(TEXT," ",PTR)=WORD,PTR=1
129 ;
130 F PTR=2:1:$L(TEXT," ") Q:'$L(TEXT) I ($L($P(TEXT," ",1,PTR))>PAGEWID) D
131 .I (ZONE=3),$$CHKPAGE(SUB,NDX,PAGELEN,2)
132 .S (GMRCR1,GMRCR2)=""
133 .I $L(RUNTIME) D
134 ..S GMRCL=$L($P(TEXT," ",1,PTR-1))
135 ..F GMRCX=1:2:$L(RUNTIME,",") D
136 ...I ($P(RUNTIME,",",GMRCX+1)>GMRCL) D I 1
137 ....S:$L(GMRCR2) GMRCR2=GMRCR2_","
138 ....S GMRCR2=GMRCR2_$P(RUNTIME,",",GMRCX)_","_($P(RUNTIME,",",GMRCX+1)-GMRCL)
139 ...E D
140 ....S:$L(GMRCR1) GMRCR1=GMRCR1_","
141 ....S GMRCR1=GMRCR1_$P(RUNTIME,",",GMRCX,GMRCX+1)
142 .D ADDLN(ZONE,$P(TEXT," ",1,PTR-1),GMRCR1)
143 .S TEXT=$P(TEXT," ",PTR,$L(TEXT," ")),PTR=1,RUNTIME=GMRCR2
144 I $L(TEXT) S:(ZONE=3) GMRCX=$$CHKPAGE($G(SUB),$G(NDX),PAGELEN,2) D ADDLN(ZONE,TEXT,$G(RUNTIME))
145 Q
146 ;
147ADDLN(ZONE,TEXT,RUNTIME) ;
148 ;
149 N NEXTLN
150 I '$D(GMRCPAGE(ZONE*100000)) S GMRCPAGE(ZONE*100000,0)=TEXT Q
151 S NEXTLN=$O(GMRCPAGE(ZONE*100000+99999),-1)+1
152 S GMRCPAGE(NEXTLN,0)=TEXT
153 S:$L($G(RUNTIME)) GMRCPAGE(NEXTLN,1)=RUNTIME
154 Q
155 ;
156OUTPUT(GMRCPG) ;
157 ;
158 N LN,LN1,NEXT,ZONE,VAR,PTR
159 S LN=0 F S LN=$O(GMRCPAGE(LN)) Q:'LN I $O(GMRCPAGE(LN,0)) D
160 .S LN1=0 F S LN1=$O(GMRCPAGE(LN,LN1)) Q:'LN1 D
161 ..S VAR=$G(GMRCPAGE(LN,LN1)) Q:'$L(VAR)
162 ..S PTR=$P(VAR,",",2),VAR=$P(VAR,",",1)
163 ..I PTR,$L(VAR),($D(@VAR)#2) S $E(GMRCPAGE(LN,0),PTR+1,PTR+1+$L(@VAR))=@VAR
164 ;
165 S NEXT=$O(^TMP("GMRC",$J,"SF513"," "),-1)+1
166 M ^TMP("GMRC",$J,"SF513",NEXT)=GMRCPAGE
167 F ZONE=1,2,3,5 D CLRZONE(ZONE)
168 Q
169 ;
170CLRZONE(ZONE) ;
171 ;
172 ; Zone 1 = Header
173 ; Zone 2 = SubHeader (Continuation Information)
174 ; Zone 3 = Body of the Consult
175 ; Zone 4 = SubFooter (Signature Information)
176 ; Zone 5 = Footer
177 ;
178 I '$G(ZONE) K GMRCPAGE Q
179 N LN,STLN,ENDLN
180 S STLN=100000*ZONE,ENDLN=STLN+99999
181 S LN=STLN D F S LN=$O(GMRCPAGE(LN)) Q:'LN Q:(LN>ENDLN) D
182 .K GMRCPAGE(LN)
183 Q
184 ;
185PRINT(PAGELEN,PAGEWID) ; Print the Consult
186 ;
187 N GMRCPAGE,LN,LN1,VAR,PAGE,PAUSE,PTR,ROOM,LNCNT
188 ;
189 S PAGE=0 F S PAGE=$O(^TMP("GMRC",$J,"SF513",PAGE)) Q:'PAGE D Q:(PAUSE[U)
190 .W:(PAGE>1) @IOF
191 .K GMRCPAGE M GMRCPAGE=^TMP("GMRC",$J,"SF513",PAGE)
192 .S ROOM=$$ROOM(PAGELEN)
193 .I (ROOM<100) F LN=1:1:ROOM D BLDPAGE(3," ",PAGEWID)
194 .S GMRCPG=PAGE_" of "_$O(^TMP("GMRC",$J,"SF513"," "),-1)
195 .S LN=0 F LNCNT=0:1 S LN=$O(GMRCPAGE(LN)) Q:'LN D
196 ..S LN1=0 F S LN1=$O(GMRCPAGE(LN,LN1)) Q:'LN1 D
197 ...S VAR=$G(GMRCPAGE(LN,LN1)) Q:'$L(VAR)
198 ...S PTR=$P(VAR,",",2),VAR=$P(VAR,",",1)
199 ...I PTR,$L(VAR),($D(@VAR)#2) D
200 ....S $E(GMRCPAGE(LN,0),PTR+1,PTR+1+$L(@VAR))=@VAR
201 ..W !,$G(GMRCPAGE(LN,0))
202 .;
203 .S PAUSE=0
204 .S:$O(^TMP("GMRC",$J,"SF513",PAGE)) PAUSE=PAUSE+1
205 .S:$O(^TMP("GMRC",$J,"SF513",PAGE),-1) PAUSE=PAUSE+10
206 .S PAUSE=$$PAUSE(PAUSE,PAGE)
207 .S:(PAUSE["-") PAGE=PAGE-2
208 ;
209 Q
210 ;
211PAUSE(PF,PG) ; Pause After Each Screen for CRT's
212 ;
213 N X,C
214 Q:'$$CRT ""
215 ;
216 W !," Press: "
217 ;
218 I (PF=00) W "<Enter> To Quit (^) To Quit : "
219 I (PF=01) W "<Enter> For Next Page (^) To Quit : "
220 I (PF=10) W "<Enter> To Quit (-) For Previous Page (^) To Quit : "
221 I (PF=11) W "<Enter> For Next Page (-) For Previous Page (^) To Quit : "
222 ;
223 R X:DTIME E W " (timeout)" Q U
224 W !
225 Q X
226 ;
227CRT() ; IS THE PRINT DEVICE A CRT ?
228 Q:TIUFLG 0 Q ($E(IOST,1,2)="C-")
229 ;
Note: See TracBrowser for help on using the repository browser.