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