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

IVMLSU.m

Go to the documentation of this file. 
  1. IVMLSU ;ALB/MLI/KCL - IVM SSA/SSN UPLOAD ; 28-MAY-93
  1.  ;;Version 2.0 ; INCOME VERIFICATION MATCH ;**2**; 21-OCT-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ; This routine will be used to upload SSN's for a veteran and/or
  1.  ; the veteran's spouse.  These SSN's were suggested by SSA after
  1.  ; checking the date of birth, sex, and name of the person.  They
  1.  ; are not automatically uploaded, but allow the user to upload
  1.  ; or purge them if they so choose.
  1.  ;
  1. EN ; - Main entry point for IVML SSN UPDATE
  1.  D BLD
  1.  ;
  1.  ; - if no entries exist in "ASEG" x-ref Quit
  1.  I IVMCT=0 G EXIT
  1.  D EN^VALM("IVM SSN UPDATE")
  1.  Q
  1.  ;
  1.  ;
  1. BLD ; - Build array of patients with suggested SSN's for uploading
  1.  N IVMI,IVMJ
  1.  S IVMCT=0
  1.  K ^TMP("IVMUP",$J)
  1.  W !,"Building list for display..."
  1.  ;
  1.  ; - change if HL7 seg sep ever changes!
  1.  S HLFS="^"
  1.  ;
  1.  ; - get records from 'ASEG' x-ref
  1.  S IVMI=0 F  S IVMI=$O(^IVM(301.5,"ASEG","ZIV",IVMI)) Q:'IVMI  D
  1.  .S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,"ASEG","ZIV",IVMI,IVMJ)) Q:'IVMJ  D
  1.  ..S IVMSP="",IVMCT=IVMCT+1 W:'(IVMCT#15) "."
  1.  ..S IVM0ND=$G(^IVM(301.5,IVMI,0)) I IVM0ND']"" Q
  1.  ..S IVMSEG=$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST")) I IVMSEG']"" Q
  1.  ..S DFN=+IVM0ND,IVMDPT0=$G(^DPT(+DFN,0)) I IVMDPT0']"" Q
  1.  ..;
  1.  ..; - check for 'date of death' in Patient (#2) file or ZIV segment
  1.  ..S IVMDOD=$S($P($G(^DPT(+DFN,.35)),"^")]"":"D"_$P($G(^DPT(+DFN,.35)),"^"),$P(IVMSEG,HLFS,12)]"":"I"_$$FMDATE^HLFNC($P(IVMSEG,HLFS,12)),1:"")
  1.  ..;
  1.  ..; - patient name and SSN in Patient (#2) file
  1.  ..S IVMNM=$P(IVMDPT0,"^",1),IVMSSN=$P(IVMDPT0,"^",9)
  1.  ..;
  1.  ..; - if new spouse SSN and Patient Relation IEN, get Patient or
  1.  ..;   Income person zeroth node
  1.  ..I $P(IVMSEG,HLFS,6),$P(IVMSEG,HLFS,7) S IVMSP=$$DEM^DGMTU1(+$P(IVMSEG,HLFS,7))
  1.  ..; - build line for display
  1.  ..D BLDLN
  1.  ;
  1.  I IVMCT=0 W !!,"There is no IVM patient data to be uploaded at this time.",!,*7
  1.  ;
  1. BLDQ K DFN,IVM0ND,IVMBL,IVMDOD,IVMDPT0,IVMSEG,IVMSP
  1.  Q
  1.  ;
  1.  ;
  1. BLDLN ; - Build storage array with data for view in list man (called from BLD)
  1.  N X
  1.  ; - if DHCP SSN is does not equal IVM SSA/SSN do
  1.  I $P(IVMDPT0,"^",9)'=$P(IVMSEG,"^",4) D
  1.  .;
  1.  .; - X = vet name, dhcp/ssn, ssa/ssn
  1.  .S X=IVMNM_"^"_IVMSSN_"^"_$P(IVMSEG,"^",4)
  1.  .;
  1.  .; - if spouse DHCP SSN does not equal IVM SSA/SSN set ^TMP array
  1.  .I IVMSP]"",$P(IVMSP,"^",9)'=$P(IVMSEG,"^",6) D  ; get spouse name, dhcp/ssn, ssa/ssn
  1.  ..;
  1.  ..; - patient data_spouse data
  1.  ..S X=X_"^"_$P(IVMSP,"^",1)_"^"_$P(IVMSP,"^",9)_"^"_$P(IVMSEG,"^",6)
  1.  .;
  1.  .; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
  1.  .S ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$P(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
  1.  ;
  1.  ;
  1.  ; - if patient DHCP SSN equals IVM SSA/SSN and spouse DHCP SSN does not
  1.  ;   equal IVM SSA/SSN set ^TMP array
  1.  I $P(IVMDPT0,"^",9)=$P(IVMSEG,"^",4),IVMSP]"",($P(IVMSP,"^",9)'=$P(IVMSEG,"^",6)) D
  1.  .;
  1.  .; - vet name, DHCP/SSN - SSA/SSN is not displayed
  1.  .S X=IVMNM_"^"_IVMSSN_"^"
  1.  .;
  1.  .; - spouse name, DHCP/SSN, IVM SSA/SSN 
  1.  .S X=X_"^"_$P(IVMSP,"^",1)_"^"_$P(IVMSP,"^",9)_"^"_$P(IVMSEG,"^",6)
  1.  .;
  1.  .; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
  1.  .S ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$P(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
  1.  Q
  1.  ;
  1.  ;
  1. EXIT ; - Exit code - kill temporary arrays
  1.  K ^TMP("IVMLST",$J),^TMP("IVMUP",$J),IVMCT
  1.  Q