1 | IVMLDEM4 ;ALB/KCL,PJR - IVM DEMOGRAPHIC UPLOAD/DELETE FIELDS ; 11/22/04 2:27pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**5,10,56,102**; 21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | UF ; - (action) select uploadable demographic fields for filing
|
---|
7 | ;
|
---|
8 | ; Input: IVMWHERE -- as where the action is coming from
|
---|
9 | ;
|
---|
10 | ; -- If action from UPLOADABLE list:
|
---|
11 | ; array of uploadable fields as
|
---|
12 | ; ^TMP("IVMUPLOAD",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
|
---|
13 | ;
|
---|
14 | ;
|
---|
15 | ; - generic seletor used within list manager action
|
---|
16 | N VALMY,IVMDOD S IVMDOD=0
|
---|
17 | D EN^VALM2($G(XQORNOD(0)))
|
---|
18 | Q:'$D(VALMY)
|
---|
19 | ;
|
---|
20 | N IVMPKDOD D CHECKS,CHECKDOD
|
---|
21 | ;
|
---|
22 | S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
|
---|
23 | .;
|
---|
24 | .S IVMINDEX=$G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4)) I IVMINDEX']"" Q
|
---|
25 | .;
|
---|
26 | .; - check to see if selection is an address field
|
---|
27 | .S IVMADDR=$$ADDR^IVMLDEM6(+IVMINDEX,$P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4),IVMPPICK)
|
---|
28 | .;
|
---|
29 | .Q:IVMADDR
|
---|
30 | .;
|
---|
31 | .; - check to see if selection is a Date of Death field
|
---|
32 | .I IVMPKDOD S IVMDOD=$$DOD^IVMLDEMD(+IVMINDEX,$P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4))
|
---|
33 | .;
|
---|
34 | .Q:IVMDOD
|
---|
35 | .;
|
---|
36 | .; - ask user if they are sure they want to update field
|
---|
37 | .D RUSURE^IVMLDEMU($P(IVMINDEX,"^",8),"update") I IVMOUT!'IVMSURE Q
|
---|
38 | .;
|
---|
39 | .W !,"Updating "_$P(IVMINDEX,"^",8)_" field... "
|
---|
40 | .;
|
---|
41 | .; - upload value received from IVM into DHCP field
|
---|
42 | .D UPLOAD^IVMLDEMU(DFN,$P(IVMINDEX,"^",6),$P(IVMINDEX,"^",7),$P(IVMINDEX,"^",5))
|
---|
43 | .;
|
---|
44 | .; - remove entry from file (#301.5)
|
---|
45 | .D DELENT^IVMLDEMU($P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4)) W "completed."
|
---|
46 | .;
|
---|
47 | ;
|
---|
48 | ; - hold display before building list
|
---|
49 | D PAUSE^VALM1
|
---|
50 | ;
|
---|
51 | ; - init the list and re-display to the user
|
---|
52 | D INIT^IVMLDEM2
|
---|
53 | ;
|
---|
54 | DEQ ; clean-up variables
|
---|
55 | D QACTION
|
---|
56 | Q
|
---|
57 | ;
|
---|
58 | ;
|
---|
59 | DF ; - (action) select uploadable/non-uploadable demographic fields for deletion
|
---|
60 | ;
|
---|
61 | ; Input: IVMWHERE -- as where the action is coming from
|
---|
62 | ;
|
---|
63 | ; -- If action from UPLOADABLE list:
|
---|
64 | ; array of uploadable fields as
|
---|
65 | ; ^TMP("IVMUPLOAD",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
|
---|
66 | ;
|
---|
67 | ; OR
|
---|
68 | ;
|
---|
69 | ; -- If action from NON-UPLOADABLE list:
|
---|
70 | ; array of non-uploadable fields as
|
---|
71 | ; ^TMP("IVMNONUP",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
|
---|
72 | ;
|
---|
73 | ;
|
---|
74 | ; Output: None
|
---|
75 | ;
|
---|
76 | ; - generic seletor used within list manager action
|
---|
77 | N VALMY
|
---|
78 | D EN^VALM2($G(XQORNOD(0)))
|
---|
79 | Q:'$D(VALMY)
|
---|
80 | ;
|
---|
81 | ; - determine array depending on variable IVMWHERE
|
---|
82 | S IVMARRAY=$S(IVMWHERE="UP":"IVMUPLOAD",1:"IVMNONUP")
|
---|
83 | ;
|
---|
84 | N IVMPKDOD D CHECKS,CHECKDOD
|
---|
85 | ;
|
---|
86 | S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
|
---|
87 | .;
|
---|
88 | .I IVMWHERE="NON" D DF^IVMLDEM8 Q ; non-uploadable fields
|
---|
89 | .;
|
---|
90 | .; - get selected entry for uploadable fields
|
---|
91 | .S IVMINDEX=$G(^TMP(IVMARRAY,$J,"IDX",IVMENT4,IVMENT4)) Q:IVMINDEX']""
|
---|
92 | .;
|
---|
93 | .; - check to see if selection is an address field
|
---|
94 | .S IVMADDR=$$ADDR^IVMLDEM7(+IVMINDEX,$P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4),IVMPPICK)
|
---|
95 | .;
|
---|
96 | .Q:IVMADDR
|
---|
97 | .;
|
---|
98 | .; - ask user if they are sure they want to delete field
|
---|
99 | .D RUSURE^IVMLDEMU($P(IVMINDEX,"^",8),"delete") I IVMOUT!'IVMSURE Q
|
---|
100 | .;
|
---|
101 | .W !,"Deleting "_$P(IVMINDEX,"^",8)_" field from the list... "
|
---|
102 | .;
|
---|
103 | .;if Date of Death is Deleted, send bulletin
|
---|
104 | .I IVMPKDOD D BULLETIN S IVMPKDOD=0
|
---|
105 | .;- remove entry from file (#301.5)
|
---|
106 | .D DELENT^IVMLDEMU($P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4)) W "completed."
|
---|
107 | ;
|
---|
108 | ; - hold display before re-building list
|
---|
109 | D PAUSE^VALM1
|
---|
110 | ;
|
---|
111 | ; - init the list and re-display to the user
|
---|
112 | D @$S(IVMWHERE="UP":"INIT^IVMLDEM2",1:"INIT^IVMLDEM3")
|
---|
113 | ;
|
---|
114 | DFQ ; clean-up variables
|
---|
115 | D QACTION
|
---|
116 | Q
|
---|
117 | ;
|
---|
118 | ;
|
---|
119 | CHECKS ; check if residence phone number selected
|
---|
120 | ; check if another address field selected
|
---|
121 | ; IVMPPICK=0 phone or an address field not selected
|
---|
122 | ; 1 address field(s) selected
|
---|
123 | ; 2 phone selected
|
---|
124 | ; 3 both address field(s) and phone selected
|
---|
125 | ;
|
---|
126 | N IVMPPIC1,IVMPPIC2
|
---|
127 | S (IVMPPICK,IVMPPIC2)=0
|
---|
128 | Q:IVMWHERE'="UP"
|
---|
129 | S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
|
---|
130 | .I $G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4))["PHONE NUMBER [RESIDENCE]" S IVMPPICK=2 Q
|
---|
131 | .S IVMINDEX=$G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4)) I IVMINDEX']"" Q
|
---|
132 | .S IVMPPIC1=+$G(^IVM(301.5,+$P(IVMINDEX,"^",2),"IN",+$P(IVMINDEX,"^",3),"DEM",+$P(IVMINDEX,"^",4),0)) Q:'IVMPPIC1
|
---|
133 | .S:$D(^IVM(301.92,"AD",+IVMPPIC1)) IVMPPIC2=1
|
---|
134 | .Q
|
---|
135 | S IVMPPICK=IVMPPICK+IVMPPIC2
|
---|
136 | Q
|
---|
137 | ;
|
---|
138 | CHECKDOD ; check if date of death was selected
|
---|
139 | ; IVMPKDOD=0 date of death not selected
|
---|
140 | ; 1 date of death selected
|
---|
141 | ;
|
---|
142 | N IVMPPIC1,IVMPPIC2,CKST
|
---|
143 | S (IVMPKDOD,IVMPPIC2)=0
|
---|
144 | Q:IVMWHERE'="UP"
|
---|
145 | S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
|
---|
146 | .S CKST=$G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4))
|
---|
147 | .I CKST["DATE OF DEATH"!(CKST["SOURCE OF NOTIFICATION")!(CKST["DATE OF DEATH LAST UPDATED") S IVMPKDOD=1 Q
|
---|
148 | Q
|
---|
149 | BULLETIN ; Non-Acceptance of Date of Death Data Bulletin
|
---|
150 | N DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
|
---|
151 | S DGMGRP=$O(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
|
---|
152 | Q:'DGMGRP
|
---|
153 | D XMY^DGMTUTL(DGMGRP,0,1)
|
---|
154 | S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^DPT(DFN,0)),"^",9)
|
---|
155 | S XMTEXT="DGBULL("
|
---|
156 | S XMSUB="NON-ACCEPTANCE OF DATE OF DEATH DATA"
|
---|
157 | S DGLINE=0
|
---|
158 | D LINE^DGEN("Patient: "_DGNAME,.DGLINE)
|
---|
159 | D LINE^DGEN("SSN: "_DGSSN,.DGLINE)
|
---|
160 | D LINE^DGEN("",.DGLINE)
|
---|
161 | D LINE^DGEN("This Veteran's Enrollment Record contains a Date of Death,",.DGLINE)
|
---|
162 | D LINE^DGEN("however, you did not upload this information into VistA.",.DGLINE)
|
---|
163 | D LINE^DGEN("Contact the HEC by phone or by fax with the reason for",.DGLINE)
|
---|
164 | D LINE^DGEN("non-acceptance. The HEC will delete erroneous Date of Death",.DGLINE)
|
---|
165 | D LINE^DGEN("information and update the veteran's enrollment record.",.DGLINE)
|
---|
166 | D ^XMD
|
---|
167 | Q
|
---|
168 | QACTION ; - kill variables used from all protocols
|
---|
169 | S VALMBCK="R"
|
---|
170 | K IVMADDR,IVMARRAY,IVMENT4,IVMINDEX,IVMOUT,IVMPPICK,IVMSURE
|
---|
171 | Q
|
---|