source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEOB01.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1IBCEOB01 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;16-JAN-2008
2 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7 ; This routine processes the "06" record on the incoming 835 and
8 ; updates the patient insurance files with the corrected name and/or
9 ; subscriber ID# data.
10 ;
11UPD(IB0,IBEOB,IBIFN,DFN,SEQ) ; update pat ins policy data
12 ; IB0 - This is the full "06" record data
13 ; IBEOB - ien# to file 361.1
14 ; IBIFN - ien# to file 399
15 ; DFN - patient ien# to file 2
16 ; SEQ - payer sequence number
17 ;
18 NEW CORRID,IBIT,IBZ,IBZ1,IDCHG,INS,MAX,NAMECHG,NNM,NNM1,PD,POL,X,MCRSFX,MCRLEN,LN
19 ;
20 ; patient ID# processing
21 S IDCHG=0 ; flag indicating an ID# change
22 S CORRID=$P(IB0,U,6) ; corrected patient ID#
23 S CORRID=$TR(CORRID,"-","")
24 I CORRID'="" D
25 . I $$VALHIC^IBCNSMM(CORRID) S IDCHG=1 ; valid HIC#
26 . E D MSG^IBCEOB(IBEOB,"The corrected ID# "_CORRID_" is not a valid Medicare HIC#. No ID# correction done.")
27 . Q
28 ;
29 ; corrected name processing
30 S NAMECHG=0 ; flag indicating a name change
31 I $P(IB0,U,3)="",$P(IB0,U,4)="",$P(IB0,U,5)="" G UPD1 ; no corrected name components indicated
32 ;
33 D F^IBCEF("N-CURR INSURED FULL NAME","IBZ",,IBIFN) ; get the existing name in standard format (see CI2-2.9)
34 I IBZ="" D MSG^IBCEOB(IBEOB,"Unable to determine the existing subscriber name.") G UPD1
35 S IBZ1=$$NAME^IBCEFG1(IBZ) ; parse existing name into component pieces (see CI2-2.9)
36 ;
37 ; Determine if Medicare sent the suffix in the last name field
38 S MCRSFX="" ; default Medicare suffix found in last name
39 S LN=$P(IB0,U,3) ; last name
40 S MCRLEN=$L(LN," ") ; how many " " pieces there are in the Medicare last name
41 I MCRLEN>1 D
42 . S MCRSFX=$$CHKSUF($P(LN," ",MCRLEN)) ; check the last piece to see if it is a common suffix
43 . Q
44 ;
45 ; build new name components
46 S NNM("FAMILY")=$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IBZ1,U,1))
47 S NNM("GIVEN")=$S($P(IB0,U,4)'="":$P(IB0,U,4),1:$P(IBZ1,U,2))
48 S NNM("MIDDLE")=$S($P(IB0,U,5)'="":$P(IB0,U,5),1:$P(IBZ1,U,3))
49 S NNM("SUFFIX")=$S(MCRSFX'="":"",1:$P(IBZ1,U,5)) ; if suffix is in the Medicare last name, blank it out here
50 ;
51 I NNM("FAMILY")="" D MSG^IBCEOB(IBEOB,"Last name is nil.") G UPD1
52 I NNM("GIVEN")="" D MSG^IBCEOB(IBEOB,"First name is nil.") G UPD1
53 ;
54 K MAX D FIELD^DID(2.312,17,,"FIELD LENGTH","MAX") S MAX=$G(MAX("FIELD LENGTH"))
55 I 'MAX D MSG^IBCEOB(IBEOB,"Unable to determine the maximum field length for 2.312,17.") G UPD1
56 S NNM1=$$NAMEFMT^XLFNAME(.NNM,"F","CL"_MAX) ; construct the new name
57 K IBIT D FIELD^DID(2.312,17,,"INPUT TRANSFORM","IBIT") S IBIT=$G(IBIT("INPUT TRANSFORM"))
58 S X=NNM1 X IBIT ; invoke the input transform on the field to see if it is valid
59 I '$D(X) D MSG^IBCEOB(IBEOB,"New name '"_NNM1_"' failed the input transform for field 2.312,17.") G UPD1
60 ;
61 ; at this point, all name checks have passed and we have a valid, new, corrected name in NNM1
62 S NAMECHG=1
63 ;
64UPD1 ;
65 ;
66 I 'NAMECHG,'IDCHG D MSG^IBCEOB(IBEOB,"No changes made.") G UPDX
67 ;
68 I NAMECHG D
69 . N DIE,DA,DR
70 . D MSG^IBCEOB(IBEOB,"Name corrected from "_IBZ_" to "_NNM1_".")
71 . S DIE=361.1,DA=IBEOB,DR="6.01////^S X=NNM1" D ^DIE
72 . Q
73 ;
74 I IDCHG D
75 . N DIE,DA,DR
76 . D MSG^IBCEOB(IBEOB,"ID# corrected from "_$$POLICY^IBCEF(IBIFN,2,SEQ)_" to "_CORRID_".")
77 . S DIE=361.1,DA=IBEOB,DR="6.02////^S X=CORRID" D ^DIE
78 . Q
79 ;
80 ; Loop thru patient policies looking to update all Medicare entries
81 S POL=0
82 F S POL=$O(^DPT(DFN,.312,POL)) Q:'POL D
83 . S PD=$G(^DPT(DFN,.312,POL,0)) ; policy data on the 0 node
84 . S INS=+PD
85 . I '$$MCRWNR^IBEFUNC(INS) Q ; quit if ins co isn't Medicare
86 . I IDCHG,CORRID'=$P(PD,U,2) D UPDID(DFN,POL,CORRID) ; ID# change
87 . I NAMECHG,NNM1'=$P(PD,U,17) D UPDNM(DFN,POL,NNM1) ; name change
88 . Q
89UPDX ;
90 Q
91 ;
92UPDID(DFN,DA,ID) ; update the subscriber ID# field
93 N DR,DIE,DIC
94 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
95 S DR="1///^S X=ID"
96 D ^DIE
97 D UPDAUD(DFN,DA) ; audit info
98 Q
99 ;
100UPDNM(DFN,DA,NM) ; update the subscriber name field
101 N DR,DIE,DIC
102 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
103 S DR="17///^S X=NM"
104 D ^DIE
105 D UPDAUD(DFN,DA) ; audit info
106 Q
107 ;
108UPDAUD(DFN,DA) ; update the audit information for this patient insurance policy
109 N DR,DIE,DIC
110 D UPDATPT^IBCNSP3(DFN,DA) ; date and time last edited and by whom
111 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN
112 S DR="1.09///MEDICARE" ; source of information is MEDICARE
113 D ^DIE
114 D UPDCLM^IBCNSP1(DFN,DA) ; update editable claims
115 Q
116 ;
117CHKSUF(X) ; Return X if it looks like a suffix; otherwise, return null
118 Q:"^I^II^III^IV^V^VI^VII^VIII^IX^X^JR^SR^DR^MD^ESQ^DDS^RN^"[(U_X_U) X
119 Q:"^1ST^2ND^3RD^4TH^5TH^6TH^7TH^8TH^9TH^10TH^"[(U_X_U) X
120 Q ""
121 ;
Note: See TracBrowser for help on using the repository browser.