source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPREC5.m@ 623

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IVMPREC5 ;ALB/KCL - PROCESS INCOMING (Z03 EVENT TYPE) HL7 MESSAGES ; 3/6/01 4:42pm
2 ;;2.0;INCOME VERIFICATION MATCH;**2,17,34**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine will process batch ORU SSN(event type Z03) HL7
6 ; messages received from the IVM center. Format of batch:
7 ; BHS
8 ; {MSH
9 ; PID
10 ; ZIV
11 ; }
12 ; BTS
13 ;
14EN ; entry point to process SSN messages
15 ;
16 F IVMDA=1:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D
17 .K HLERR
18 .S HLMID=$P(IVMSEG,HLFS,10) ; message control id from MSH
19 .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="PID" D Q
20 ..S HLERR="Missing PID segment" D ACK^IVMPREC
21 .S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH),1)
22 .I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
23 ..S HLERR="Invalid DFN" D ACK^IVMPREC
24 .I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) D Q
25 ..S HLERR="Couldn't match IVM SSN with DHCP SSN" D ACK^IVMPREC
26 .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="ZIV" D Q
27 ..S HLERR="Missing ZIV segment" D ACK^IVMPREC
28 .S IVMSEG=$P(IVMSEG,HLFS,2,999),IVMIY=$P(IVMSEG,HLFS,2)
29 .S IVMIY=$$FMDATE^HLFNC(IVMIY) I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) S HLERR="Invalid Income Year" D ACK^IVMPREC Q
30 .;
31 .I $P(IVMSEG,"^",4)=$P($G(^DPT(DFN,0)),"^",9) D Q
32 ..S HLERR="Client SSN already on file in DHCP" D ACK^IVMPREC Q
33 .I $P(IVMSEG,"^",6)]"",$P(IVMSEG,"^",7)']"" D Q
34 ..S HLERR="Missing spouse IEN" D ACK^IVMPREC Q
35 .I $P(IVMSEG,"^",6)]"",($P(IVMSEG,"^",6)=$P($$DEM^DGMTU1(+$P(IVMSEG,"^",7)),"^",9)) D Q
36 ..S HLERR="Spouse SSN already on file in DHCP" D ACK^IVMPREC Q
37 .;
38 .I $P(IVMSEG,"^",4)="",($P(IVMSEG,"^",6)=""!($P(IVMSEG,"^",7)="")) D Q
39 ..S HLERR="Missing client/spouse SSNs" D ACK^IVMPREC Q
40 .;
41 .D SSNCK I $D(HLERR) D ACK^IVMPREC Q
42 .D STORE
43 ;
44 ; - send notification message if necessary
45 I IVMCNTR D MAIL^IVMUFNC()
46 Q
47 ;
48SSNCK ; check to make sure the SSN(s) are valid SSA SSNs
49 ;
50 N FLAG,L,X
51 S FLAG=0 ; set to 1 if problem with SSN
52 ;
53 F X=$P(IVMSEG,"^",4),$P(IVMSEG,"^",6) Q:FLAG D
54 .S L=$E(X,1,3)
55 .I L="000" S FLAG=1 Q ; begins with 000
56 .I L>649,(L<700) S FLAG=1 Q ; 650-699 invalid
57 .I L>728 S FLAG=1 Q ; 729-999 invalid
58 I FLAG S HLERR="Invalid SSN sent"
59 Q
60 ;
61STORE ; store the ZIV segment in the (#301.5) file for uploading
62 ;
63 ; check for patient case record
64 S DA(1)=$O(^IVM(301.5,"B",+DFN,0)),X=$$IEN^IVMUFNC4("ZIV")
65 I DA(1)']"" S HLERR="Patient missing from IVM PATIENT file" D ACK^IVMPREC Q
66 I $G(^IVM(301.5,DA(1),"IN",0))']"" S ^(0)="^301.501PA^^"
67 S DIC="^IVM(301.5,"_DA(1)_",""IN"",",DIC(0)="L",DLAYGO=301.501
68 S DIC("DR")="10////^S X=IVMSEG"
69 K DD,DO D FILE^DICN
70 ;
71 ;
72STOREQ K DA,DIC,DIE,X,Y
73 ;
74 ;
75 ; build mail message if SUPPRESS SSN UPLOAD NOTIFICATION is not set
76 Q:$P($G(^IVM(301.9,1,0)),"^",3)
77 ;
78 ;
79ZIVBULL ; build mail message for transmission to IVM mail group notifying them
80 ; that patients with updated SSA/SSN's have been received from the
81 ; IVM Center and may now be uploaded into DHCP.
82 ;
83 S XMSUB="IVM - SSN UPLOAD"
84 S IVMTEXT(1)="Updated SSA/SSNs have been received from the Income Verification"
85 S IVMTEXT(2)="Match Center. Please select the 'SSN Upload' (SSN) option from the"
86 S IVMTEXT(3)="'IVM Upload Menu' in order to view/update these SSA/SSNs. If you"
87 S IVMTEXT(4)="have any questions concerning these updated SSA/SSNs, please contact"
88 S IVMTEXT(5)="the Income Verification Match Center."
89 S IVMTEXT(6)=""
90 S IVMTEXT(7)="The following patients have SSA/SSNs to be viewed/updated: "
91 S IVMTEXT(8)=" "
92 S IVMCNTR=IVMCNTR+1
93 S IVMPTID=$$PT^IVMUFNC4(DFN)
94 S IVMTEXT(IVMCNTR+8)=$J(IVMCNTR_")",5)_" "_$P(IVMPTID,"^")_" ("_$P(IVMPTID,"^",3)_")"
95 Q
Note: See TracBrowser for help on using the repository browser.