source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECMLMN.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.1 KB
Line 
1ECMLMN ;ALB/ESD - Multiple patients processing ;26 AUG 1997 14:42
2 ;;2.0; EVENT CAPTURE ;**5,10,15,13,17,18,23,42,47,54**;8 May 96
3 ;
4 ;
5EN ;- Entry point for multiple patients (part of Multiple Dates/Procs option)
6 ;
7 N ECGO,ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS
8 ;
9 ;- Ask patient related questions
10 D ENPAT(.ECGO)
11 ;
12 ;- ListMan entry point
13 I +$G(ECGO)=1 D EN^VALM("EC MUL PATIENTS")
14 ;
15 Q
16 ;
17ENPAT(ECFL,ECONE) ;- Ask patient name, ordering section, inpat/outpat,
18 ; dx, assoc clinic, and classification questions
19 ; (AO, IR, EC, SC, MST, HNC, CV)
20 ;
21SEL K ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS
22 S ECFL=1,ECS=""
23 ;
24 ;- Patient name
25 S ECNXT=$$ASKPAT^ECMUTL1(.ECPAT)
26 I ECNXT=-1!((ECNXT=-2)&('$D(^TMP("ECPAT",$J)))) S ECFL=-1 G ENPATQ
27 I ECNXT=-2,$D(^TMP("ECPAT",$J)) G ENPATQ
28 ;
29 ;- Inpatient/outpatient status (in ECPCE("I/O"))
30 I '$$INOUT^ECMUTL1(ECPAT) G ENPATQ
31 ;
32 ;- Patient eligibility (in ECPCE("ELIG"))
33 D ASKELIG^ECMUTL1(ECDSSU,ECPCE("I/O"),ECPAT)
34 ;
35 ;- Display inpatient/outpatient status on screen
36 D DSPSTAT^ECUTL0(ECPCE("I/O"))
37 ;
38 ;- Ordering section
39 S ECORD=$$ASKORD^ECMUTL1
40 I 'ECORD D REMOVE^ECMUTL1(ECPAT) G ENPATQ
41 ;
42 ;- Send Event Code Screen IEN of first procedure (used only if 'Send to
43 ; PCE' fld in DSS Unit file is 'N' and patient is an inpatient)
44 ;
45 I $P($G(^TMP("ECMPIDX",$J,1)),"^",3)]"" S ECS=$O(^ECJ("AP",ECL,+$P(ECDSSU,"^"),+ECCAT,$P($G(^TMP("ECMPIDX",$J,1)),"^",3),0))
46 ;
47 ;- Dx, associated clinic, and classification questions
48 S ECPCEQ=$$PCEDAT^ECMUTL1(+$P(ECDSSU,"^"),ECS,.ECPCE)
49 I ECPCEQ>0 D REMOVE^ECMUTL1(ECPAT) G ENPATQ
50 I ECPCEQ=0 D BLDPAT
51ENPATQ I '$G(ECONE),ECNXT>0 W ! G SEL
52 Q
53 ;
54 ;
55BLDPAT ;- Build ^TMP("ECPAT",$J) array with patient data
56 ;
57 N ECNODE,ECNUM
58 S ECNUM=2
59 S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",12)=""
60 S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",1)=$P(ECPAT,"^",2)
61 S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",2)=+$P(ECORD,"^")
62 F ECNODE="I/O","CLIN","CLINNM","DX","DXNM","AO","ENV","IR","SC","ELIG","MST","HNC","CV" D
63 . S ECNUM=ECNUM+1
64 . S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",ECNUM)=$S(ECNODE="CLINNM":$P($G(ECPCE("CLIN")),"^",2),ECNODE="DXNM":$P($G(ECPCE("DX")),"^",2),1:$P($G(ECPCE(ECNODE)),"^"))
65 I $D(ECPCE("DXS")) M ^TMP("ECPAT",$J,$P(ECPAT,"^"),"DXS")=ECPCE("DXS")
66 Q
67 ;
68 ;
69HDR ;- Header
70 ;
71 S VALMHDR(1)=" Location: "_$G(ECLN)_" ("_$G(ECL)_")"
72 S VALMHDR(1)=$$SETSTR^VALM1("Provider #1: "_$P(ECU(1),"^",2),VALMHDR(1),40,30)
73 S VALMHDR(2)=" DSS Unit: "_$P(ECDSSU,"^",2)
74 S VALMHDR(2)=$$SETSTR^VALM1(" Category: "_$P(ECCAT,"^",2),VALMHDR(2),40,30)
75 Q
76 ;
77 ;
78INIT ;-- Init vars and display selected procedures for patient(s)
79 ;
80 N ECPTCNT,BL,X,IC,IW,DC,DW,NC,NW,PC,PW,RC,RW,SC,SW
81 K ^TMP("ECMPT",$J),^TMP("ECMPTIDX",$J)
82 D CLEAN^VALM10
83 ;
84 S (VALMCNT,ECPTCNT)=0
85 S BL="",$P(BL," ",30)=""
86 S X=VALMDDF("INDEX"),IC=$P(X,"^",2),IW=$P(X,"^",3)
87 S X=VALMDDF("PATIENT"),PC=$P(X,"^",2),PW=$P(X,"^",3)
88 S X=VALMDDF("SSN"),SC=$P(X,"^",2),SW=$P(X,"^",3)
89 ;
90 D BLD
91 S $P(^TMP("ECMPT",$J,0),"^",4)=VALMCNT
92 Q
93 ;
94 ;
95BLD ;- Get data from array for screen display
96 ;
97 N DFN,ECDFN,ECX,VA,VAERR
98 S ECDFN=0 F S ECDFN=$O(^TMP("ECPAT",$J,ECDFN)) Q:'ECDFN D
99 . K DFN S DFN=ECDFN D PID^VADPT6
100 . D BLDLM
101 . D PRDSP
102 Q
103 ;
104 ;
105BLDLM ;- Display patient data
106 ;
107 K ECX
108 S ECPTCNT=ECPTCNT+1,ECX="",$P(ECX," ",VALMWD+1)=""
109 S ECX=$E(ECX,1,IC-1)_$E(ECPTCNT_BL,1,IW)_$E(ECX,IC+IW+1,VALMWD)
110 S ECX=$E(ECX,1,PC-1)_$E($P(^TMP("ECPAT",$J,ECDFN),"^")_BL,1,PW)_$E(ECX,PC+PW+1,VALMWD)
111 S ECX=$E(ECX,1,SC-1)_$E($G(VA("PID"))_BL,1,SW)_$E(ECX,SC+SW+1,VALMWD)
112 ;
113 D SET(ECX)
114 ;
115 ;- Tmp array ECMPTIDX contains:
116 ; Cnt^DFN^Name^Ord Sect^In/Out^Clin^Clin Nam^DX^DX Nam^AO^EC^IR^SC^Elig^MST^HNC^CV
117 ;
118 S ^TMP("ECMPTIDX",$J,ECPTCNT)=VALMCNT_"^"_ECDFN_"^"_$G(^TMP("ECPAT",$J,ECDFN))
119 ;- Set secondary diagnosis codes in array ECMPTIDX
120 I $D(^TMP("ECPAT",$J,ECDFN,"DXS")) D
121 . M ^TMP("ECMPTIDX",$J,ECPTCNT,"DXS")=^TMP("ECPAT",$J,ECDFN,"DXS")
122 Q
123 ;
124 ;
125SET(X) ;- Create ^TMP("ECMPT",$J) array for screen display
126 ;
127 S VALMCNT=VALMCNT+1,^TMP("ECMPT",$J,VALMCNT,0)=X
128 S ^TMP("ECMPT",$J,"IDX",VALMCNT,ECPTCNT)=""
129 Q
130 ;
131 ;
132PRDSP ;- Display selected procedure dates/times and procedures
133 ;
134 N I,X,J,ECCPT,ECPR
135 S I=0
136 D SET("")
137 D SET($$SETSTR^VALM1("Procedure(s):","",8,13))
138 D CNTRL^VALM10(VALMCNT,8,13,IORVON,IORVOFF)
139 ;
140 F S I=$O(^TMP("ECMPIDX",$J,I)) Q:'I D
141 . S X=""
142 . S X=$$SETSTR^VALM1($$FTIME^VALM1($P($G(^TMP("ECMPIDX",$J,I)),"^",2)),X,10,18)
143 . S X=$$SETSTR^VALM1($P($P($G(^TMP("ECMPIDX",$J,I)),"^",3),";"),X,34,5)
144 . S ECCPT=$P(^TMP("ECMPIDX",$J,I),"^",3)
145 . S ECCPT=$S(ECCPT["ICPT":+ECCPT,1:$P($G(^EC(725,+ECCPT,0)),"^",5))
146 . I ECCPT'="" S ECCPT=$P($$CPT^ICPTCOD(ECCPT,$P(^TMP("ECMPIDX",$J,I),"^",2)),"^",2)
147 . S ECPR=$S(ECCPT'="":ECCPT_" ",1:ECCPT)_$P(^TMP("ECMPIDX",$J,I),"^",4)
148 . S X=$$SETSTR^VALM1(ECPR,X,42,VALMWD)
149 . D SET(X)
150 . ;set modifier in ^TMP global for display
151 . S J="" F S J=$O(^TMP("ECMPIDX",$J,I,"MOD",J)) Q:J="" S X="" D
152 . . S X=$$SETSTR^VALM1(" - "_J_" "_$P(^TMP("ECMPIDX",$J,I,"MOD",J),"^"),X,41,VALMWD)
153 . . D SET(X)
154 ;
155 D SET("")
156 ;
157PRDSPQ Q
158 ;
159HLPS ;- Brief help
160 ;
161 S X="?" D DISP^XQORM1 W !!
162 Q
163 ;
164HELP ;- Help for list
165 S ECZ=""
166 I $D(X),X'["??" D HLPS,PAUSE^VALM1 G HLPQ
167 D CLEAR^VALM1
168 F I=1:1 S ECZ=$P($T(HELPTXT+I),";",3,99) Q:ECZ="$END" D PAUSE^VALM1:ECZ="$PAUSE" Q:'Y W !,$S(ECZ["$PAUSE":"",1:ECZ)
169 W !,"Possible actions are the following:"
170 D HLPS,PAUSE^VALM1 S VALMBCK="R"
171HLPQ K ECZ,Y,I Q
172 ;
173EXIT ;- Clean up and exit
174 ;
175 K ECPLST
176 K ^TMP("ECPAT",$J),^TMP("ECMPT",$J)
177 K VALMDDF
178 D CLEAN^VALM10,CLEAR^VALM1
179 Q
180 ;
181 ;
182PATDEL ;- Entry point for EC MUL PAT DEL protocol
183 ;
184 N ECFND,ECI,ECSEL,VALMY
185 S VALMBCK=""
186 D FULL^VALM1
187 D EN^VALM2(XQORNOD(0))
188 S (ECFND,ECSEL)=0
189 F S ECSEL=$O(VALMY(ECSEL)) Q:'ECSEL D
190 . I $D(^TMP("ECMPTIDX",$J,ECSEL)) K ECDAT S ECDAT=^(ECSEL) D
191 .. S ECI=0 F S ECI=$O(^TMP("ECPAT",$J,ECI)) Q:'ECI!(ECFND) D
192 ... I $P(ECDAT,"^",2)=ECI S ECFND=1 K ^TMP("ECPAT",$J,ECI) D REMOVNM(ECI)
193 .. I ECFND=0 W !!,*7,">>> This patient could not be found. <<<" D PAUSE^VALM1 Q
194 I ECFND=1 D INIT^ECMLMN
195 S VALMBCK="R"
196 K ECDAT
197PATDELQ Q
198 ;
199 ;
200REMOVNM(ECI) ;- Remove patient name from array which tracks dup patients
201 ;
202 Q:'$G(ECI)
203 N ECX
204 S ECX=0
205 F S ECX=$O(^TMP("ECPLST",$J,ECX)) Q:'ECX D
206 . I +$P($G(^TMP("ECPLST",$J,ECX)),"^")=ECI K ^TMP("ECPLST",$J,ECX)
207 Q
208 ;
209 ;
210ADDPAT ;- Entry point for EC MUL PAT ADD protocol
211 ;
212 N ECADD,ECOK
213 S VALMBCK=""
214 D FULL^VALM1
215 D ENPAT(.ECOK,1)
216 I +$G(ECOK)=1 D INIT^ECMLMN
217 I +$G(ECOK)<0 W !!,*7,">>> No patient entered. <<<" D PAUSE^VALM1
218 S VALMBCK="R"
219ADDPATQ Q
220 ;
221 ;
222HELPTXT ; - Help text
223 ;;Enter actions(s) by typing the name(s), or abbreviation(s).
224 ;;
225 ;;ACTION DEFINITIONS:
226 ;; AP - Add a Patient allows the user to add a Patient to those
227 ;; patients previously entered
228 ;; DP - Delete a Patient allows the user to delete a patient from
229 ;; those patients previously entered
230 ;; FP - File Patients will enter the patients into the Event Capture
231 ;; procedure database
232 ;;
233 ;; NOTE: The procedures you have entered with this option MUST be filed
234 ;; with the 'FP' action for the data to be filed into the Event
235 ;; Capture system.
236 ;;------------------------------------------------------------------------------
237 ;;$PAUSE
238 ;;$END
Note: See TracBrowser for help on using the repository browser.