source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5D.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: 7.6 KB
Line 
1GMRCP5D ;SLC/DCM,RJS,JFR - Print Consult form 513 (Gather Data - Addendums, Headers, Service reports and Comments) ;8/19/03 15:31
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,22,29,35,38**;Dec 27, 1997
3 ;
4FORMAT(GMRCIFN,GMRCRD,PAGEWID) ;
5 ;
6 I $L($P(GMRCRD,U,15)) D
7 .I $O(^TMP("GMRCR",$J,"MCAR",0)) D
8 ..N GMRCSVC
9 ..S GMRCSVC=$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1)
10 ..S:$L(GMRCSVC) GMRCSVC=GMRCSVC_" "
11 ..;
12 ..; Medicine Results?
13 ..S GMRCR0=0 F S GMRCR0=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0)) Q:'GMRCR0 D
14 ...D SUB("H","SREP",GMRCR0,$$CENTER(GMRCSVC_"Service Report #"_GMRCR0_" continued."))
15 ...D SUB("H","SREP",GMRCR0," ")
16 ...D BLD("SREP",GMRCR0,1,0,$$CENTER("Medicine Package Report"))
17 ...D BLD("SREP",GMRCR0,1,0,"")
18 ...N LN
19 ...S LN=0 F S LN=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN)) Q:'LN D
20 ....D BLD("SREP",GMRCR0,1,0,$G(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN,0)))
21 ;
22 ; Build Processing Activities
23 S GMRCR0=0 F S GMRCR0=$O(^GMR(123,GMRCIFN,40,GMRCR0)) Q:'GMRCR0 D
24 .N GMRCR1,GMRC400,CMT,USER,GMRCDT,RPRV,GMRC402,GMRCISIT
25 .S GMRCR1=+$O(^GMR(123,GMRCIFN,40,GMRCR0,0)) Q:GMRCR1'=1
26 .S GMRC400=$G(^GMR(123,GMRCIFN,40,GMRCR0,0))
27 .S GMRC402=$G(^GMR(123,GMRCIFN,40,GMRCR0,2))
28 .S CMT=$$PRCMT^GMRCP5B(+$P(GMRC400,U,2)) Q:'$L(CMT)
29 .S GMRCDT=$P(GMRC400,U,3) S:'GMRCDT GMRCDT=$P(GMRC400,U,1)
30 .S GMRCDT=$$EXDT(GMRCDT)_" "_$P(GMRC402,U,3)
31 .;Following lines modified in patch *38
32 .;I $P(^GMR(123,GMRCIFN,0),U,23) D ;commented out
33 .;.S GMRCISIT=$$GET1^DIQ(4,$P(^GMR(123,GMRCIFN,0),U,23),.01) ;commented out
34 .;.S GMRCISIT="Entered at: "_GMRCISIT ;commented out
35 .I $L(GMRC402) D ;ADDED
36 ..S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.07) ;ADDED
37 .I '$D(GMRCISIT) D ;ADDED
38 ..S GMRCISIT=$$KSP^XUPARAM("INST") ;ADDED
39 ..I GMRCISIT'="" S GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01) ;ADDED
40 ..I GMRCISIT="" S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.05) ;ADDED
41 .S GMRCISIT="Entered at: "_GMRCISIT ;ADDED
42 .;End of modifications for patch *38
43 .S RPRV=$$GET1^DIQ(200,+$P(GMRC400,U,4),.01)
44 .I '$L(RPRV) S RPRV=$P(GMRC402,U,2)
45 .S:($L(RPRV)) RPRV="Responsible Person: "_RPRV
46 .S USER=$$GET1^DIQ(200,+$P(GMRC400,U,5),.01)
47 .I '$L(USER) S USER=$P(GMRC402,U)
48 .S USER="Entered by: "_USER_" - "_GMRCDT
49 .D SUB("H","COM",GMRCR0,CMT_" Comment ("_USER_") continued.")
50 .D SUB("H","COM",GMRCR0," ")
51 .D BLD("COM",GMRCR0,1,0,"")
52 .D BLD("COM",GMRCR0,1,0,$$CENTER("("_CMT_" Comment)"))
53 .I $P(GMRC400,U,2)=17!($P(GMRC400,U,2)=25) D
54 .. N FWDLN,FWDRS
55 .. S FWDLN="Forwarded from: "
56 .. S FWDRS=$P($G(^GMR(123,GMRCIFN,40,GMRCR0,3)),U)
57 .. I $L(FWDRS) S FWDLN=FWDLN_FWDRS
58 .. I '$L(FWDRS) S FWDLN=FWDLN_$$GET1^DIQ(123.5,+$P(GMRC400,U,6),.01)
59 .. D BLD("COM",GMRCR0,1,5,FWDLN)
60 .D BLD("COM",GMRCR0,1,5,USER)
61 .D:($L(RPRV)) BLD("COM",GMRCR0,1,5,RPRV)
62 .D:($L($G(GMRCISIT))) BLD("COM",GMRCR0,1,5,GMRCISIT)
63 .;
64 .N GMRCR2 S GMRCR2=0
65 .F S GMRCR2=$O(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2)) Q:'GMRCR2 D
66 ..D BLD("COM",GMRCR0,1,0,$G(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2,0)))
67 ;
68 Q
69 ;
70ADDEND(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID) ;
71 ;
72 N GMRCADD,GMRCNDX,GMRCR1,GMRCV,TEXT,GMRCX
73 ;
74 S GMRCADD=0 F S GMRCADD=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD)) Q:'GMRCADD D
75 .N GMRCSGNM,GMRCNMDT,GMRCTIT,GMRCMODE,GMRCCSDT,GMRCCTIT,GMRCCSGM
76 .;
77 .F GMRCV="GMRCSGNM","GMRCNMDT","GMRCTIT","GMRCMODE" D
78 ..S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV))
79 .;
80 . F GMRCV="GMRCCSDT","GMRCCTIT","GMRCCSGM","GMRCCSIG" D
81 .. S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV))
82 .S GMRCNDX=$O(^TMP("GMRC",$J,"OUTPUT","RES"," "),-1)+1
83 .I $L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" for "_GMRCRPT_" continued.")
84 .I '$L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" continued.")
85 .D SUB("H","RES",GMRCNDX," ")
86 .I $L($G(GMRCSGNM)) D
87 ..D SUB("F","RES",GMRCNDX," ")
88 ..I (GMRCMODE="electronic") S GMRCX=" Addendum Signature: "_GMRCSGNM_" /es/ "_$$EXDT($G(GMRCNMDT))
89 ..I '(GMRCMODE="electronic") S GMRCX=" Addendum Author: "_GMRCSGNM S:$L($G(GMRCNMDT)) GMRCX=GMRCX_" Last edited: "_$$EXDT(GMRCNMDT)
90 ..D SUB("F","RES",GMRCNDX,GMRCX)
91 ..D:$L($G(GMRCTIT)) SUB("F","RES",GMRCNDX," "_GMRCTIT)
92 .I $L($G(GMRCCSDT)) D
93 ..D SUB("F","RES",GMRCNDX," ")
94 ..I (GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /es/ "_$$EXDT(GMRCCSDT)
95 ..I '(GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /chart/ "_$$EXDT(GMRCCSDT)
96 ..D SUB("F","RES",GMRCNDX,GMRCX)
97 ..D:$L($G(GMRCCTIT)) SUB("F","RES",GMRCNDX," "_GMRCCTIT)
98 .D BLD("RES",GMRCNDX,1,0," ")
99 .I $L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0_" FOR "_GMRCRPT))
100 .I '$L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0))
101 .D BLD("RES",GMRCNDX,1,0," ")
102 .S GMRCR1=0 F S GMRCR1=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1)) Q:'GMRCR1 D
103 ..D BLD("RES",GMRCNDX,1,0,$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1,0)))
104 Q
105 ;
106HDR ; Header code for form 513
107 ;
108 N PG,GMRCFROM
109 ;
110 F PG=0,1 D
111 .D BLD("HDR",PG,1,0,GMRCDVL)
112 .D BLD("HDR",PG,1,6,"MEDICAL RECORD")
113 .D BLD("HDR",PG,0,29,"|")
114 .D BLD("HDR",PG,0,36,"CONSULTATION SHEET")
115 .I PG D BLD("HDR",PG,0,60,"Page ","GMRCPG,65") I 1
116 .E I '$G(GMRCGUI) D BLD("HDR",PG,0,60,"Page ","GMRCPG,65")
117 .;
118 .D BLD("HDR",PG,1,0,GMRCDVL)
119 .D BLD("HDR",PG,1,0,"Consult Request: "_$$CONSRQ(GMRCIFN))
120 .D BLD("HDR",PG,0,55,"|Consult No.: "_GMRCIFN)
121 .;
122 D BLD("HDR",1,1,0,GMRCEQL)
123 D BLD("HDR",0,1,0,GMRCDVL)
124 ;
125 I $G(CMT) D BLD("HDR",0,1,27,"("_$$PRCMT^GMRCP5B(CMT)_")") Q
126 ;
127 S GMRCFROM=$P($G(^SC(+$P(GMRCRD,U,6),0)),U,1)
128 ;
129 I '$L(GMRCFROM) D
130 .N VAIN
131 .D INP^VADPT
132 .S GMRCFROM=$P($G(VAIN(4)),U,2)
133 .I $L($G(VAIN(5))) S GMRCFROM=GMRCFROM_" (Rm/Bd: "_$G(VAIN(5))_" )"
134 ;No location, IFC - consulting site
135 I '$L(GMRCFROM),$P(GMRCRD,U,23),$P($G(GMRCRD(12)),U,5)="F" D
136 .I $P(GMRCRD,U,21) S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,21),.01)
137 .E S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,23),.01)
138 ;
139 D BLD("HDR",0,1,0,"To: "_$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1))
140 D BLD("HDR",0,1,5,"From: "_GMRCFROM)
141 D BLD("HDR",0,0,49,"|Requested: "_$$EXDT($P(GMRCRD,U,7)))
142 ;
143 D BLD("HDR",0,1,0,GMRCDVL)
144 D BLD("HDR",0,1,0,"Requesting Facility: "_$E(GMRCFAC,1,22))
145 I $P(GMRCRD,U,11) D BLD("HDR",0,0,45,"|ATTENTION: "_$E($P($G(^VA(200,+$P(GMRCRD,U,11),0)),U,1),1,21))
146 I $P(GMRCRD,U,23) D
147 . D BLD("HDR",0,1,0,"Remote Consult No.: "_GMRCINO)
148 . D BLD("HDR",0,1,0,"Role: "_GMRCIRL)
149 D BLD("HDR",0,1,0,GMRCEQL)
150 ;
151 Q
152 ;
153CENTER(X) ;
154 ;
155 N TEXT,COL
156 S COL=35-($L(X)\2) Q:(COL<1) X
157 S $E(TEXT,COL)=X
158 Q TEXT
159 ;
160BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
161 ;
162 Q:'$L($G(SUB))
163 N LINECNT
164 ;
165 F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
166 ;
167 S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
168 I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
169 ;
170 S GMRCLAST=SUB
171 Q
172 ;
173SUB(ZONE,SUB,NDX,TEXT) ;
174 ;
175 N NEXT
176 S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
177 S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
178 Q
179 ;
180LASTLN(SUB,NDX) ;
181 Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
182 ;
183CONSRQ(IFN) ;
184 ;
185 N PTR,LINK,REF,GMRCRQ
186 I +$P(^GMR(123,+IFN,0),U,8) D
187 . S GMRCRQ=$P(^GMR(123,+IFN,0),U,8)
188 . S GMRCRQ=$$GET1^DIQ(123.3,+GMRCRQ,.01)
189 . I '$L(GMRCRQ) S GMRCRQ="Procedure"
190 I $L($G(GMRCRQ)) Q GMRCRQ
191 I $L($G(^GMR(123,IFN,1.11))) D
192 . N SERV,TYPE
193 . S SERV=$$UP^XLFSTR($$GET1^DIQ(123.5,$P(^GMR(123,IFN,0),U,5),.01))
194 . S TYPE=$$UP^XLFSTR(^GMR(123,IFN,1.11)) I TYPE'=SERV D
195 . I TYPE'=SERV S GMRCRQ=$E(^GMR(123,IFN,1.11),1,36)
196 Q:$L($G(GMRCRQ)) GMRCRQ Q "Consult"
197 ;
198EXDT(X) ;EXTERNAL DATE FORMAT
199 ;
200 N DATE,TIME,HR,MN,PD,Y,%DT
201 Q:'$L(X) ""
202 I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
203 Q $$FMTE^XLFDT(X,"5PMZ")
204 ;
Note: See TracBrowser for help on using the repository browser.