- IVMLSU ;ALB/MLI/KCL - IVM SSA/SSN UPLOAD ; 28-MAY-93
- ;;Version 2.0 ; INCOME VERIFICATION MATCH ;**2**; 21-OCT-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; This routine will be used to upload SSN's for a veteran and/or
- ; the veteran's spouse. These SSN's were suggested by SSA after
- ; checking the date of birth, sex, and name of the person. They
- ; are not automatically uploaded, but allow the user to upload
- ; or purge them if they so choose.
- ;
- EN ; - Main entry point for IVML SSN UPDATE
- D BLD
- ;
- ; - if no entries exist in "ASEG" x-ref Quit
- I IVMCT=0 G EXIT
- D EN^VALM("IVM SSN UPDATE")
- Q
- ;
- ;
- BLD ; - Build array of patients with suggested SSN's for uploading
- N IVMI,IVMJ
- S IVMCT=0
- K ^TMP("IVMUP",$J)
- W !,"Building list for display..."
- ;
- ; - change if HL7 seg sep ever changes!
- S HLFS="^"
- ;
- ; - get records from 'ASEG' x-ref
- S IVMI=0 F S IVMI=$O(^IVM(301.5,"ASEG","ZIV",IVMI)) Q:'IVMI D
- .S IVMJ=0 F S IVMJ=$O(^IVM(301.5,"ASEG","ZIV",IVMI,IVMJ)) Q:'IVMJ D
- ..S IVMSP="",IVMCT=IVMCT+1 W:'(IVMCT#15) "."
- ..S IVM0ND=$G(^IVM(301.5,IVMI,0)) I IVM0ND']"" Q
- ..S IVMSEG=$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST")) I IVMSEG']"" Q
- ..S DFN=+IVM0ND,IVMDPT0=$G(^DPT(+DFN,0)) I IVMDPT0']"" Q
- ..;
- ..; - check for 'date of death' in Patient (#2) file or ZIV segment
- ..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:"")
- ..;
- ..; - patient name and SSN in Patient (#2) file
- ..S IVMNM=$P(IVMDPT0,"^",1),IVMSSN=$P(IVMDPT0,"^",9)
- ..;
- ..; - if new spouse SSN and Patient Relation IEN, get Patient or
- ..; Income person zeroth node
- ..I $P(IVMSEG,HLFS,6),$P(IVMSEG,HLFS,7) S IVMSP=$$DEM^DGMTU1(+$P(IVMSEG,HLFS,7))
- ..; - build line for display
- ..D BLDLN
- ;
- I IVMCT=0 W !!,"There is no IVM patient data to be uploaded at this time.",!,*7
- ;
- BLDQ K DFN,IVM0ND,IVMBL,IVMDOD,IVMDPT0,IVMSEG,IVMSP
- Q
- ;
- ;
- BLDLN ; - Build storage array with data for view in list man (called from BLD)
- N X
- ; - if DHCP SSN is does not equal IVM SSA/SSN do
- I $P(IVMDPT0,"^",9)'=$P(IVMSEG,"^",4) D
- .;
- .; - X = vet name, dhcp/ssn, ssa/ssn
- .S X=IVMNM_"^"_IVMSSN_"^"_$P(IVMSEG,"^",4)
- .;
- .; - if spouse DHCP SSN does not equal IVM SSA/SSN set ^TMP array
- .I IVMSP]"",$P(IVMSP,"^",9)'=$P(IVMSEG,"^",6) D ; get spouse name, dhcp/ssn, ssa/ssn
- ..;
- ..; - patient data_spouse data
- ..S X=X_"^"_$P(IVMSP,"^",1)_"^"_$P(IVMSP,"^",9)_"^"_$P(IVMSEG,"^",6)
- .;
- .; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
- .S ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$P(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
- ;
- ;
- ; - if patient DHCP SSN equals IVM SSA/SSN and spouse DHCP SSN does not
- ; equal IVM SSA/SSN set ^TMP array
- I $P(IVMDPT0,"^",9)=$P(IVMSEG,"^",4),IVMSP]"",($P(IVMSP,"^",9)'=$P(IVMSEG,"^",6)) D
- .;
- .; - vet name, DHCP/SSN - SSA/SSN is not displayed
- .S X=IVMNM_"^"_IVMSSN_"^"
- .;
- .; - spouse name, DHCP/SSN, IVM SSA/SSN
- .S X=X_"^"_$P(IVMSP,"^",1)_"^"_$P(IVMSP,"^",9)_"^"_$P(IVMSEG,"^",6)
- .;
- .; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
- .S ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$P(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
- Q
- ;
- ;
- EXIT ; - Exit code - kill temporary arrays
- K ^TMP("IVMLST",$J),^TMP("IVMUP",$J),IVMCT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLSU 3382 printed Mar 13, 2025@21:06:06 Page 2
- IVMLSU ;ALB/MLI/KCL - IVM SSA/SSN UPLOAD ; 28-MAY-93
- +1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;**2**; 21-OCT-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; This routine will be used to upload SSN's for a veteran and/or
- +5 ; the veteran's spouse. These SSN's were suggested by SSA after
- +6 ; checking the date of birth, sex, and name of the person. They
- +7 ; are not automatically uploaded, but allow the user to upload
- +8 ; or purge them if they so choose.
- +9 ;
- EN ; - Main entry point for IVML SSN UPDATE
- +1 DO BLD
- +2 ;
- +3 ; - if no entries exist in "ASEG" x-ref Quit
- +4 IF IVMCT=0
- GOTO EXIT
- +5 DO EN^VALM("IVM SSN UPDATE")
- +6 QUIT
- +7 ;
- +8 ;
- BLD ; - Build array of patients with suggested SSN's for uploading
- +1 NEW IVMI,IVMJ
- +2 SET IVMCT=0
- +3 KILL ^TMP("IVMUP",$JOB)
- +4 WRITE !,"Building list for display..."
- +5 ;
- +6 ; - change if HL7 seg sep ever changes!
- +7 SET HLFS="^"
- +8 ;
- +9 ; - get records from 'ASEG' x-ref
- +10 SET IVMI=0
- FOR
- SET IVMI=$ORDER(^IVM(301.5,"ASEG","ZIV",IVMI))
- if 'IVMI
- QUIT
- Begin DoDot:1
- +11 SET IVMJ=0
- FOR
- SET IVMJ=$ORDER(^IVM(301.5,"ASEG","ZIV",IVMI,IVMJ))
- if 'IVMJ
- QUIT
- Begin DoDot:2
- +12 SET IVMSP=""
- SET IVMCT=IVMCT+1
- if '(IVMCT#15)
- WRITE "."
- +13 SET IVM0ND=$GET(^IVM(301.5,IVMI,0))
- IF IVM0ND']""
- QUIT
- +14 SET IVMSEG=$GET(^IVM(301.5,IVMI,"IN",IVMJ,"ST"))
- IF IVMSEG']""
- QUIT
- +15 SET DFN=+IVM0ND
- SET IVMDPT0=$GET(^DPT(+DFN,0))
- IF IVMDPT0']""
- QUIT
- +16 ;
- +17 ; - check for 'date of death' in Patient (#2) file or ZIV segment
- +18 SET IVMDOD=$SELECT($PIECE($GET(^DPT(+DFN,.35)),"^")]"":"D"_$PIECE($GET(^DPT(+DFN,.35)),"^"),$PIECE(IVMSEG,HLFS,12)]"":"I"_$$FMDATE^HLFNC($PIECE(IVMSEG,HLFS,12)),1:"")
- +19 ;
- +20 ; - patient name and SSN in Patient (#2) file
- +21 SET IVMNM=$PIECE(IVMDPT0,"^",1)
- SET IVMSSN=$PIECE(IVMDPT0,"^",9)
- +22 ;
- +23 ; - if new spouse SSN and Patient Relation IEN, get Patient or
- +24 ; Income person zeroth node
- +25 IF $PIECE(IVMSEG,HLFS,6)
- IF $PIECE(IVMSEG,HLFS,7)
- SET IVMSP=$$DEM^DGMTU1(+$PIECE(IVMSEG,HLFS,7))
- +26 ; - build line for display
- +27 DO BLDLN
- End DoDot:2
- End DoDot:1
- +28 ;
- +29 IF IVMCT=0
- WRITE !!,"There is no IVM patient data to be uploaded at this time.",!,*7
- +30 ;
- BLDQ KILL DFN,IVM0ND,IVMBL,IVMDOD,IVMDPT0,IVMSEG,IVMSP
- +1 QUIT
- +2 ;
- +3 ;
- BLDLN ; - Build storage array with data for view in list man (called from BLD)
- +1 NEW X
- +2 ; - if DHCP SSN is does not equal IVM SSA/SSN do
- +3 IF $PIECE(IVMDPT0,"^",9)'=$PIECE(IVMSEG,"^",4)
- Begin DoDot:1
- +4 ;
- +5 ; - X = vet name, dhcp/ssn, ssa/ssn
- +6 SET X=IVMNM_"^"_IVMSSN_"^"_$PIECE(IVMSEG,"^",4)
- +7 ;
- +8 ; - if spouse DHCP SSN does not equal IVM SSA/SSN set ^TMP array
- +9 ; get spouse name, dhcp/ssn, ssa/ssn
- IF IVMSP]""
- IF $PIECE(IVMSP,"^",9)'=$PIECE(IVMSEG,"^",6)
- Begin DoDot:2
- +10 ;
- +11 ; - patient data_spouse data
- +12 SET X=X_"^"_$PIECE(IVMSP,"^",1)_"^"_$PIECE(IVMSP,"^",9)_"^"_$PIECE(IVMSEG,"^",6)
- End DoDot:2
- +13 ;
- +14 ; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
- +15 SET ^TMP("IVMUP",$JOB,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$PIECE(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
- End DoDot:1
- +16 ;
- +17 ;
- +18 ; - if patient DHCP SSN equals IVM SSA/SSN and spouse DHCP SSN does not
- +19 ; equal IVM SSA/SSN set ^TMP array
- +20 IF $PIECE(IVMDPT0,"^",9)=$PIECE(IVMSEG,"^",4)
- IF IVMSP]""
- IF ($PIECE(IVMSP,"^",9)'=$PIECE(IVMSEG,"^",6))
- Begin DoDot:1
- +21 ;
- +22 ; - vet name, DHCP/SSN - SSA/SSN is not displayed
- +23 SET X=IVMNM_"^"_IVMSSN_"^"
- +24 ;
- +25 ; - spouse name, DHCP/SSN, IVM SSA/SSN
- +26 SET X=X_"^"_$PIECE(IVMSP,"^",1)_"^"_$PIECE(IVMSP,"^",9)_"^"_$PIECE(IVMSEG,"^",6)
- +27 ;
- +28 ; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
- +29 SET ^TMP("IVMUP",$JOB,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$PIECE(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
- End DoDot:1
- +30 QUIT
- +31 ;
- +32 ;
- EXIT ; - Exit code - kill temporary arrays
- +1 KILL ^TMP("IVMLST",$JOB),^TMP("IVMUP",$JOB),IVMCT
- +2 QUIT