source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZU3.m@ 949

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

initial load of WorldVistAEHR
File size: 9.2 KB
Line 
1EASEZU3 ;ALB/jap - Utilities for 1010EZ Processing ;10/12/00 13:08
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,57**;Mar 15, 2001
3 ;
4NSD(EASAPP,TYPE,MULTIPLE) ;get name, ssn, dob for person of interest
5 ;input EASAPP = application ien in file #712
6 ; TYPE = "APPLICANT", "SPOUSE", "CHILD1", or "CHILD(N)"
7 ; MULTIPLE = default to 1, unless TYPE="CHILD(N)"
8 ;output RTR = name^ssn^dob
9 N RTR,KEY,EASNAME,EASSSN,EASDOB,LAST,FIRST,MDL,SUFF
10 S RTR="",EASNAME="",EASSSN="",EASDOB=""
11 S KEY=+$$KEY711^EASEZU1(TYPE_" LAST NAME") I KEY S LAST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
12 S KEY=+$$KEY711^EASEZU1(TYPE_" FIRST NAME") I KEY S FIRST=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
13 S KEY=+$$KEY711^EASEZU1(TYPE_" MIDDLE NAME") I KEY S MDL=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
14 S KEY=+$$KEY711^EASEZU1(TYPE_" SUFFIX NAME") I KEY S SUFF=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
15 I (LAST="")!(FIRST="") Q RTR
16 S EASNAME=LAST_","_FIRST
17 I $L(EASNAME)+$L(MDL)>45 S MDL=$E(MDL,1)
18 I MDL'="" S EASNAME=EASNAME_" "_MDL
19 I SUFF'="" S EASNAME=EASNAME_" "_SUFF
20 S EASNAME=$$UC^EASEZT1($E(EASNAME,1,45))
21 S KEY=+$$KEY711^EASEZU1(TYPE_" SOCIAL SECURITY NUMBER")
22 I KEY S EASSSN=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1),EASSSN=$$SSNOUT^EASEZT1(EASSSN)
23 S KEY=+$$KEY711^EASEZU1(TYPE_" DATE OF BIRTH")
24 I KEY S EASDOB=$P($$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),U,1)
25 S RTR=EASNAME_U_EASSSN_U_EASDOB
26 Q RTR
27 ;
28LINK ;
29 ;link applicant to file #2 as new or existing patient
30 Q:EASVIEW'=1
31 S EASPSTAT="NEW"
32 D DFN^EASEZI(EASAPP,.EASDFN)
33 I $G(EASDFN)>0 D
34 .D SETDATE^EASEZU2(EASAPP,"REV") S EASPSTAT="REV"
35 .D BLD^EASEZLM
36 .W ! D WAIT^DICD,EN^VALM("EAS EZ 1010EZ REVIEW2")
37 .S VALMBCK="Q"
38 I '$G(EASDFN) S VALMBCK="R"
39 Q
40 ;
41ACCFLD ;accept a single 1010EZ data element
42 ;if data element was previously accepted, this action returns to non-accepted status
43 ;input EASAPP = pointer to file #712 for 1010EZ
44 ; EASPSTAT = current processing status of Application;
45 ;result ACCEPT = 1, if toggled to accepted
46 ; 0, if toggled to non-accepted
47 N J,LN,SUBIEN,KEYIEN,MULTIPLE,ACCEPT,ACTION,LINK,ONE
48 Q:'EASAPP Q:EASPSTAT=""
49 Q:'EASLN
50 S ACTION="'Accept Field'"
51 I EASPSTAT="PRT" D NOACT^EASEZLM("Printed",ACTION) Q
52 I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
53 I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
54 I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
55 ;select data item to toggle
56 S VALMBCK=""
57 S ONE=0
58 S VALM("ENTITY")="Line Item" D SELRNGE^EASEZLM
59 Q:$G(EASERR)
60 Q:'$G(EASSEL("BG"))
61 ;
62 I EASSEL("BG")=EASSEL("LST") S ONE=1
63 ;
64 S J=0 F S J=$O(EASSEL(J)) Q:'J S EASLN=J D
65 .S LN=$G(^TMP("EASEXP",$J,"IDX",EASLN))
66 .Q:LN=""
67 .S SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
68 .S EZDATA=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1),XFILE=$P($G(^TMP("EZDATA",$J,KEYIEN)),U,1)
69 .Q:EZDATA=""
70 .Q:'SUBIEN
71 .S ACCEPT=$P($G(^EAS(712,EASAPP,10,SUBIEN,0)),U,3)
72 .;provide info to user only if exactly one line item being 'accepted'
73 .I ONE D FULL^VALM1
74 .;don't allow accept of data which cannot be filed
75 .I ((XFILE=0)!(ACCEPT=-1)) D:ONE Q
76 ..W !!,?5,"Sorry, that data element cannot be 'Accepted' for 'Filing'."
77 ..W !!,?5,"After filing this Application to VistA, use Register a Patient "
78 ..W !,?5,"or Patient Enrollment to enter/update data as needed.",!
79 ..K DIR D PAUSE^VALM1 S VALMBCK="R"
80 .;if an 'always' accept data element, don't allow user to toggle off;
81 .I ACCEPT=2 D:ONE Q
82 ..W !!,?5,"Sorry, that data element must be 'Accepted' for this Applicant."
83 ..I XFILE'=355.33 D
84 ...W !!,?5,"After filing this Application to VistA, the Registration options"
85 ...W !,?5,"can be used to modify data as needed.",!
86 ..I XFILE=355.33 D
87 ...W !!,?5,"After filing this Application to VistA, Integrated Billing users"
88 ...W !,?5,"can modify the data using the 'Process Insurance Buffer' option.",!
89 ..K DIR D PAUSE^VALM1 S VALMBCK="R"
90 .;don't allow 'updated' element to be toggled off;
91 .S UPD=$P($G(^EAS(712,EASAPP,10,SUBIEN,1)),U,2) I UPD'="" D:ONE Q
92 ..W !!,?5,"Sorry, that data element has been Updated and must be 'Accepted'"
93 ..W !,?5,"for this Applicant."
94 ..K DIR D PAUSE^VALM1 S VALMBCK="R"
95 .;toggle 'accept' indicator for line itme
96 .S ACCEPT=$$ATOGGLE(EASLN,SUBIEN,ACCEPT)
97 ;
98 Q
99 ;
100ATOGGLE(EASLN,SUBIEN,ACCEPT) ;toggle 'accept' on line item
101 S ACCEPT='ACCEPT
102 S $P(^EAS(712,EASAPP,10,SUBIEN,0),U,3)=ACCEPT
103 ;highlight data on screen
104 I ACCEPT D CNTRL^VALM10(EASLN,27,25,IORVON,IORVOFF)
105 I 'ACCEPT D CNTRL^VALM10(EASLN,27,25,IORVOFF,IORVOFF)
106 D WRITE^VALM10(EASLN)
107 S VALMBCK="R"
108 Q ACCEPT
109 ;
110ACCALL ;accept all non-null 1010EZ data elements
111 ;prevously accepted data elements are not toggled to non-accepted
112 ;input EASAPP = pointer to file #712 for 1010EZ
113 ; EASPSTAT = current processing status of Application;
114 N EASLN,ACTION,XFILE
115 Q:'EASAPP Q:EASPSTAT=""
116 S ACTION="'Accept All'"
117 I EASPSTAT="PRT" D NOACT^EASEZLM("Printed",ACTION) Q
118 I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
119 I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
120 I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
121 ;
122 S EASLN=0 F S EASLN=$O(^TMP("EASEXP",$J,"IDX",EASLN)) Q:'EASLN D
123 .S SUBIEN=$P(^TMP("EASEXP",$J,"IDX",EASLN),U,1),MULTIPLE=$P(^(EASLN),U,2),KEYIEN=$P(^(EASLN),U,3)
124 .S XFILE=$P(^TMP("EZDATA",$J,KEYIEN),U,1)
125 .Q:XFILE=0
126 .S EZDATA=$P($G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),U,1) I EZDATA'="" D
127 ..I $P(^EAS(712,EASAPP,10,SUBIEN,0),U,3)="" S $P(^(0),U,3)=1
128 ..D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
129 ..Q:(EASLN<VALMBG)!(EASLN>VALMLST)
130 ..D CNTRL^VALM10(EASLN,27,25,IORVON,IORVOFF)
131 ..D WRITE^VALM10(EASLN)
132 ;
133 ;update processing status if necessary
134 I EASPSTAT="NEW" D
135 .D SETDATE^EASEZU2(EASAPP,"REV") S EASPSTAT="REV"
136 .D BLD^EASEZLM,HDR2^EASEZL1
137 S VALMBCK="R"
138 Q
139 ;
140CLEAR ;clear all accept indicators from subfile #712.01 & LM array
141 ;input EASAPP = ien to #712 for Application
142 ; EASPSTAT = current processing status of Application;
143 N BB,EASLN,ACTION
144 Q:'EASAPP Q:EASPSTAT=""
145 S ACTION="'Clear All'"
146 I EASPSTAT="PRT" D NOACT^EASEZLM("Printed",ACTION) Q
147 I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
148 I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
149 I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
150 ;
151 ;if a new patient, don't allow user to reset all accept
152 I $G(EASEZNEW) D Q
153 .D FULL^VALM1
154 .W !!,?5,"Sorry, the 'Clear All' action cannot be used for this new patient."
155 .W !,?5,"It is recommended that all data elements be 'Accepted' for 'Filing'."
156 .W !!,?5,"After filing the Application to VistA, the Registration options"
157 .W !,?5,"can be used to modify data.",!
158 .D PAUSE^VALM1 S VALMBCK="R"
159 ;
160 ;clear accept flags and updates
161 ;remove accept indicators from List Manager display array
162 S EASLN=0 F S EASLN=$O(^TMP("EASEXP",$J,"IDX",EASLN)) Q:'EASLN D
163 .S SUBIEN=$P(^TMP("EASEXP",$J,"IDX",EASLN),U,1)
164 .;don't clear if updated
165 .Q:'SUBIEN
166 .I $P($G(^EAS(712,EASAPP,10,SUBIEN,0)),U,3)=1 D
167 ..F P=3,4,5 S $P(^EAS(712,EASAPP,10,SUBIEN,0),U,P)=""
168 ..S $P(^EAS(712,EASAPP,10,SUBIEN,1),U,2)=""
169 ..S $P(^EAS(712,EASAPP,10,SUBIEN,2),U,1)=""
170 ..D FLDCTRL^VALM10(EASLN,"EZDATA",IORVOFF,IORVOFF)
171 ..Q:(EASLN<VALMBG)!(EASLN>VALMLST)
172 ..D CNTRL^VALM10(EASLN,27,25,IORVOFF,IORVOFF) D WRITE^VALM10(EASLN)
173 S VALMBCK=""
174 Q
175 ;
176RESET ;reset 1010EZ Application to 'new' processing status
177 ;input EASAPP = pointer to file #712 for 1010EZ
178 ; EASPSTAT = current processing status of Application;
179 ;this action must be follwed by an 'exit' action from the List Manager screen
180 N ACTION,NEWDATE
181 Q:'EASAPP Q:EASPSTAT=""
182 S ACTION="'Reset to New'"
183 I EASPSTAT="SIG" D NOACT^EASEZLM("Signed",ACTION) Q
184 I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
185 I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
186 ;
187 D OKRESET
188 ;update to 'New' status
189 S EASPSTAT="NEW",NEWDATE=$P(^EAS(712,EASAPP,0),U,6)
190 D REINDEX^EASEZU2(EASAPP,EASPSTAT,NEWDATE)
191 ;rebuild selection list since this application is removed from list
192 D BLD^EASEZLM
193 I 'VALMCNT D NOLINES^EASEZLM
194 W !,"Application has been Reset to New...",!
195 D PAUSE^VALM1
196 S VALMBCK="Q"
197 Q
198 ;
199OKRESET ;perform all housekeeping to for 'reset to new' or 'inactivate'
200 N BB,DA,DR,DIE,REM
201 ;remove status indicator fields from file #712 record
202 S DA=EASAPP,DIE="^EAS(712,"
203 S DR="5.1///^S X=""@"";5.2///^S X=""@"";6.1///^S X=""@"";6.2///^S X=""@"";8.1///^S X=""@"";8.2///^S X=""@"";"
204 D ^DIE
205 ;
206 ;delete link to file #2
207 I '$G(EASDFN) S EASDFN=$P(^EAS(712,EASAPP,0),U,10)
208 S $P(^EAS(712,EASAPP,0),U,10)=""
209 I $G(EASDFN) K ^EAS(712,"AC",EASDFN,EASAPP)
210 ;remove all links to VistA datbase
211 ;delete link, delete updated data, remove accept in each subfile #712.01 record
212 S BB=0 F S BB=$O(^EAS(712,EASAPP,10,BB)) Q:'BB D
213 .F P=3,4,5 S $P(^EAS(712,EASAPP,10,BB,0),U,P)=""
214 .S $P(^EAS(712,EASAPP,10,BB,1),U,2)=""
215 .F P=1,2 S $P(^EAS(712,EASAPP,10,BB,2),U,P)=""
216 ;
217 ;clear new patient indicator since applicant must be re-matched to VistA;
218 ;but if this applicant is matched again with same new stub record in VistA,
219 ; there's a comment in file #2/field #.091 to indicate the record was previously
220 ; added by 1010EZ process
221 ;update 'new patient' remark
222 I '$G(EASEZNEW) S EASEZNEW=$P(^EAS(712,EASAPP,0),U,11)
223 S $P(^EAS(712,EASAPP,0),U,11)=""
224 I EASEZNEW,EASDFN D
225 .S REM="New Patient record added by ELECTRONIC 10-10EZ."
226 .S DA=EASDFN,DIE="^DPT(",DR=".091///^S X=REM"
227 .D ^DIE
228 Q
Note: See TracBrowser for help on using the repository browser.