IVMLDEM7 ;ALB/KCL,LBD - IVM DEMOGRAPHIC UPLOAD - DELETE ADDRESS ; 3/11/12 2:39pm
;;2.0;INCOME VERIFICATION MATCH;**10,79,152**; 21-OCT-94;Build 4
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
ADDR(DFN,IVMDA2,IVMDA1,IVMDA,IVMPPICK) ; - function to check if the delete field
; is an address field and return a flag.
;
;
; Input: DFN - as patient IEN
; IVMDA2 - pointer to case record in (#301.5) file
; IVMDA1 - pointer to PID msg in (#301.501) sub-file
; IVMDA - pointer to record in (#301.511) sub-file
; IVMPPICK - residence phone number and/or another address
; field selected
; 0 - phone or an address field not selected
; 1 - address field(s) selected
; 2 - phone selected
; 3 - both address field(s) and phone selected
;
; Output: IVMFLAG - 1 if field is an address field
; 0 if field is not an address field
;
;
N IVMFLAG,IVMI,IVMJ,IVMNODE,IVMPTR,Y,IVMFNAM
;
; - initialize flag
S IVMFLAG=0
;
; - check for required parameters
I '$G(DFN)!('$G(IVMDA))!('$G(IVMDA1))!'($G(IVMDA2)) G ADDRQ
;
; - get pointer to (#301.92) file from (#301.511) sub-file
S IVMPTR=+$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)) G ADDRQ:'IVMPTR
;
;
ASK I '$D(^IVM(301.92,"AD",+IVMPTR)) G ADDRQ
I IVMPPICK=2 G ASK1
W ! S DIR("A")="Do you wish to proceed with this action"
S DIR("A",1)="You have selected to delete an address field."
S DIR("A",2)="You will be required to delete the entire address."
S DIR("?")="Enter 'YES' to continue or 'NO' to abort."
S DIR(0)="Y",DIR("B")="NO"
D ^DIR K DIR
S IVMFLAG=1
I 'Y,IVMPPICK=1 G ADDRQ ;only address selected so quit
I 'Y S IVMPPICK=2 G ASK1 ;check if phone should be deleted
W ! S DIR("A")="Are you sure that you want to delete the complete address"
S DIR("A",1)="If you delete this address, then the previously filed address"
S DIR("A",2)="will be transmitted to HEC and all sites visited by this patient."
S DIR("?",1)="Enter 'YES' to delete the complete address that was received from"
S DIR("?")="HEC. Enter 'NO' to quit."
S DIR(0)="Y",DIR("B")="NO"
D ^DIR K DIR
S IVMFLAG=1
I 'Y,IVMPPICK=1 G ADDRQ ;only address selected so quit
I 'Y S IVMPPICK=2 G ASK1 ;check if phone # should be deleted
;
; file new Address Change Date/Time
N FDA,ERRMSG
S FDA(2,DFN_",",.118)=$$FMTE^XLFDT($$NOW^XLFDT)
D FILE^DIE("E","FDA","ERRMSG")
;
I IVMPPICK=3 G ASK1 ;check if phone # should be deleted
;
LOOP ; - loop thru fields in ^IVM(301.92,"AD" x-ref
I IVMPPICK'=2 W !,"Deleting address fields... "
S IVMI=0 F S IVMI=$O(^IVM(301.92,"AD",IVMI)) Q:IVMI']"" D
.S IVMJ=0 F S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ)) Q:IVMJ']"" D
..;
..; - check for data node in (#301.511) sub-file
..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0)) Q:IVMNODE']""
..Q:'(+IVMNODE)!($P(IVMNODE,"^",2)']"")
..;
..S IVMFNAM=$P($G(^IVM(301.92,+IVMNODE,0)),U) Q:IVMFNAM=""
..; - check if residence phone number and not selected to delete
..I IVMPPICK=1&(IVMFNAM="PHONE NUMBER [RESIDENCE]"!(IVMFNAM["RESIDENCE NUMBER CHANGE")) Q
..; - check if not residence phone number and only phone selected to delete
..I IVMPPICK=2&(IVMFNAM'="PHONE NUMBER [RESIDENCE]"&(IVMFNAM'["RESIDENCE NUMBER CHANGE")) Q
..;
..; - remove entry from (#301.511) sub-file
..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
..S IVMFLAG=1
;
I IVMFLAG S VALMBCK="R" W "completed.",!
;
ADDRQ ; - return --> 1 if delete field is an address field
; --> 0 if delete field is not an address field
;
I IVMFLAG D RESET^IVMLDEMU
Q IVMFLAG
;
ASK1 ; - phone selected to be deleted - address fields not selected
W ! S DIR("A")="Okay to delete the PHONE NUMBER [RESIDENCE] field"
S DIR("?",1)="Enter 'YES' to delete the patient's Phone Number [Residence] that was"
S DIR("?",2)="received from HEC. Enter 'NO' to quit."
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR
S IVMFLAG=1
I 'Y,IVMPPICK=2 G ADDRQ ;no phone or address deletions, just quit
I 'Y S IVMPPICK=1 G LOOP ;address still needs to be deleted
;
W !,"Deleting PHONE NUMBER [RESIDENCE] field from the list... "
G LOOP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEM7 4406 printed Apr 09, 2024@21:03:14 Page 2
IVMLDEM7 ;ALB/KCL,LBD - IVM DEMOGRAPHIC UPLOAD - DELETE ADDRESS ; 3/11/12 2:39pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**10,79,152**; 21-OCT-94;Build 4
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
ADDR(DFN,IVMDA2,IVMDA1,IVMDA,IVMPPICK) ; - function to check if the delete field
+1 ; is an address field and return a flag.
+2 ;
+3 ;
+4 ; Input: DFN - as patient IEN
+5 ; IVMDA2 - pointer to case record in (#301.5) file
+6 ; IVMDA1 - pointer to PID msg in (#301.501) sub-file
+7 ; IVMDA - pointer to record in (#301.511) sub-file
+8 ; IVMPPICK - residence phone number and/or another address
+9 ; field selected
+10 ; 0 - phone or an address field not selected
+11 ; 1 - address field(s) selected
+12 ; 2 - phone selected
+13 ; 3 - both address field(s) and phone selected
+14 ;
+15 ; Output: IVMFLAG - 1 if field is an address field
+16 ; 0 if field is not an address field
+17 ;
+18 ;
+19 NEW IVMFLAG,IVMI,IVMJ,IVMNODE,IVMPTR,Y,IVMFNAM
+20 ;
+21 ; - initialize flag
+22 SET IVMFLAG=0
+23 ;
+24 ; - check for required parameters
+25 IF '$GET(DFN)!('$GET(IVMDA))!('$GET(IVMDA1))!'($GET(IVMDA2))
GOTO ADDRQ
+26 ;
+27 ; - get pointer to (#301.92) file from (#301.511) sub-file
+28 SET IVMPTR=+$GET(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0))
if 'IVMPTR
GOTO ADDRQ
+29 ;
+30 ;
ASK IF '$DATA(^IVM(301.92,"AD",+IVMPTR))
GOTO ADDRQ
+1 IF IVMPPICK=2
GOTO ASK1
+2 WRITE !
SET DIR("A")="Do you wish to proceed with this action"
+3 SET DIR("A",1)="You have selected to delete an address field."
+4 SET DIR("A",2)="You will be required to delete the entire address."
+5 SET DIR("?")="Enter 'YES' to continue or 'NO' to abort."
+6 SET DIR(0)="Y"
SET DIR("B")="NO"
+7 DO ^DIR
KILL DIR
+8 SET IVMFLAG=1
+9 ;only address selected so quit
IF 'Y
IF IVMPPICK=1
GOTO ADDRQ
+10 ;check if phone should be deleted
IF 'Y
SET IVMPPICK=2
GOTO ASK1
+11 WRITE !
SET DIR("A")="Are you sure that you want to delete the complete address"
+12 SET DIR("A",1)="If you delete this address, then the previously filed address"
+13 SET DIR("A",2)="will be transmitted to HEC and all sites visited by this patient."
+14 SET DIR("?",1)="Enter 'YES' to delete the complete address that was received from"
+15 SET DIR("?")="HEC. Enter 'NO' to quit."
+16 SET DIR(0)="Y"
SET DIR("B")="NO"
+17 DO ^DIR
KILL DIR
+18 SET IVMFLAG=1
+19 ;only address selected so quit
IF 'Y
IF IVMPPICK=1
GOTO ADDRQ
+20 ;check if phone # should be deleted
IF 'Y
SET IVMPPICK=2
GOTO ASK1
+21 ;
+22 ; file new Address Change Date/Time
+23 NEW FDA,ERRMSG
+24 SET FDA(2,DFN_",",.118)=$$FMTE^XLFDT($$NOW^XLFDT)
+25 DO FILE^DIE("E","FDA","ERRMSG")
+26 ;
+27 ;check if phone # should be deleted
IF IVMPPICK=3
GOTO ASK1
+28 ;
LOOP ; - loop thru fields in ^IVM(301.92,"AD" x-ref
+1 IF IVMPPICK'=2
WRITE !,"Deleting address fields... "
+2 SET IVMI=0
FOR
SET IVMI=$ORDER(^IVM(301.92,"AD",IVMI))
if IVMI']""
QUIT
Begin DoDot:1
+3 SET IVMJ=0
FOR
SET IVMJ=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ))
if IVMJ']""
QUIT
Begin DoDot:2
+4 ;
+5 ; - check for data node in (#301.511) sub-file
+6 SET IVMNODE=$GET(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0))
if IVMNODE']""
QUIT
+7 if '(+IVMNODE)!($PIECE(IVMNODE,"^",2)']"")
QUIT
+8 ;
+9 SET IVMFNAM=$PIECE($GET(^IVM(301.92,+IVMNODE,0)),U)
if IVMFNAM=""
QUIT
+10 ; - check if residence phone number and not selected to delete
+11 IF IVMPPICK=1&(IVMFNAM="PHONE NUMBER [RESIDENCE]"!(IVMFNAM["RESIDENCE NUMBER CHANGE"))
QUIT
+12 ; - check if not residence phone number and only phone selected to delete
+13 IF IVMPPICK=2&(IVMFNAM'="PHONE NUMBER [RESIDENCE]"&(IVMFNAM'["RESIDENCE NUMBER CHANGE"))
QUIT
+14 ;
+15 ; - remove entry from (#301.511) sub-file
+16 DO DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
+17 SET IVMFLAG=1
End DoDot:2
End DoDot:1
+18 ;
+19 IF IVMFLAG
SET VALMBCK="R"
WRITE "completed.",!
+20 ;
ADDRQ ; - return --> 1 if delete field is an address field
+1 ; --> 0 if delete field is not an address field
+2 ;
+3 IF IVMFLAG
DO RESET^IVMLDEMU
+4 QUIT IVMFLAG
+5 ;
ASK1 ; - phone selected to be deleted - address fields not selected
+1 WRITE !
SET DIR("A")="Okay to delete the PHONE NUMBER [RESIDENCE] field"
+2 SET DIR("?",1)="Enter 'YES' to delete the patient's Phone Number [Residence] that was"
+3 SET DIR("?",2)="received from HEC. Enter 'NO' to quit."
+4 SET DIR(0)="Y"
SET DIR("B")="YES"
+5 DO ^DIR
KILL DIR
+6 SET IVMFLAG=1
+7 ;no phone or address deletions, just quit
IF 'Y
IF IVMPPICK=2
GOTO ADDRQ
+8 ;address still needs to be deleted
IF 'Y
SET IVMPPICK=1
GOTO LOOP
+9 ;
+10 WRITE !,"Deleting PHONE NUMBER [RESIDENCE] field from the list... "
+11 GOTO LOOP
