source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLSU.m@ 661

Last change on this file since 661 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1IVMLSU ;ALB/MLI/KCL - IVM SSA/SSN UPLOAD ; 28-MAY-93
2 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;**2**; 21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine will be used to upload SSN's for a veteran and/or
6 ; the veteran's spouse. These SSN's were suggested by SSA after
7 ; checking the date of birth, sex, and name of the person. They
8 ; are not automatically uploaded, but allow the user to upload
9 ; or purge them if they so choose.
10 ;
11EN ; - Main entry point for IVML SSN UPDATE
12 D BLD
13 ;
14 ; - if no entries exist in "ASEG" x-ref Quit
15 I IVMCT=0 G EXIT
16 D EN^VALM("IVM SSN UPDATE")
17 Q
18 ;
19 ;
20BLD ; - Build array of patients with suggested SSN's for uploading
21 N IVMI,IVMJ
22 S IVMCT=0
23 K ^TMP("IVMUP",$J)
24 W !,"Building list for display..."
25 ;
26 ; - change if HL7 seg sep ever changes!
27 S HLFS="^"
28 ;
29 ; - get records from 'ASEG' x-ref
30 S IVMI=0 F S IVMI=$O(^IVM(301.5,"ASEG","ZIV",IVMI)) Q:'IVMI D
31 .S IVMJ=0 F S IVMJ=$O(^IVM(301.5,"ASEG","ZIV",IVMI,IVMJ)) Q:'IVMJ D
32 ..S IVMSP="",IVMCT=IVMCT+1 W:'(IVMCT#15) "."
33 ..S IVM0ND=$G(^IVM(301.5,IVMI,0)) I IVM0ND']"" Q
34 ..S IVMSEG=$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST")) I IVMSEG']"" Q
35 ..S DFN=+IVM0ND,IVMDPT0=$G(^DPT(+DFN,0)) I IVMDPT0']"" Q
36 ..;
37 ..; - check for 'date of death' in Patient (#2) file or ZIV segment
38 ..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:"")
39 ..;
40 ..; - patient name and SSN in Patient (#2) file
41 ..S IVMNM=$P(IVMDPT0,"^",1),IVMSSN=$P(IVMDPT0,"^",9)
42 ..;
43 ..; - if new spouse SSN and Patient Relation IEN, get Patient or
44 ..; Income person zeroth node
45 ..I $P(IVMSEG,HLFS,6),$P(IVMSEG,HLFS,7) S IVMSP=$$DEM^DGMTU1(+$P(IVMSEG,HLFS,7))
46 ..; - build line for display
47 ..D BLDLN
48 ;
49 I IVMCT=0 W !!,"There is no IVM patient data to be uploaded at this time.",!,*7
50 ;
51BLDQ K DFN,IVM0ND,IVMBL,IVMDOD,IVMDPT0,IVMSEG,IVMSP
52 Q
53 ;
54 ;
55BLDLN ; - Build storage array with data for view in list man (called from BLD)
56 N X
57 ; - if DHCP SSN is does not equal IVM SSA/SSN do
58 I $P(IVMDPT0,"^",9)'=$P(IVMSEG,"^",4) D
59 .;
60 .; - X = vet name, dhcp/ssn, ssa/ssn
61 .S X=IVMNM_"^"_IVMSSN_"^"_$P(IVMSEG,"^",4)
62 .;
63 .; - if spouse DHCP SSN does not equal IVM SSA/SSN set ^TMP array
64 .I IVMSP]"",$P(IVMSP,"^",9)'=$P(IVMSEG,"^",6) D ; get spouse name, dhcp/ssn, ssa/ssn
65 ..;
66 ..; - patient data_spouse data
67 ..S X=X_"^"_$P(IVMSP,"^",1)_"^"_$P(IVMSP,"^",9)_"^"_$P(IVMSEG,"^",6)
68 .;
69 .; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
70 .S ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$P(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
71 ;
72 ;
73 ; - if patient DHCP SSN equals IVM SSA/SSN and spouse DHCP SSN does not
74 ; equal IVM SSA/SSN set ^TMP array
75 I $P(IVMDPT0,"^",9)=$P(IVMSEG,"^",4),IVMSP]"",($P(IVMSP,"^",9)'=$P(IVMSEG,"^",6)) D
76 .;
77 .; - vet name, DHCP/SSN - SSA/SSN is not displayed
78 .S X=IVMNM_"^"_IVMSSN_"^"
79 .;
80 .; - spouse name, DHCP/SSN, IVM SSA/SSN
81 .S X=X_"^"_$P(IVMSP,"^",1)_"^"_$P(IVMSP,"^",9)_"^"_$P(IVMSEG,"^",6)
82 .;
83 .; - ^tmp("ivmup",$j,pt name,pt ssn,ivm ien)=dfn^spien^display elements
84 .S ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)=DFN_"^"_+$P(IVMSEG,HLFS,7)_"^"_IVMDOD_"^"_X
85 Q
86 ;
87 ;
88EXIT ; - Exit code - kill temporary arrays
89 K ^TMP("IVMLST",$J),^TMP("IVMUP",$J),IVMCT
90 Q
Note: See TracBrowser for help on using the repository browser.