- 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 Mar 13, 2025@21:06:20 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
