IVMPREC5 ;ALB/KCL - PROCESS INCOMING (Z03 EVENT TYPE) HL7 MESSAGES ; 3/6/01 4:42pm
;;2.0;INCOME VERIFICATION MATCH;**2,17,34**;21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine will process batch ORU SSN(event type Z03) HL7
; messages received from the IVM center. Format of batch:
; BHS
; {MSH
; PID
; ZIV
; }
; BTS
;
EN ; entry point to process SSN messages
;
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
.K HLERR
.S HLMID=$P(IVMSEG,HLFS,10) ; message control id from MSH
.S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="PID" D Q
..S HLERR="Missing PID segment" D ACK^IVMPREC
.S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH),1)
.I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
..S HLERR="Invalid DFN" D ACK^IVMPREC
.I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) D Q
..S HLERR="Couldn't match IVM SSN with DHCP SSN" D ACK^IVMPREC
.S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0)) I $E(IVMSEG,1,3)'="ZIV" D Q
..S HLERR="Missing ZIV segment" D ACK^IVMPREC
.S IVMSEG=$P(IVMSEG,HLFS,2,999),IVMIY=$P(IVMSEG,HLFS,2)
.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
.;
.I $P(IVMSEG,"^",4)=$P($G(^DPT(DFN,0)),"^",9) D Q
..S HLERR="Client SSN already on file in DHCP" D ACK^IVMPREC Q
.I $P(IVMSEG,"^",6)]"",$P(IVMSEG,"^",7)']"" D Q
..S HLERR="Missing spouse IEN" D ACK^IVMPREC Q
.I $P(IVMSEG,"^",6)]"",($P(IVMSEG,"^",6)=$P($$DEM^DGMTU1(+$P(IVMSEG,"^",7)),"^",9)) D Q
..S HLERR="Spouse SSN already on file in DHCP" D ACK^IVMPREC Q
.;
.I $P(IVMSEG,"^",4)="",($P(IVMSEG,"^",6)=""!($P(IVMSEG,"^",7)="")) D Q
..S HLERR="Missing client/spouse SSNs" D ACK^IVMPREC Q
.;
.D SSNCK I $D(HLERR) D ACK^IVMPREC Q
.D STORE
;
; - send notification message if necessary
I IVMCNTR D MAIL^IVMUFNC()
Q
;
SSNCK ; check to make sure the SSN(s) are valid SSA SSNs
;
N FLAG,L,X
S FLAG=0 ; set to 1 if problem with SSN
;
F X=$P(IVMSEG,"^",4),$P(IVMSEG,"^",6) Q:FLAG D
.S L=$E(X,1,3)
.I L="000" S FLAG=1 Q ; begins with 000
.I L>649,(L<700) S FLAG=1 Q ; 650-699 invalid
.I L>728 S FLAG=1 Q ; 729-999 invalid
I FLAG S HLERR="Invalid SSN sent"
Q
;
STORE ; store the ZIV segment in the (#301.5) file for uploading
;
; check for patient case record
S DA(1)=$O(^IVM(301.5,"B",+DFN,0)),X=$$IEN^IVMUFNC4("ZIV")
I DA(1)']"" S HLERR="Patient missing from IVM PATIENT file" D ACK^IVMPREC Q
I $G(^IVM(301.5,DA(1),"IN",0))']"" S ^(0)="^301.501PA^^"
S DIC="^IVM(301.5,"_DA(1)_",""IN"",",DIC(0)="L",DLAYGO=301.501
S DIC("DR")="10////^S X=IVMSEG"
K DD,DO D FILE^DICN
;
;
STOREQ K DA,DIC,DIE,X,Y
;
;
; build mail message if SUPPRESS SSN UPLOAD NOTIFICATION is not set
Q:$P($G(^IVM(301.9,1,0)),"^",3)
;
;
ZIVBULL ; build mail message for transmission to IVM mail group notifying them
; that patients with updated SSA/SSN's have been received from the
; IVM Center and may now be uploaded into DHCP.
;
S XMSUB="IVM - SSN UPLOAD"
S IVMTEXT(1)="Updated SSA/SSNs have been received from the Income Verification"
S IVMTEXT(2)="Match Center. Please select the 'SSN Upload' (SSN) option from the"
S IVMTEXT(3)="'IVM Upload Menu' in order to view/update these SSA/SSNs. If you"
S IVMTEXT(4)="have any questions concerning these updated SSA/SSNs, please contact"
S IVMTEXT(5)="the Income Verification Match Center."
S IVMTEXT(6)=""
S IVMTEXT(7)="The following patients have SSA/SSNs to be viewed/updated: "
S IVMTEXT(8)=" "
S IVMCNTR=IVMCNTR+1
S IVMPTID=$$PT^IVMUFNC4(DFN)
S IVMTEXT(IVMCNTR+8)=$J(IVMCNTR_")",5)_" "_$P(IVMPTID,"^")_" ("_$P(IVMPTID,"^",3)_")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPREC5 3857 printed Oct 16, 2024@18:03 Page 2
IVMPREC5 ;ALB/KCL - PROCESS INCOMING (Z03 EVENT TYPE) HL7 MESSAGES ; 3/6/01 4:42pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**2,17,34**;21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will process batch ORU SSN(event type Z03) HL7
+5 ; messages received from the IVM center. Format of batch:
+6 ; BHS
+7 ; {MSH
+8 ; PID
+9 ; ZIV
+10 ; }
+11 ; BTS
+12 ;
EN ; entry point to process SSN messages
+1 ;
+2 FOR IVMDA=1:0
SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
if 'IVMDA
QUIT
SET IVMSEG=$GET(^(IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)="MSH"
Begin DoDot:1
+3 KILL HLERR
+4 ; message control id from MSH
SET HLMID=$PIECE(IVMSEG,HLFS,10)
+5 SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
SET IVMSEG=$GET(^(+IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)'="PID"
Begin DoDot:2
+6 SET HLERR="Missing PID segment"
DO ACK^IVMPREC
End DoDot:2
QUIT
+7 SET DFN=$PIECE($PIECE(IVMSEG,HLFS,4),$EXTRACT(HLECH),1)
+8 IF ('DFN!(DFN'=+DFN)!('$DATA(^DPT(+DFN,0))))
Begin DoDot:2
+9 SET HLERR="Invalid DFN"
DO ACK^IVMPREC
End DoDot:2
QUIT
+10 IF $PIECE(IVMSEG,HLFS,20)'=$PIECE(^DPT(DFN,0),"^",9)
Begin DoDot:2
+11 SET HLERR="Couldn't match IVM SSN with DHCP SSN"
DO ACK^IVMPREC
End DoDot:2
QUIT
+12 SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
SET IVMSEG=$GET(^(+IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)'="ZIV"
Begin DoDot:2
+13 SET HLERR="Missing ZIV segment"
DO ACK^IVMPREC
End DoDot:2
QUIT
+14 SET IVMSEG=$PIECE(IVMSEG,HLFS,2,999)
SET IVMIY=$PIECE(IVMSEG,HLFS,2)
+15 SET IVMIY=$$FMDATE^HLFNC(IVMIY)
IF $EXTRACT(IVMIY,4,7)'="0000"!($EXTRACT(IVMIY,1,3)<292)
SET HLERR="Invalid Income Year"
DO ACK^IVMPREC
QUIT
+16 ;
+17 IF $PIECE(IVMSEG,"^",4)=$PIECE($GET(^DPT(DFN,0)),"^",9)
Begin DoDot:2
+18 SET HLERR="Client SSN already on file in DHCP"
DO ACK^IVMPREC
QUIT
End DoDot:2
QUIT
+19 IF $PIECE(IVMSEG,"^",6)]""
IF $PIECE(IVMSEG,"^",7)']""
Begin DoDot:2
+20 SET HLERR="Missing spouse IEN"
DO ACK^IVMPREC
QUIT
End DoDot:2
QUIT
+21 IF $PIECE(IVMSEG,"^",6)]""
IF ($PIECE(IVMSEG,"^",6)=$PIECE($$DEM^DGMTU1(+$PIECE(IVMSEG,"^",7)),"^",9))
Begin DoDot:2
+22 SET HLERR="Spouse SSN already on file in DHCP"
DO ACK^IVMPREC
QUIT
End DoDot:2
QUIT
+23 ;
+24 IF $PIECE(IVMSEG,"^",4)=""
IF ($PIECE(IVMSEG,"^",6)=""!($PIECE(IVMSEG,"^",7)=""))
Begin DoDot:2
+25 SET HLERR="Missing client/spouse SSNs"
DO ACK^IVMPREC
QUIT
End DoDot:2
QUIT
+26 ;
+27 DO SSNCK
IF $DATA(HLERR)
DO ACK^IVMPREC
QUIT
+28 DO STORE
End DoDot:1
+29 ;
+30 ; - send notification message if necessary
+31 IF IVMCNTR
DO MAIL^IVMUFNC()
+32 QUIT
+33 ;
SSNCK ; check to make sure the SSN(s) are valid SSA SSNs
+1 ;
+2 NEW FLAG,L,X
+3 ; set to 1 if problem with SSN
SET FLAG=0
+4 ;
+5 FOR X=$PIECE(IVMSEG,"^",4),$PIECE(IVMSEG,"^",6)
if FLAG
QUIT
Begin DoDot:1
+6 SET L=$EXTRACT(X,1,3)
+7 ; begins with 000
IF L="000"
SET FLAG=1
QUIT
+8 ; 650-699 invalid
IF L>649
IF (L<700)
SET FLAG=1
QUIT
+9 ; 729-999 invalid
IF L>728
SET FLAG=1
QUIT
End DoDot:1
+10 IF FLAG
SET HLERR="Invalid SSN sent"
+11 QUIT
+12 ;
STORE ; store the ZIV segment in the (#301.5) file for uploading
+1 ;
+2 ; check for patient case record
+3 SET DA(1)=$ORDER(^IVM(301.5,"B",+DFN,0))
SET X=$$IEN^IVMUFNC4("ZIV")
+4 IF DA(1)']""
SET HLERR="Patient missing from IVM PATIENT file"
DO ACK^IVMPREC
QUIT
+5 IF $GET(^IVM(301.5,DA(1),"IN",0))']""
SET ^(0)="^301.501PA^^"
+6 SET DIC="^IVM(301.5,"_DA(1)_",""IN"","
SET DIC(0)="L"
SET DLAYGO=301.501
+7 SET DIC("DR")="10////^S X=IVMSEG"
+8 KILL DD,DO
DO FILE^DICN
+9 ;
+10 ;
STOREQ KILL DA,DIC,DIE,X,Y
+1 ;
+2 ;
+3 ; build mail message if SUPPRESS SSN UPLOAD NOTIFICATION is not set
+4 if $PIECE($GET(^IVM(301.9,1,0)),"^",3)
QUIT
+5 ;
+6 ;
ZIVBULL ; build mail message for transmission to IVM mail group notifying them
+1 ; that patients with updated SSA/SSN's have been received from the
+2 ; IVM Center and may now be uploaded into DHCP.
+3 ;
+4 SET XMSUB="IVM - SSN UPLOAD"
+5 SET IVMTEXT(1)="Updated SSA/SSNs have been received from the Income Verification"
+6 SET IVMTEXT(2)="Match Center. Please select the 'SSN Upload' (SSN) option from the"
+7 SET IVMTEXT(3)="'IVM Upload Menu' in order to view/update these SSA/SSNs. If you"
+8 SET IVMTEXT(4)="have any questions concerning these updated SSA/SSNs, please contact"
+9 SET IVMTEXT(5)="the Income Verification Match Center."
+10 SET IVMTEXT(6)=""
+11 SET IVMTEXT(7)="The following patients have SSA/SSNs to be viewed/updated: "
+12 SET IVMTEXT(8)=" "
+13 SET IVMCNTR=IVMCNTR+1
+14 SET IVMPTID=$$PT^IVMUFNC4(DFN)
+15 SET IVMTEXT(IVMCNTR+8)=$JUSTIFY(IVMCNTR_")",5)_" "_$PIECE(IVMPTID,"^")_" ("_$PIECE(IVMPTID,"^",3)_")"
+16 QUIT
