source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5A.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 8.8 KB
Line 
1GMRCP5A ;SLC/DCM,RJS,MA - Print Consult form 513 (Gather Data - TIU Results) ;4/18/01 10:29
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,13,12,15,21,22,53**;Dec 27, 1997;Build 3
3 ; Patch #21 added PRNTAUDT to this routine.
4 ;
5PRNT(GMRCIFN,TIUFLG,GMRCQUED,GMRCCPY,GMRCGUI,GMRCAUDT) ;
6 ;
7 ; Input Arguments:
8 ;
9 ; GMRCIFN: IEN of the Consult/Request in file 123
10 ; TIUFLG: Called from TIU ? 1=yes 0=no
11 ; GMRCQUED: Queued job ? 1=yes 0=no
12 ; GMRCCPY: Chart Copy ? C=Chart Copy W=Working Copy null=Not Applicable
13 ; GMRCGUI: Called from the GUI. (Only produce output in a formatted global.)
14 ; GMRCAUDT: Set to 1 in GMRCUTL1 if NW or DC consult.
15 ; ZTIO: Output device when job is tasked
16 ;
17 N GMRCSIG,GMRCSDT,GMRCCSIG,GMRCSIGT,GMRCADDS
18 I '+$G(IOM) S IOM=80
19 ;
20 I GMRCGUI D Q
21 . D FORMAT(80)
22 . D ASSMBL^GMRCP5C(GMRCGUI,80)
23 . F GMRCX="GMRCTIU","RES","MCAR" K ^TMP("GMRCR",$J,GMRCX)
24 . K ^TMP("GMRC",$J,"OUTPUT")
25 . Q
26 ;
27 I 'TIUFLG,'GMRCQUED W @IOF I '$$CRT^GMRCP5C,$L($G(IO(0))),'(IO=IO(0)) U IO(0) W !,"PRINTING... "
28 ;
29 D FORMAT(IOM),ASSMBL^GMRCP5C(IOSL,IOM)
30 U IO
31 D PRINT^GMRCP5C(IOSL,IOM)
32 ;
33 I 'TIUFLG,'$$CRT^GMRCP5C U IO(0) D ^%ZISC
34 ;
35 I $G(GMRCQUED),$G(ZTSK) D KILL^%ZTLOAD
36 ;
37 F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
38 F GMRCX="GMRCTIU","RES","MCAR" K ^TMP("GMRCR",$J,GMRCX)
39 ; If print device (ZTIO) do PRNTAUDT unless there is no GMRCAUDT
40 ; GMRCAUDT=1 means print for NW or DC consult
41 I $D(ZTIO),$D(GMRCAUDT) D PRNTAUDT(GMRCIFN,ZTIO,GMRCAUDT)
42 Q
43 ;
44PRNTAUDT(GMRCIFN,ZTIO,GMRCAUDT) ; Update the last activity field in 123 and
45 ; Processing Activity multiple
46 ; Update the activity log to reflect "Printed To:" and the printer
47 ; GMRCAUDT=1 indicates the consult is NW or Discontinued
48 ; and it should update the audit trail.
49 I $G(GMRCAUDT)'=1 K GMRCAUDT Q
50 N GMRCOM,GMRCORNP,GMRCFF,GMRCPA,GMRCAD,GMRCA,DA,DIE
51 S GMRCA=22
52 S GMRCO=GMRCIFN,GMRCDEV=ZTIO
53 S DIE="^GMR(123,",DA=+GMRCO,DR="9////^S X=GMRCA"
54 L +^GMR(123,GMRCO):5
55 D ^DIE
56 L -^GMR(123,GMRCO)
57 ;Update activity other than HL7 original msg received
58 D AUDIT^GMRCP
59 KILL GMRCO,GMRCA,GMRCDEV
60 Q
61 ;
62FORMAT(PAGEWID) ;
63 ;
64 N %I,CMT,COUNT,D0,DFN,DIC,DIQ2,DR,GLOBAL,GMRC400,GMRCADD,GMRCADDT,GMRCAGE,GMRCCSDT
65 N GMRCCTIT,GMRCDFN,GMRCDOB,GMRCDVL,GMRCELIG,GMRCEQL,GMRCERR,GMRCFAC,GMRCFP
66 N GMRCFTR,GMRCIPH,GMRCINO,GMRCIRL,GMRCLAST,GMRCMODE,GMRCND,GMRCNDX,GMRCNT,GMRCPG,GMRCPGR,GMRCPNM,GMRCPRNM
67 N GMRCPTR,GMRCQSTR,GMRCQSTT,GMRCR0,GMRCR1,GMRCR2,GMRCRB,GMRCRD,GMRCRPT,GMRCSG,GMRCSGAD,GMRCSIGM
68 N GMRCSN,GMRCSR,GMRCSVC,GMRCTO,GMRCUL,GMRCWARD,GMRCWLI,GMRCX,LN,MCFILE,MCPROC
69 N ND,ND1,ND2,NDS,ORACTION,SEX,TAB,X,Y
70 ;
71 S GMRCFTR=13,GMRCFP=0,GMRCPG=0
72 S GMRCRD=$G(^GMR(123,GMRCIFN,0)),(DFN,GMRCDFN)=$P(GMRCRD,U,2)
73 Q:'(DFN)
74 D ELIG^VADPT S GMRCELIG=$P(VAEL(6),U,2) K VAEL
75 S GMRCDVL="",$P(GMRCDVL,"-",PAGEWID+1)=""
76 S GMRCEQL="",$P(GMRCEQL,"=",PAGEWID+1)=""
77 S GMRCUL="",$P(GMRCUL,"_",40)=""
78 S DFN=GMRCDFN D DEM^GMRCU
79 ;
80 S GMRCFAC=+$P(GMRCRD,U,21)
81 I 'GMRCFAC S GMRCFAC=+$G(DUZ(2))
82 I 'GMRCFAC S GMRCFAC=+$$SITE^VASITE()
83 I +GMRCFAC S GMRCFAC=$$GET1^DIQ(4,+GMRCFAC,.01)
84 E S GMRCFAC="" Q
85 ;
86 ; get inter-facility consult info
87 I $P(GMRCRD,U,23) D
88 .S GMRCINO=$P(GMRCRD,U,22)
89 .S GMRCRD(12)=$G(^GMR(123,GMRCIFN,12))
90 .S GMRCRD(13)=$G(^GMR(123,GMRCIFN,13))
91 .S GMRCIRL=$S($P(GMRCRD(12),U,5)="P":"Requesting facility",$P(GMRCRD(12),U,5)="F":"Consulting facility",1:"")
92 ;Commented out following line to allow TIU doc to print based on ASU
93 ;rules.
94 ;I $P(GMRCRD,U,12)=2!(TIUFLG) D
95 D PRINT^GMRCTIUP(GMRCIFN,0,0) ;Removed dot structure
96 ;
97 K GMRCSG I $D(^TMP("GMRCR",$J,"RES")) D
98 .;
99 .S GMRCR0=0 F Q:$D(GMRCSG) S GMRCR0=$O(^TMP("GMRCR",$J,"RES",GMRCR0)) Q:'GMRCR0 D
100 ..F GMRCV="GMRCSDT","GMRCSIG","GMRCSIGM","GMRCSIGT" S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCV))
101 ..Q:'$L($G(GMRCSIG))
102 ..F GMRCV="GMRCSDT","GMRCSIG","GMRCSIGM","GMRCSIGT" S GMRCSG(GMRCV)=@GMRCV
103 ;
104 D INIT^GMRCP5B(.GMRCSG) ; Build Header, Footer, Request, and Primary Diagnosis Segments
105 ;
106 I $L($G(GMRCCPY)) D
107 .D BLD("RES",1,1,0,$$CENTER($S(GMRCCPY="C":"C H A R T C O P Y",1:"W O R K I N G C O P Y")))
108 I ($P(GMRCRD,U,19)="Y") D
109 .D BLD("RES",1,1,0,$$CENTER("******* Significant Findings *******"))
110 I ($P(GMRCRD,U,19)="N") D
111 .D BLD("RES",1,1,0,$$CENTER("******* No Significant Findings *******"))
112 I ($P(GMRCRD,U,19)="U") D
113 .D BLD("RES",1,1,0,$$CENTER("******* Unknown Significant Findings *******"))
114 ;
115 I $P(GMRCRD,U,12)=1 D
116 . D BLD("RES",1,2,0,$$CENTER("**** REQUEST CANCELLED REQUEST CANCELLED ****"))
117 I '$D(^TMP("GMRCR",$J,"RES")),'$D(^("MCAR")) D
118 .I $L($G(GMRCRPT)) D BLD("RES",1,2,0,$$CENTER(" No Consultation Results for "_GMRCRPT_" available."))
119 .I '$L($G(GMRCRPT)) D BLD("RES",1,2,0,$$CENTER(" No Consultation Results available."))
120 ;
121 I $D(^TMP("GMRCR",$J,"RES")) D
122 .;
123 .S (GMRCNT,GMRCR0)=0 F S GMRCR0=$O(^TMP("GMRCR",$J,"RES",GMRCR0)) Q:'GMRCR0 D
124 ..N GMRCCSDT,GMRCCSGM,GMRCCSIG,GMRCCTIT,GMRCRPT,GMRCSDT
125 ..N GMRCSIG,GMRCSIGM,GMRCSIGT,GMRCV,GMRCENT,GMRCVIS,GMRCVLOC,GMRCNODT
126 ..;
127 ..F GMRCV="GMRCCSDT","GMRCCSGM","GMRCCSIG","GMRCCTIT","GMRCRPT","GMRCSDT","GMRCSIG","GMRCSIGM","GMRCSIGT","GMRCVIS","GMRCENT","GMRCVLOC","GMRCNODT" D
128 ...S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCV))
129 ..;
130 ..S GMRCNDX=$O(^TMP("GMRC",$J,"OUTPUT","RES"," "),-1)+1
131 ..I $L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Consultation Results "_$S(GMRCR0=.5:"",1:"#"_GMRCR0_" ")_"for "_GMRCRPT_" continued.")
132 ..I '$L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Consultation Results "_$S(GMRCR0=.5:"",1:"#"_GMRCR0_" ")_"continued.")
133 ..D SUB("H","RES",GMRCNDX," ")
134 ..I $L($G(GMRCSIG)) D
135 ...D SUB("F","RES",GMRCNDX," ")
136 ...I (GMRCSIGM="electronic") S GMRCX=" Results Signature: "_GMRCSIG_" /es/ "_$$EXDT($G(GMRCSDT))
137 ...I '(GMRCSIGM="electronic") S GMRCX=" Results Signature: "_GMRCSIG_" /chart/ " S:$L($G(GMRCSDT)) GMRCX=GMRCX_$$EXDT(GMRCSDT)
138 ...D SUB("F","RES",GMRCNDX,GMRCX)
139 ...D:$L($G(GMRCSIGT)) SUB("F","RES",GMRCNDX," "_GMRCSIGT)
140 ..I $L($G(GMRCCSIG)) D
141 ...D SUB("F","RES",GMRCNDX," ")
142 ...I (GMRCCSGM="electronic") S GMRCX=" Results CoSignature: "_GMRCCSIG_" /es/ "_$$EXDT($G(GMRCCSDT))
143 ...I '(GMRCCSGM="electronic") S GMRCX=" Results CoSignature: "_GMRCCSIG_" /chart/ " S:$L($G(GMRCCSDT)) GMRCX=GMRCX_$$EXDT(GMRCCSDT)
144 ...D SUB("F","RES",GMRCNDX,GMRCX)
145 ...D:$L($G(GMRCCTIT)) SUB("F","RES",GMRCNDX," "_GMRCCTIT)
146 ..;extra signers
147 .. I $D(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA")) D
148 ... D SUB("F","RES",GMRCNDX," ")
149 ... D SUB("F","RES",GMRCNDX," Receipt acknowledged by: ")
150 ... N XTRA S XTRA=0 F S XTRA=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA",XTRA)) Q:'XTRA D
151 .... D SUB("F","RES",GMRCNDX,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA",XTRA,0))
152 .... D SUB("F","RES",GMRCNDX,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA",XTRA,1))
153 ..;
154 ..D BLD("RES",GMRCNDX,1,0," ")
155 ..I $L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("CONSULTATION NOTE "_$S(GMRCR0=.5:"",1:"#"_GMRCR0_" ")_"FOR "_GMRCRPT))
156 ..I '$L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("CONSULTATION NOTE "_$S(GMRCR0=.5:"",1:"#"_GMRCR0)))
157 ..D BLD("RES",GMRCNDX,1,0," ")
158 ..I $L($G(GMRCENT)) D
159 ...S GMRCX=" Entry Date: "_$$EXDT($G(GMRCENT))
160 ...D BLD("RES",GMRCNDX,1,0,GMRCX)
161 ..I $L($G(GMRCNODT)) D
162 ...Q:$$EXDT($G(GMRCNODT))=$$EXDT($G(GMRCENT))
163 ...S GMRCX="Date/Time of result: "_$$EXDT($G(GMRCNODT))
164 ...D BLD("RES",GMRCNDX,1,0,GMRCX)
165 ..I $L($G(GMRCVIS)) D
166 ...S GMRCX=" Visit: "_$$EXDT($G(GMRCVIS))
167 ...I $L($G(GMRCVLOC)) S GMRCX=GMRCX_" "_GMRCVLOC
168 ...D BLD("RES",GMRCNDX,1,0,GMRCX)
169 ..I $L($G(GMRCVLOC)) S GMRCX=GMRCVLOC
170 ..D BLD("RES",GMRCNDX,1,0," ")
171 ..I $D(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",0,0)) D I 1
172 ...D BLD("RES",GMRCNDX,1,0,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",0,0))
173 ..E I '$O(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","")) D
174 ...D BLD("RES",1,1,0,$$CENTER("CONSULTATION NOTE TEXT NOT AVAILABLE"))
175 ..S GMRCR1=0 F S GMRCR1=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCR1)) Q:'GMRCR1 D
176 ...D BLD("RES",GMRCNDX,1,0,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCR1,0))
177 ..;
178 ..; GET ADDENDUMS TO THIS NOTE
179 ..;
180 ..I +$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",0)) D ADDEND^GMRCP5D(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID)
181 ;
182 D FORMAT^GMRCP5D(GMRCIFN,GMRCRD,PAGEWID) ; GET SERVICE REPORTS AND COMMENTS
183 ;
184 Q
185 ;
186EXDT(X) ;EXTERNAL DATE FORMAT
187 ;
188 N DATE,TIME,HR,MN,PD,Y,%DT
189 Q:'$L(X) ""
190 I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
191 Q $$FMTE^XLFDT(X,"5PMZ")
192 ;
193CENTER(X) ;
194 ;
195 N TEXT,COL
196 S COL=35-($L(X)\2) Q:(COL<1) X
197 S $E(TEXT,COL)=X
198 Q TEXT
199 ;
200BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
201 ;
202 Q:'$L($G(SUB))
203 N LINECNT
204 ;
205 F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
206 ;
207 S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
208 I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
209 ;
210 S GMRCLAST=SUB
211 Q
212 ;
213SUB(ZONE,SUB,NDX,TEXT) ;
214 ;
215 N NEXT
216 S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
217 S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
218 Q
219 ;
220LASTLN(SUB,NDX) ;
221 Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
222 ;
Note: See TracBrowser for help on using the repository browser.