source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEM7.m@ 1604

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IVMLDEM7 ;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 ;
6ADDR(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 ;
37ASK 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 ;
62LOOP ; - 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 ;
81ADDRQ ; - 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 ;
87ASK1 ; - 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
Note: See TracBrowser for help on using the repository browser.