source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZU5.m@ 975

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

initial load of WorldVistAEHR

File size: 7.5 KB
Line 
1EASEZU5 ;ALB/jap - Utilities for 1010EZ Processing ;10/25/00 13:08
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51**;Mar 15, 2001
3 ;
4PRTCOMP ;print comparison of 10-10EZ data with VistA data
5 N ACTION
6 S ACTION="'Print Data'"
7 ;no action if closed
8 I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
9 ;proceed with print of data comparison
10 W !,"Data Print queued to background...",!
11 S VALMBCK="R"
12 D PAUSE^VALM1
13 Q
14 ;
15UPDATE ;update/overwrite a 10-10EZ data element
16 N ACTION,SIGDATE,EASSEL,EASERR,EASLN,LN,SUBIEN,MULTIPLE,KEYIEN,UPDATE,UPDATE2,FILE,SUBFILE,FLD,FFF
17 N ORIGINAL,DATANM,UPDATE,CODE,FILE,SUBFILE,FLD,FDEF,FTYPE,ROOT,SETCODES,MIN,MAX,X,Y,DA,DR,DIC,DIE,DIR,X1,X2,X3
18 ;variable ORIGINAL holds original 1010EZ data
19 S ACTION="'Update Field'"
20 ;no action if closed
21 I EASPSTAT="CLS" D NOACT^EASEZLM("Inactivated",ACTION) Q
22 ;invalid for the following process status
23 I EASPSTAT="NEW" D NOACT^EASEZLM("New",ACTION) Q
24 I EASPSTAT="PRT" D NOACT^EASEZLM("Unsigned",ACTION) Q
25 I EASPSTAT="FIL" D NOACT^EASEZLM("Filed",ACTION) Q
26 ;select data item to update
27 S VALMBCK="R"
28 D SEL^EASEZLM
29 Q:$G(EASERR)
30 Q:'$G(EASSEL)
31 S EASLN=EASSEL
32 ;
33 ;use DIR reader to get input from user which overwrites 1010EZ data
34 D FULL^VALM1
35 S DIR(0)="",(FDEF,FTYPE)=""
36 S LN=^TMP("EASEXP",$J,"IDX",EASLN),SUBIEN=$P(LN,U,1),MULTIPLE=$P(LN,U,2),KEYIEN=$P(LN,U,3)
37 S X=$G(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1)),ORIGINAL=$P(X,U,1),ACCEPT=$P(X,U,2)
38 S DATANM=$P($G(^EAS(711,KEYIEN,0)),U,1)
39 S DIR("A")=DATANM
40 ;if #3 of file #711 is defined then use to set DIR(0);
41 S X=$G(^EAS(711,KEYIEN,3)) I X'="" X X
42 S FFF=$G(^EAS(711,KEYIEN,1)),FILE=$P(FFF,U,1),SUBFILE=$P(FFF,U,2),FLD=$P(FFF,U,3)
43 ;don't allow updates to data which cannot be filed
44 I ((FILE=0)!(ACCEPT=-1)) D Q
45 .W !!,?5,"Sorry...the selected data element cannot be 'Updated'."
46 .D ADDMSG ;alb/cmf/51
47 .W !!,?5,"After filing this Application to VistA, use Register a Patient "
48 .W !,?5,"or Patient Enrollment to enter/update data as needed.",!
49 .K DIR D PAUSE^VALM1 S VALMBCK="R"
50 ;exceptions for data input; too complex for simple DIR call;
51 I DATANM["NAME",DATANM'["OTHER" D ANAME^EASEZU6(EASLN,LN,DATANM) Q
52 I DATANM["PHONE" D APHONE^EASEZU6(EASLN,LN,DATANM) Q
53 I DATANM["COUNTY" D ACOUNTY^EASEZU6(EASLN,LN,DATANM) Q
54 I DATANM["STATE" D ASTATE^EASEZU6(EASLN,LN,DATANM) Q
55 I DATANM["SOCIAL SECURITY NUMBER",FILE'=2 D ASSN^EASEZU6(EASLN,LN,DATANM,ACCEPT) Q
56 ;setup DIR(0) for remaining mapped-to data elements
57 I DIR(0)="",FLD'=0 D
58 .;use DIR read based on mapped-to file/field for all other data elements
59 .I (SUBFILE=FILE)!(SUBFILE="") S FDEF=FILE
60 .E S FDEF=SUBFILE
61 .S FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
62 .;can't use DD type read, some fields will error because DA is not defined for the input transform;
63 .;so set DIR(0) according to field type of VistA target location instead;
64 .I FTYPE["POINTER" D
65 ..;mapped to pointer field
66 ..S ROOT=$$GET1^DID(FDEF,FLD,"","POINTER")
67 ..I ROOT'="" S DIR(0)="P"_U_ROOT_":EMZ"
68 .I FTYPE="SET" D
69 ..;mapped to set of codes field
70 ..S X=^DD(FDEF,FLD,0)
71 ..S SETCODES=$P(X,U,3) K X
72 ..S DIR(0)="S"_U_SETCODES
73 .I FTYPE="DATE/TIME" D
74 ..;mapped to date/time field
75 ..S DIR(0)="D^::AEP"
76 .I FTYPE="FREE TEXT" D
77 ..;mapped to free text field
78 ..S MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
79 ..I MAX S DIR(0)="F^1:"_MAX
80 ..E S DIR(0)="F^1:80"
81 .I FTYPE="NUMERIC" D
82 ..;mapped to numeric field
83 ..S FINP=$$GET1^DID(FDEF,FLD,"","INPUT TRANSFORM")
84 ..S MIN=+$P(FINP,"X<",2),MAX=+$P(FINP,"X>",2)
85 ..I MAX S DIR(0)="N"_U_MIN_":"_MAX_":0"
86 ..E S DIR(0)="N^0:9999999:0"
87 I FLD=0 D
88 .;unmapped data element
89 .I DIR(0)="" S DIR(0)="F^1:80"
90 ;make the DIR call for user input only if DIR(0) has been set
91 Q:DIR(0)=""
92 D ^DIR
93 ;don't continue if user exited w/o input
94 Q:($D(DTOUT)!$D(DUOUT))
95 K DIR,DTOUT,DUOUT,DIRUT
96 ;pickup the DIR output
97 S UPDATE=$P($G(Y(0)),U,1) S:UPDATE="" UPDATE=$P($G(Y),U,1)
98 ;don't continue if no data
99 Q:UPDATE=""
100 ;convert dates to mm/dd/yyyy
101 I FTYPE="DATE/TIME" D
102 .;Y holds date from DIR call in internal format
103 .S %F=5,UPDATE2=$$FMTE^XLFDT(Y,%F) I $L(UPDATE2)<10 D
104 ..S X1=$P(UPDATE2,"/",1),X2=$P(UPDATE2,"/",2),X3=$P(UPDATE2,"/",3)
105 ..S:$L(X1)=1 X1="0"_X1 S:$L(X2)=1 X2="0"_X2
106 ..S UPDATE2=X1_"/"_X2_"/"_X3
107 ..S UPDATE=UPDATE2
108 ;special handling for field #.362
109 I FILE=2,FLD=.362,EASVRSN>5.99 D
110 .I UPDATE["IN LIEU OF VA COMP" S UPDATE="YES"
111 .I UPDATE="YES, RECEIVING MILITARY RETIREMENT" S UPDATE="NO"
112 ;don't continue if no change to data
113 Q:(UPDATE=ORIGINAL)
114 Q:(UPDATE="")
115 ;
116 I 'ACCEPT S ACCEPT=1
117 S $P(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1),U,1,2)=UPDATE_U_ACCEPT
118 ;file data element; any manually updated element is 'accepted'
119 S DIE="^EAS(712,EASAPP,10,",DA=SUBIEN,DA(1)=EASAPP,DR(1)="10;"
120 S DR="1.5///^S X=UPDATE;1.1///^S X=ACCEPT;1.2///^S X=DT;1.3////^S X=DUZ"
121 D ^DIE
122 S VALMBCK="R"
123 ;update screen list
124 D FLDTEXT^VALM10(EASLN,"EZDATA",UPDATE)
125 D FLDCTRL^VALM10(EASLN,"EZDATA",IORVON,IORVOFF)
126 D WRITE^VALM10(EASLN)
127 Q
128 ;
129REMSIG ;remove signature verification from selected Application
130 N APP,STATUS,DA,DIC,DR,DIR,DIRUT,DUOUT,DTOUT,S,X,Y
131 W @IOF
132 W !!,"Lookup and selection for Signature Verification Removal"
133 W !,"is by Application # only."
134 W !!,"Only Applications with a Signature Verification Date, but no"
135 W !,"Filing Date may be selected.",!!
136 S DIC="^EAS(712,",DIC(0)="AENQXZ",DIC("S")="I +$P($G(^(1)),U,2)>0,+$P($G(^(2)),U,5)=0"
137 D ^DIC
138 S APP=+Y
139 I APP>0 D
140 .S DIR(0)="YA",DIR("A")="Are you sure Signature Verification should be removed? (Y/N): " D ^DIR
141 .Q:$D(DIRUT)
142 .Q:'Y
143 .W !!,"One moment please...",!
144 .;remove signature verification data; update audit fields for sig. removal
145 .S DA=APP K X,Y
146 .S DIE=DIC,DR="4///^S X=""@"";4.1///^S X=""@"";4.2///^S X=""@"";4.6///^S X=DT;4.7////^S X=DUZ"
147 .D ^DIE
148 .D APPINDEX^EASEZU2(APP)
149 .S S=$$CURRSTAT^EASEZU2(APP),STATUS=$S(S="PRT":"Printed, Pending Signature",1:"In Review")
150 .W !!,"Signature Verification removed..."
151 .W !!,"Application #"_APP_" STATUS -- ",STATUS
152 W !!
153 Q
154 ;
155ADDMSG ;alb/cmf/51 - special update messages by field
156 N SECT,S1,S2
157 Q:EASVRSN<6
158 S SECT=$P($P(^EAS(711,KEYIEN,0),U,2),";")
159 Q:SECT'["II"
160 ;
161 I SECT="IIC" D Q
162 .I DATANM="CHILD1 GROSS ANNUAL INCOME2" D Q
163 ..D INCTOT("Gross Annual","gross annual")
164 .I DATANM="CHILD1 OTHER INCOME" D Q
165 ..D INCTOT("Other","other")
166 .I DATANM="CHILD1 FARM OR BUSINESS INCOME" D Q
167 ..D INCTOT("Farm/Business","farm/business")
168 ;
169 I SECT="IIE" D Q
170 .I DATANM="CHILD1 CASH IN BANK" D Q
171 ..D ASSTOT("Cash in Bank","cash in bank")
172 .I DATANM="CHILD1 REAL PROPERTY LESS MORTGAGES" D Q
173 ..D ASSTOT("Real Property","real property")
174 .I DATANM="CHILD1 STOCKS BONDS ASSETS LESS DEBTS" D Q
175 ..D ASSTOT("Other Property","other property")
176 ;
177 I SECT="IIG" D Q
178 .I DATANM="ASSET(N) CHILD CASH" D CHLDASS("Cash in Bank") Q
179 .I DATANM="ASSET(N) CHILD REAL PROPERTY" D CHLDASS("Real Property") Q
180 .I DATANM="ASSET(N) CHILD OTHER PROPERTY" D CHLDASS("Other Property") Q
181 Q
182 ;
183INCTOT(S1,S2) ; income total messages
184 W !!,?5,"The "_S1_" Income Child Total is the sum of the"
185 W !,?5,"individual child "_S2_" income values. The Child Total"
186 W !,?5,"may only be updated by adjusting the individual child"
187 W !,?5,S2_" income values. - or..."
188 Q
189 ;
190ASSTOT(S1,S2) ; asset total messages
191 W !!,?5,"The "_S1_" Child Total is the sum of the individual"
192 W !,?5,"child "_S2_" values and this total has been added to"
193 W !,?5,"the "_S1_" Veteran amount. The Child Total may only be"
194 W !,?5,"adjusted by updating the "_S1_" Veteran amount. - or..."
195 Q
196 ;
197CHLDASS(S1) ; child asset messages
198 W !!,?5,"The "_S1_" child amount has been added to the "_S1
199 W !,?5,"Veteran amount. The "_S1_" child amount may only"
200 W !,?5,"be adjusted by updating the "_S1_" Veteran amount."
201 W !,?5," - or..."
202 Q
203 ;
Note: See TracBrowser for help on using the repository browser.