IBCEOB01 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;16-JAN-2008
;;2.0;INTEGRATED BILLING;**377,516,631**;21-MAR-94;Build 23
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; This routine processes the "06" record on the incoming 835 and
; updates the patient insurance files with the corrected name and/or
; subscriber ID# data.
;
UPD(IB0,IBEOB,IBIFN,DFN,SEQ) ; update pat ins policy data
; IB0 - This is the full "06" record data
; IBEOB - ien# to file 361.1
; IBIFN - ien# to file 399
; DFN - patient ien# to file 2
; SEQ - payer sequence number
;
NEW CORRID,IBIT,IBZ,IBZ1,IDCHG,INS,MAX,NAMECHG,NNM,NNM1,PD,POL,X,MCRSFX,MCRLEN,LN
;
; patient ID# processing
S IDCHG=0 ; flag indicating an ID# change
S CORRID=$P(IB0,U,6) ; corrected patient ID#
S CORRID=$TR(CORRID,"-","")
I CORRID'="" D
. I $$VALHIC^IBCNSMM(CORRID) S IDCHG=1 ; valid HIC#
. E D MSG^IBCEOB(IBEOB,"The corrected ID# "_CORRID_" is not a valid Medicare HIC#. No ID# correction done.")
. Q
;
; corrected name processing
S NAMECHG=0 ; flag indicating a name change
I $P(IB0,U,3)="",$P(IB0,U,4)="",$P(IB0,U,5)="" G UPD1 ; no corrected name components indicated
;
D F^IBCEF("N-CURR INSURED FULL NAME","IBZ",,IBIFN) ; get the existing name in standard format (see CI2-2.9)
I IBZ="" D MSG^IBCEOB(IBEOB,"Unable to determine the existing subscriber name.") G UPD1
S IBZ1=$$NAME^IBCEFG1(IBZ) ; parse existing name into component pieces (see CI2-2.9)
;
; Determine if Medicare sent the suffix in the last name field
S MCRSFX="" ; default Medicare suffix found in last name
S LN=$P(IB0,U,3) ; last name
S MCRLEN=$L(LN," ") ; how many " " pieces there are in the Medicare last name
I MCRLEN>1 D
. S MCRSFX=$$CHKSUF($P(LN," ",MCRLEN)) ; check the last piece to see if it is a common suffix
. Q
;
; build new name components
S NNM("FAMILY")=$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IBZ1,U,1))
S NNM("GIVEN")=$S($P(IB0,U,4)'="":$P(IB0,U,4),1:$P(IBZ1,U,2))
S NNM("MIDDLE")=$S($P(IB0,U,5)'="":$P(IB0,U,5),1:$P(IBZ1,U,3))
S NNM("SUFFIX")=$S(MCRSFX'="":"",1:$P(IBZ1,U,5)) ; if suffix is in the Medicare last name, blank it out here
;
I NNM("FAMILY")="" D MSG^IBCEOB(IBEOB,"Last name is nil.") G UPD1
I NNM("GIVEN")="" D MSG^IBCEOB(IBEOB,"First name is nil.") G UPD1
;
K MAX D FIELD^DID(2.312,17,,"FIELD LENGTH","MAX") S MAX=$G(MAX("FIELD LENGTH"))
I 'MAX D MSG^IBCEOB(IBEOB,"Unable to determine the maximum field length for 2.312,17.") G UPD1
S NNM1=$$NAMEFMT^XLFNAME(.NNM,"F","CL"_MAX) ; construct the new name
K IBIT D FIELD^DID(2.312,17,,"INPUT TRANSFORM","IBIT") S IBIT=$G(IBIT("INPUT TRANSFORM"))
S X=NNM1 X IBIT ; invoke the input transform on the field to see if it is valid
I '$D(X) D MSG^IBCEOB(IBEOB,"New name '"_NNM1_"' failed the input transform for field 2.312,17.") G UPD1
;
; at this point, all name checks have passed and we have a valid, new, corrected name in NNM1
S NAMECHG=1
;
UPD1 ;
;
I 'NAMECHG,'IDCHG D MSG^IBCEOB(IBEOB,"No changes made.") G UPDX
;
I NAMECHG D
. N DIE,DA,DR
. D MSG^IBCEOB(IBEOB,"Name corrected from "_IBZ_" to "_NNM1_".")
. S DIE=361.1,DA=IBEOB,DR="6.01////^S X=NNM1" D ^DIE
. Q
;
I IDCHG D
. N DIE,DA,DR
. D MSG^IBCEOB(IBEOB,"ID# corrected from "_$$POLICY^IBCEF(IBIFN,2,SEQ)_" to "_CORRID_".")
. S DIE=361.1,DA=IBEOB,DR="6.02////^S X=CORRID" D ^DIE
. Q
;
; Loop thru patient policies looking to update all Medicare entries
S POL=0
F S POL=$O(^DPT(DFN,.312,POL)) Q:'POL D
. ;S PD=$G(^DPT(DFN,.312,POL,0)) ; policy data on the 0 node ;516 - baa
. S PD=$$ZND^IBCNS1(DFN,POL) ; policy data on the 0 node ;516 - baa
. S INS=+PD
. I '$$MCRWNR^IBEFUNC(INS) Q ; quit if ins co isn't Medicare
. I IDCHG,CORRID'=$P(PD,U,2) D UPDID(DFN,POL,CORRID) ; ID# change
. I NAMECHG,NNM1'=$P(PD,U,17) D UPDNM(DFN,POL,NNM1) ; name change
. Q
UPDX ;
Q
;
UPDID(DFN,DA,ID) ; update the subscriber ID# field
N DR,DIE,DIC
S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
S DR="7.02///^S X=ID" ;patch 516 - baa changes
D ^DIE
D UPDAUD(DFN,DA) ; audit info
Q
;
UPDNM(DFN,DA,NM) ; update the subscriber name field
N DR,DIE,DIC
S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
S DR="7.01///^S X=NM" ;patch 516 - baa changes
D ^DIE
D UPDAUD(DFN,DA) ; audit info
Q
;
UPDAUD(DFN,DA) ; update the audit information for this patient insurance policy
N DR,DIE,DIC
D UPDATPT^IBCNSP3(DFN,DA) ; date and time last edited and by whom
; Check for SOI being populated in (#2.312,1.09) before setting it.
;IB*2.0*631/TAZ - Changed logic to only update to Medicare if no other SOI exists.
I $$GET1^DIQ(2.312,DA_","_DFN_",",1.09)="" D
. S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
. S DR="1.09///MEDICARE" ; source of information is MEDICARE
. D ^DIE
D UPDCLM^IBCNSP1(DFN,DA) ; update editable claims
Q
;
CHKSUF(X) ; Return X if it looks like a suffix; otherwise, return null
Q:"^I^II^III^IV^V^VI^VII^VIII^IX^X^JR^SR^DR^MD^ESQ^DDS^RN^"[(U_X_U) X
Q:"^1ST^2ND^3RD^4TH^5TH^6TH^7TH^8TH^9TH^10TH^"[(U_X_U) X
Q ""
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEOB01 5238 printed Apr 09, 2024@21:36:38 Page 2
IBCEOB01 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;16-JAN-2008
+1 ;;2.0;INTEGRATED BILLING;**377,516,631**;21-MAR-94;Build 23
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; This routine processes the "06" record on the incoming 835 and
+7 ; updates the patient insurance files with the corrected name and/or
+8 ; subscriber ID# data.
+9 ;
UPD(IB0,IBEOB,IBIFN,DFN,SEQ) ; update pat ins policy data
+1 ; IB0 - This is the full "06" record data
+2 ; IBEOB - ien# to file 361.1
+3 ; IBIFN - ien# to file 399
+4 ; DFN - patient ien# to file 2
+5 ; SEQ - payer sequence number
+6 ;
+7 NEW CORRID,IBIT,IBZ,IBZ1,IDCHG,INS,MAX,NAMECHG,NNM,NNM1,PD,POL,X,MCRSFX,MCRLEN,LN
+8 ;
+9 ; patient ID# processing
+10 ; flag indicating an ID# change
SET IDCHG=0
+11 ; corrected patient ID#
SET CORRID=$PIECE(IB0,U,6)
+12 SET CORRID=$TRANSLATE(CORRID,"-","")
+13 IF CORRID'=""
Begin DoDot:1
+14 ; valid HIC#
IF $$VALHIC^IBCNSMM(CORRID)
SET IDCHG=1
+15 IF '$TEST
DO MSG^IBCEOB(IBEOB,"The corrected ID# "_CORRID_" is not a valid Medicare HIC#. No ID# correction done.")
+16 QUIT
End DoDot:1
+17 ;
+18 ; corrected name processing
+19 ; flag indicating a name change
SET NAMECHG=0
+20 ; no corrected name components indicated
IF $PIECE(IB0,U,3)=""
IF $PIECE(IB0,U,4)=""
IF $PIECE(IB0,U,5)=""
GOTO UPD1
+21 ;
+22 ; get the existing name in standard format (see CI2-2.9)
DO F^IBCEF("N-CURR INSURED FULL NAME","IBZ",,IBIFN)
+23 IF IBZ=""
DO MSG^IBCEOB(IBEOB,"Unable to determine the existing subscriber name.")
GOTO UPD1
+24 ; parse existing name into component pieces (see CI2-2.9)
SET IBZ1=$$NAME^IBCEFG1(IBZ)
+25 ;
+26 ; Determine if Medicare sent the suffix in the last name field
+27 ; default Medicare suffix found in last name
SET MCRSFX=""
+28 ; last name
SET LN=$PIECE(IB0,U,3)
+29 ; how many " " pieces there are in the Medicare last name
SET MCRLEN=$LENGTH(LN," ")
+30 IF MCRLEN>1
Begin DoDot:1
+31 ; check the last piece to see if it is a common suffix
SET MCRSFX=$$CHKSUF($PIECE(LN," ",MCRLEN))
+32 QUIT
End DoDot:1
+33 ;
+34 ; build new name components
+35 SET NNM("FAMILY")=$SELECT($PIECE(IB0,U,3)'="":$PIECE(IB0,U,3),1:$PIECE(IBZ1,U,1))
+36 SET NNM("GIVEN")=$SELECT($PIECE(IB0,U,4)'="":$PIECE(IB0,U,4),1:$PIECE(IBZ1,U,2))
+37 SET NNM("MIDDLE")=$SELECT($PIECE(IB0,U,5)'="":$PIECE(IB0,U,5),1:$PIECE(IBZ1,U,3))
+38 ; if suffix is in the Medicare last name, blank it out here
SET NNM("SUFFIX")=$SELECT(MCRSFX'="":"",1:$PIECE(IBZ1,U,5))
+39 ;
+40 IF NNM("FAMILY")=""
DO MSG^IBCEOB(IBEOB,"Last name is nil.")
GOTO UPD1
+41 IF NNM("GIVEN")=""
DO MSG^IBCEOB(IBEOB,"First name is nil.")
GOTO UPD1
+42 ;
+43 KILL MAX
DO FIELD^DID(2.312,17,,"FIELD LENGTH","MAX")
SET MAX=$GET(MAX("FIELD LENGTH"))
+44 IF 'MAX
DO MSG^IBCEOB(IBEOB,"Unable to determine the maximum field length for 2.312,17.")
GOTO UPD1
+45 ; construct the new name
SET NNM1=$$NAMEFMT^XLFNAME(.NNM,"F","CL"_MAX)
+46 KILL IBIT
DO FIELD^DID(2.312,17,,"INPUT TRANSFORM","IBIT")
SET IBIT=$GET(IBIT("INPUT TRANSFORM"))
+47 ; invoke the input transform on the field to see if it is valid
SET X=NNM1
XECUTE IBIT
+48 IF '$DATA(X)
DO MSG^IBCEOB(IBEOB,"New name '"_NNM1_"' failed the input transform for field 2.312,17.")
GOTO UPD1
+49 ;
+50 ; at this point, all name checks have passed and we have a valid, new, corrected name in NNM1
+51 SET NAMECHG=1
+52 ;
UPD1 ;
+1 ;
+2 IF 'NAMECHG
IF 'IDCHG
DO MSG^IBCEOB(IBEOB,"No changes made.")
GOTO UPDX
+3 ;
+4 IF NAMECHG
Begin DoDot:1
+5 NEW DIE,DA,DR
+6 DO MSG^IBCEOB(IBEOB,"Name corrected from "_IBZ_" to "_NNM1_".")
+7 SET DIE=361.1
SET DA=IBEOB
SET DR="6.01////^S X=NNM1"
DO ^DIE
+8 QUIT
End DoDot:1
+9 ;
+10 IF IDCHG
Begin DoDot:1
+11 NEW DIE,DA,DR
+12 DO MSG^IBCEOB(IBEOB,"ID# corrected from "_$$POLICY^IBCEF(IBIFN,2,SEQ)_" to "_CORRID_".")
+13 SET DIE=361.1
SET DA=IBEOB
SET DR="6.02////^S X=CORRID"
DO ^DIE
+14 QUIT
End DoDot:1
+15 ;
+16 ; Loop thru patient policies looking to update all Medicare entries
+17 SET POL=0
+18 FOR
SET POL=$ORDER(^DPT(DFN,.312,POL))
if 'POL
QUIT
Begin DoDot:1
+19 ;S PD=$G(^DPT(DFN,.312,POL,0)) ; policy data on the 0 node ;516 - baa
+20 ; policy data on the 0 node ;516 - baa
SET PD=$$ZND^IBCNS1(DFN,POL)
+21 SET INS=+PD
+22 ; quit if ins co isn't Medicare
IF '$$MCRWNR^IBEFUNC(INS)
QUIT
+23 ; ID# change
IF IDCHG
IF CORRID'=$PIECE(PD,U,2)
DO UPDID(DFN,POL,CORRID)
+24 ; name change
IF NAMECHG
IF NNM1'=$PIECE(PD,U,17)
DO UPDNM(DFN,POL,NNM1)
+25 QUIT
End DoDot:1
UPDX ;
+1 QUIT
+2 ;
UPDID(DFN,DA,ID) ; update the subscriber ID# field
+1 NEW DR,DIE,DIC
+2 SET DIE="^DPT("_DFN_",.312,"
SET DA(1)=DFN
+3 ;patch 516 - baa changes
SET DR="7.02///^S X=ID"
+4 DO ^DIE
+5 ; audit info
DO UPDAUD(DFN,DA)
+6 QUIT
+7 ;
UPDNM(DFN,DA,NM) ; update the subscriber name field
+1 NEW DR,DIE,DIC
+2 SET DIE="^DPT("_DFN_",.312,"
SET DA(1)=DFN
+3 ;patch 516 - baa changes
SET DR="7.01///^S X=NM"
+4 DO ^DIE
+5 ; audit info
DO UPDAUD(DFN,DA)
+6 QUIT
+7 ;
UPDAUD(DFN,DA) ; update the audit information for this patient insurance policy
+1 NEW DR,DIE,DIC
+2 ; date and time last edited and by whom
DO UPDATPT^IBCNSP3(DFN,DA)
+3 ; Check for SOI being populated in (#2.312,1.09) before setting it.
+4 ;IB*2.0*631/TAZ - Changed logic to only update to Medicare if no other SOI exists.
+5 IF $$GET1^DIQ(2.312,DA_","_DFN_",",1.09)=""
Begin DoDot:1
+6 SET DIE="^DPT("_DFN_",.312,"
SET DA(1)=DFN
+7 ; source of information is MEDICARE
SET DR="1.09///MEDICARE"
+8 DO ^DIE
End DoDot:1
+9 ; update editable claims
DO UPDCLM^IBCNSP1(DFN,DA)
+10 QUIT
+11 ;
CHKSUF(X) ; Return X if it looks like a suffix; otherwise, return null
+1 if "^I^II^III^IV^V^VI^VII^VIII^IX^X^JR^SR^DR^MD^ESQ^DDS^RN^"[(U_X_U)
QUIT X
+2 if "^1ST^2ND^3RD^4TH^5TH^6TH^7TH^8TH^9TH^10TH^"[(U_X_U)
QUIT X
+3 QUIT ""
+4 ;
