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 Nov 22, 2024@17:12:11 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
