source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5B.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: 6.0 KB
Line 
1GMRCP5B ;SLC/DCM,RJS - Print Consult form 513 (Gather Data - Footers, Provisional Diagnosis and Reason For Request) ;11/5/02 07:35
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,13,12,15,24,23,22,29**;Dec 27, 1997
3 ;
4 ; Patch #23 add "SERVICE RENDERED AS:" to SF513
5 ; This routine invokes IA #1252,#10112
6 ; DBIA 10035 ;PATIENT FILE
7 ; DBIA 2849 ;PROTOCOL
8 ; DBIA 10060 ;NEW PERSON
9 Q
10 ;
11INIT(GMRCSG) ; Initialize the form
12 ;
13 D HDR^GMRCP5D,FTR(.GMRCSG),REQUEST,PDIAG Q
14 ;
15REQUEST ;
16 N GMRCX
17 ;
18 I $L($T(OUTPTPR^SDUTL3)) D
19 .S GMRCX=$P($$OUTPTPR^SDUTL3(DFN),U,2)
20 .D:$L(GMRCX) BLD("REQ",1,1,0,"Current Primary Care Provider: "_GMRCX)
21 I $L($T(OUTPTTM^SDUTL3)) D
22 .S GMRCX=$P($$OUTPTTM^SDUTL3(DFN),U,2)
23 .D:$L(GMRCX) BLD("REQ",1,1,0," Current Primary Care Team: "_GMRCX)
24 ;
25 I $O(^TMP("GMRC",$J,"OUTPUT","REQ",0)) D BLD("REQ",1,1,0,"")
26 ;
27 D SUB("H","REQ",1,"Reason For Request continued.")
28 D SUB("H","REQ",1," ")
29 ;
30 D BLD("REQ",1,1,0,"REASON FOR REQUEST: (Complaints and findings)")
31 I '$O(^GMR(123,GMRCIFN,20,0)) D BLD("REQ",1,1,0,"") I 1
32 E D
33 .N LN S LN=0 F S LN=$O(^GMR(123,GMRCIFN,20,LN)) Q:LN="" D
34 ..D BLD("REQ",1,1,0,^GMR(123,GMRCIFN,20,LN,0))
35 ;
36 Q
37PDIAG ;
38 ;
39 D BLD("PDIAG",1,1,0,"PROVISIONAL DIAG: "_$G(^GMR(123,GMRCIFN,30)))
40 D BLD("PDIAG",1,1,0,GMRCDVL)
41 ;
42 S (GMRCQSTR,GMRCPGR,GMRCIPH,GMRCQSTT)=""
43 ;
44 I $S('$P(GMRCRD,U,23):1,$P(GMRCRD(12),U,5)="P":1,1:0) D
45 .S GMRCQSTR=$P(GMRCRD,U,14)
46 .S:'GMRCQSTR GMRCQSTR=$$GET1^DIQ(100,+$P(GMRCRD,U,3),1)
47 .S GMRCX=$G(^VA(200,+GMRCQSTR,.13))
48 .S GMRCPGR=$P(GMRCX,U,7) S:'$L(GMRCPGR) GMRCPGR=$P(GMRCX,U,8)
49 .S GMRCIPH=$P(GMRCX,U,2)
50 .;
51 .S GMRCQSTT=$P($G(^VA(200,+GMRCQSTR,20)),U,3)
52 .S:'$L(GMRCQSTT) GMRCQSTT=$$GET1^DIQ(200,+GMRCQSTR,8)
53 .S GMRCQSTR=$P($G(^VA(200,+GMRCQSTR,0)),U,1)
54 ;
55 I $P(GMRCRD,U,23),$P(GMRCRD(12),U,5)="F" D
56 .S GMRCQSTR=$P(GMRCRD(12),U,6)
57 .S GMRCIPH=$P(GMRCRD(13),U,2)
58 .S GMRCPGR=$P(GMRCRD(13),U,3)
59 ;
60 S GMRCIPH="(Phone: "_GMRCIPH_")"
61 S GMRCPGR="(Pager: "_GMRCPGR_")"
62 ;
63 D BLD("PDIAG",1,1,0,"REQUESTED BY: ")
64 D BLD("PDIAG",1,0,35,"|PLACE:")
65 D BLD("PDIAG",1,0,59,"|URGENCY:")
66 ;
67 D BLD("PDIAG",1,1,0,$E(GMRCQSTR,1,37))
68 D BLD("PDIAG",1,0,35,"|"_$E($P($G(^ORD(101,+$P(GMRCRD,U,10),0)),U,2),1,20))
69 D BLD("PDIAG",1,0,59,"|"_$E($P($G(^ORD(101,+$P(GMRCRD,U,9),0)),U,2),1,18))
70 ;
71 I $L(GMRCQSTT) D
72 .D BLD("PDIAG",1,1,0,GMRCQSTT)
73 .D BLD("PDIAG",1,0,35,"|")
74 .D BLD("PDIAG",1,0,59,"|")
75 D BLD("PDIAG",1,1,0,GMRCPGR)
76 D BLD("PDIAG",1,0,35,"|SERVICE RENDERED AS:")
77 D BLD("PDIAG",1,0,59,"|")
78 S GMRCINOU=$S($P(GMRCRD,U,18)="O":"Outpatient",1:"Inpatient")
79 I $D(GMRCIPH)>0 D
80 .D BLD("PDIAG",1,1,0,GMRCIPH)
81 .D BLD("PDIAG",1,0,35,"|"_GMRCINOU)
82 E D
83 .D BLD("PDIAG",1,1,35,"|"_GMRCINOU)
84 D BLD("PDIAG",1,0,59,"|")
85 K GMRCINOU
86 ;***************************************************************
87 D BLD("PDIAG",1,1,0,GMRCDVL)
88 ;
89 Q
90 ;
91FTR(GMRCSG) ;Footer of form 513
92 ;
93 N GMRCRMBD,GMRCFAC1,GMRCLOC,GMRCX,GMRCPEL,SUB,VAIN,VAPA,VAERR
94 ;
95 D ADD^VADPT,INP^VADPT
96 ;
97 S (GMRCLOC,GMRCRMBD)=""
98 S GMRCLOC=$P($G(VAIN(4)),U,2)
99 S GMRCRMBD=$G(VAIN(5))
100 S:'$L(GMRCLOC) GMRCLOC=$P($G(^SC(+$P($G(^GMR(123,+GMRCIFN,0)),U,4),0)),U,1)
101 ;No location, IFC - consulting site
102 I '$L(GMRCLOC),$P(GMRCRD,U,23),$P($G(GMRCRD(12)),U,5)="F" D
103 .I $P(GMRCRD,U,21) S GMRCLOC=$$GET1^DIQ(4,$P(GMRCRD,U,21),.01)
104 .E S GMRCLOC=$$GET1^DIQ(4,$P(GMRCRD,U,23),.01)
105 S:'$L(GMRCLOC) GMRCLOC=GMRCUL
106 ;
107 D BLD("FTR",0,1,0,GMRCEQL)
108 D BLD("FTR",1,1,0,GMRCEQL)
109 ;
110 I ($G(GMRCSG("GMRCSIGM"))="electronic") D I 1
111 .D BLD("FTR",0,1,0,"SIGNATURE & TITLE: ")
112 .D BLD("FTR",0,0,20,$G(GMRCSG("GMRCSIG"))_" /es/")
113 .D BLD("FTR",0,0,54,"|")
114 .D BLD("FTR",0,1,20,$G(GMRCSG("GMRCSIGT")))
115 .D BLD("FTR",0,0,54,"|DATE: "_$$EXDT($G(GMRCSG("GMRCSDT"))))
116 E D
117 .D BLD("FTR",0,1,0,"AUTHOR & TITLE: ")
118 .D BLD("FTR",0,0,20,$G(GMRCSG("GMRCSIG")))
119 .D BLD("FTR",0,0,54,"|")
120 .D BLD("FTR",0,1,20,$G(GMRCSG("GMRCSIGT")))
121 .D BLD("FTR",0,0,54,"|DATE: "_$$EXDT($G(GMRCSG("GMRCSDT"))))
122 ;
123 S GMRCFAC1=+$G(DUZ(2))
124 S:'GMRCFAC1 GMRCFAC1=+$$SITE^VASITE()
125 S GMRCFAC1=$$GET1^DIQ(4,+GMRCFAC1,.01)
126 ;
127 D BLD("FTR",0,1,0,GMRCDVL)
128 D BLD("FTR",0,1,0,"ID #:"_$E(GMRCUL,1,8))
129 D BLD("FTR",0,0,12,"|ORGANIZATION:"_$J($E(GMRCFAC1,1,17),17))
130 D BLD("FTR",0,0,45,"|REG #:"_$E(GMRCUL,1,4))
131 D BLD("FTR",0,0,58,"|LOC: "_$E($G(GMRCLOC),1,11))
132 ;
133 I $L(GMRCRMBD) D I 1
134 .D BLD("FTR",0,1,12,"|")
135 .D BLD("FTR",0,0,45,"|")
136 .D BLD("FTR",0,0,58,"|RM/BD: "_GMRCRMBD)
137 ;
138 D BLD("FTR",0,1,0,GMRCDVL)
139 ;
140 ; get and format eligibility info
141 D
142 . N VAEL
143 . D ELIG^VADPT
144 . S GMRCPEL=$P(VAEL(1),U,2)
145 ;
146 F SUB=0,1 D
147 . N GMRCFLN
148 . S GMRCFLN=$P($G(^DPT(GMRCDFN,0)),U,1)_" "_GMRCPEL_" "
149 . S GMRCFLN=GMRCFLN_$E($G(GMRCELIG),1,(79-$L(GMRCFLN)))
150 . D BLD("FTR",SUB,1,0,GMRCFLN)
151 . D BLD("FTR",SUB,1,0,GMRCSN)
152 . D BLD("FTR",SUB,0,16,$$EXDT(GMRCDOB))
153 . D BLD("FTR",SUB,0,51,"CONSULTATION SHEET")
154 ;
155 ; ADDRESS LINES 1-3
156 F GMRCX=1,2,3 D:$L(VAPA(GMRCX))
157 . D BLD("FTR",0,1,0,VAPA(GMRCX))
158 . I GMRCX=1 D BLD("FTR",0,0,51,"Standard Form 513 (Rev 9-77)")
159 ;
160 ; CITY STATE ZIP CODE
161 S GMRCX=VAPA(4)_" "_$P(VAPA(5),U,2)_" "_VAPA(6)
162 ;
163 I $L(VAPA(8)) S GMRCX=GMRCX_" Phone: "_VAPA(8) ; TELEPHONE (IF AVAILABLE)
164 ;
165 D BLD("FTR",0,1,0,GMRCX)
166 ;
167 Q
168 ;
169CONSRQ(GMRCRQ) ;
170 ;
171 N ORND,ORFL,REF
172 I '$L(GMRCRQ) Q "Consult"
173 S ORND=$P(GMRCRQ,";",1),ORFL=$P(GMRCRQ,";",2),REF=U_ORFL_ORND_",0)"
174 S GMRCRQ=$P($G(@(REF)),U,2)
175 Q:$L(GMRCRQ) GMRCRQ Q "Consult"
176 ;
177EXDT(X) ;EXTERNAL DATE FORMAT
178 ;
179 N DATE,TIME,HR,MN,PD,Y,%DT
180 Q:'$L(X) ""
181 I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
182 Q $$FMTE^XLFDT(X,"5PMZ")
183 ;
184PRCMT(CMT) ;
185 ;
186 Q $P($G(^GMR(123.1,+CMT,0)),U,8)
187 ;
188 ;
189BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
190 ;
191 Q:'$L($G(SUB))
192 N LINECNT
193 ;
194 F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
195 ;
196 S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
197 I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
198 ;
199 S GMRCLAST=SUB
200 Q
201 ;
202SUB(ZONE,SUB,NDX,TEXT) ;
203 ;
204 N NEXT
205 S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
206 S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
207 Q
208 ;
209LASTLN(SUB,NDX) ;
210 Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
211 ;
Note: See TracBrowser for help on using the repository browser.