- 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 Jan 18, 2025@03:12:34 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 ;