1 | IVMLDEM7 ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD - DELETE ADDRESS ; 5/28/03 3:55pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**10,79**; 21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | ADDR(DFN,IVMDA2,IVMDA1,IVMDA,IVMPPICK) ; - function to check if the delete field
|
---|
7 | ; is an address field and return a flag.
|
---|
8 | ;
|
---|
9 | ;
|
---|
10 | ; Input: DFN - as patient IEN
|
---|
11 | ; IVMDA2 - pointer to case record in (#301.5) file
|
---|
12 | ; IVMDA1 - pointer to PID msg in (#301.501) sub-file
|
---|
13 | ; IVMDA - pointer to record in (#301.511) sub-file
|
---|
14 | ; IVMPPICK - residence phone number and/or another address
|
---|
15 | ; field selected
|
---|
16 | ; 0 - phone or an address field not selected
|
---|
17 | ; 1 - address field(s) selected
|
---|
18 | ; 2 - phone selected
|
---|
19 | ; 3 - both address field(s) and phone selected
|
---|
20 | ;
|
---|
21 | ; Output: IVMFLAG - 1 if field is an address field
|
---|
22 | ; 0 if field is not an address field
|
---|
23 | ;
|
---|
24 | ;
|
---|
25 | N IVMFLAG,IVMI,IVMJ,IVMNODE,IVMPTR,Y
|
---|
26 | ;
|
---|
27 | ; - initialize flag
|
---|
28 | S IVMFLAG=0
|
---|
29 | ;
|
---|
30 | ; - check for required parameters
|
---|
31 | I '$G(DFN)!('$G(IVMDA))!('$G(IVMDA1))!'($G(IVMDA2)) G ADDRQ
|
---|
32 | ;
|
---|
33 | ; - get pointer to (#301.92) file from (#301.511) sub-file
|
---|
34 | S IVMPTR=+$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)) G ADDRQ:'IVMPTR
|
---|
35 | ;
|
---|
36 | ;
|
---|
37 | ASK I '$D(^IVM(301.92,"AD",+IVMPTR)) G ADDRQ
|
---|
38 | I IVMPPICK=2 G ASK1
|
---|
39 | W ! S DIR("A")="Do you wish to proceed with this action"
|
---|
40 | S DIR("A",1)="You have selected to delete an address field."
|
---|
41 | S DIR("A",2)="You will be required to delete the entire address."
|
---|
42 | S DIR("?")="Enter 'YES' to continue or 'NO' to abort."
|
---|
43 | S DIR(0)="Y",DIR("B")="NO"
|
---|
44 | D ^DIR K DIR
|
---|
45 | S IVMFLAG=1 G ADDRQ:'Y
|
---|
46 | W ! S DIR("A")="Are you sure that you want to delete the complete address"
|
---|
47 | S DIR("A",1)="If you delete this address, then the previously filed address"
|
---|
48 | S DIR("A",2)="will be transmitted to HEC and all sites visited by this patient."
|
---|
49 | S DIR("?",1)="Enter 'YES' to delete the complete address that was received from"
|
---|
50 | S DIR("?")="HEC. Enter 'NO' to quit."
|
---|
51 | S DIR(0)="Y",DIR("B")="NO"
|
---|
52 | D ^DIR K DIR
|
---|
53 | S IVMFLAG=1 G ADDRQ:'Y
|
---|
54 | ;
|
---|
55 | ; file new Address Change Date/Time
|
---|
56 | N FDA,ERRMSG
|
---|
57 | S FDA(2,DFN_",",.118)=$$FMTE^XLFDT($$NOW^XLFDT)
|
---|
58 | D FILE^DIE("E","FDA","ERRMSG")
|
---|
59 | ;
|
---|
60 | W !,"Deleting address fields... "
|
---|
61 | ;
|
---|
62 | LOOP ; - loop thru fields in ^IVM(301.92,"AD" x-ref
|
---|
63 | S IVMI=0 F S IVMI=$O(^IVM(301.92,"AD",IVMI)) Q:IVMI']"" D
|
---|
64 | .S IVMJ=0 F S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ)) Q:IVMJ']"" D
|
---|
65 | ..;
|
---|
66 | ..; - check for data node in (#301.511) sub-file
|
---|
67 | ..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0)) Q:IVMNODE']""
|
---|
68 | ..Q:'(+IVMNODE)!($P(IVMNODE,"^",2)']"")
|
---|
69 | ..;
|
---|
70 | ..; - check if residence phone number and not selected to delete
|
---|
71 | ..Q:(IVMPPICK=1&(+IVMNODE=$O(^IVM(301.92,"B","PHONE NUMBER [RESIDENCE]",0))))
|
---|
72 | ..; - check if not residence phone number and only phone selected to delete
|
---|
73 | ..Q:(IVMPPICK=2&(+IVMNODE'=$O(^IVM(301.92,"B","PHONE NUMBER [RESIDENCE]",0))))
|
---|
74 | ..;
|
---|
75 | ..; - remove entry from (#301.511) sub-file
|
---|
76 | ..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
|
---|
77 | ..S IVMFLAG=1
|
---|
78 | ;
|
---|
79 | I IVMFLAG S VALMBCK="R" W "completed.",!
|
---|
80 | ;
|
---|
81 | ADDRQ ; - return --> 1 if delete field is an address field
|
---|
82 | ; --> 0 if delete field is not an address field
|
---|
83 | ;
|
---|
84 | I IVMFLAG D RESET^IVMLDEMU
|
---|
85 | Q IVMFLAG
|
---|
86 | ;
|
---|
87 | ASK1 ; - phone selected to be deleted - address fields not selected
|
---|
88 | W ! S DIR("A")="Okay to delete the PHONE NUMBER [RESIDENCE] field"
|
---|
89 | S DIR("?",1)="Enter 'YES' to delete the patient's Phone Number [Residence] that was"
|
---|
90 | S DIR("?",2)="received from HEC. Enter 'NO' to quit."
|
---|
91 | S DIR(0)="Y",DIR("B")="YES"
|
---|
92 | D ^DIR K DIR
|
---|
93 | S IVMFLAG=1 G ADDRQ:'Y
|
---|
94 | W !,"Deleting PHONE NUMBER [RESIDENCE] field from the list... "
|
---|
95 | G LOOP
|
---|