Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMLDEM7

IVMLDEM7.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ;
  1. ADDR(DFN,IVMDA2,IVMDA1,IVMDA,IVMPPICK) ; - function to check if the delete field
  1.  ;                          is an address field and return a flag.
  1.  ;
  1.  ;
  1.  ;  Input:      DFN  -  as patient IEN
  1.  ;           IVMDA2  -  pointer to case record in (#301.5) file
  1.  ;           IVMDA1  -  pointer to PID msg in (#301.501) sub-file
  1.  ;            IVMDA  -  pointer to record in (#301.511) sub-file
  1.  ;         IVMPPICK  -  residence phone number and/or another address
  1.  ;                        field selected
  1.  ;                      0 - phone or an address field not selected 
  1.  ;                      1 - address field(s) selected
  1.  ;                      2 - phone selected
  1.  ;                      3 - both address field(s) and phone selected
  1.  ;
  1.  ; Output: IVMFLAG   -  1 if field is an address field
  1.  ;                      0 if field is not an address field
  1.  ;
  1.  ;
  1.  N IVMFLAG,IVMI,IVMJ,IVMNODE,IVMPTR,Y,IVMFNAM
  1.  ;
  1.  ; - initialize flag
  1.  S IVMFLAG=0
  1.  ;
  1.  ; - check for required parameters
  1.  I '$G(DFN)!('$G(IVMDA))!('$G(IVMDA1))!'($G(IVMDA2)) G ADDRQ
  1.  ;
  1.  ; - get pointer to (#301.92) file from (#301.511) sub-file
  1.  S IVMPTR=+$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)) G ADDRQ:'IVMPTR
  1.  ;
  1.  ;
  1. ASK I '$D(^IVM(301.92,"AD",+IVMPTR)) G ADDRQ
  1.  I IVMPPICK=2 G ASK1
  1.  W ! S DIR("A")="Do you wish to proceed with this action"
  1.  S DIR("A",1)="You have selected to delete an address field."
  1.  S DIR("A",2)="You will be required to delete the entire address."
  1.  S DIR("?")="Enter 'YES' to continue or 'NO' to abort."
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  S IVMFLAG=1
  1.  I 'Y,IVMPPICK=1 G ADDRQ    ;only address selected so quit
  1.  I 'Y S IVMPPICK=2 G ASK1   ;check if phone should be deleted
  1.  W ! S DIR("A")="Are you sure that you want to delete the complete address"
  1.  S DIR("A",1)="If you delete this address, then the previously filed address"
  1.  S DIR("A",2)="will be transmitted to HEC and all sites visited by this patient."
  1.  S DIR("?",1)="Enter 'YES' to delete the complete address that was received from"
  1.  S DIR("?")="HEC.  Enter 'NO' to quit."
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  S IVMFLAG=1
  1.  I 'Y,IVMPPICK=1 G ADDRQ    ;only address selected so quit
  1.  I 'Y S IVMPPICK=2 G ASK1   ;check if phone # should be deleted
  1.  ;
  1.  ; file new Address Change Date/Time
  1.  N FDA,ERRMSG
  1.  S FDA(2,DFN_",",.118)=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  D FILE^DIE("E","FDA","ERRMSG")
  1.  ;
  1.  I IVMPPICK=3 G ASK1   ;check if phone # should be deleted
  1.  ;
  1. LOOP ; - loop thru fields in ^IVM(301.92,"AD" x-ref
  1.  I IVMPPICK'=2 W !,"Deleting address fields... "
  1.  S IVMI=0 F  S IVMI=$O(^IVM(301.92,"AD",IVMI)) Q:IVMI']""  D
  1.  .S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ)) Q:IVMJ']""  D
  1.  ..;
  1.  ..; - check for data node in (#301.511) sub-file
  1.  ..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0)) Q:IVMNODE']""
  1.  ..Q:'(+IVMNODE)!($P(IVMNODE,"^",2)']"")
  1.  ..;
  1.  ..S IVMFNAM=$P($G(^IVM(301.92,+IVMNODE,0)),U) Q:IVMFNAM=""
  1.  ..; - check if residence phone number and not selected to delete
  1.  ..I IVMPPICK=1&(IVMFNAM="PHONE NUMBER [RESIDENCE]"!(IVMFNAM["RESIDENCE NUMBER CHANGE")) Q
  1.  ..; - check if not residence phone number and only phone selected to delete
  1.  ..I IVMPPICK=2&(IVMFNAM'="PHONE NUMBER [RESIDENCE]"&(IVMFNAM'["RESIDENCE NUMBER CHANGE")) Q
  1.  ..;
  1.  ..; - remove entry from (#301.511) sub-file
  1.  ..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
  1.  ..S IVMFLAG=1
  1.  ;
  1.  I IVMFLAG S VALMBCK="R" W "completed.",!
  1.  ;
  1. ADDRQ ; - return  -->  1 if delete field is an address field
  1.  ;           -->  0 if delete field is not an address field
  1.  ;
  1.  I IVMFLAG D RESET^IVMLDEMU
  1.  Q IVMFLAG
  1.  ;
  1. ASK1 ; - phone selected to be deleted - address fields not selected
  1.  W ! S DIR("A")="Okay to delete the PHONE NUMBER [RESIDENCE] field"
  1.  S DIR("?",1)="Enter 'YES' to delete the patient's Phone Number [Residence] that was"
  1.  S DIR("?",2)="received from HEC.  Enter 'NO' to quit."
  1.  S DIR(0)="Y",DIR("B")="YES"
  1.  D ^DIR K DIR
  1.  S IVMFLAG=1
  1.  I 'Y,IVMPPICK=2 G ADDRQ   ;no phone or address deletions, just quit
  1.  I 'Y S IVMPPICK=1 G LOOP  ;address still needs to be deleted
  1.  ;
  1.  W !,"Deleting PHONE NUMBER [RESIDENCE] field from the list... "
  1.  G LOOP