- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEOB.m
r613 r623 1 IBCEOB ;ALB/TMP - 835 EDI EOB MESSAGE PROCESSING ;20-JAN-99 2 ;;2.0;INTEGRATED BILLING;**137,135,265,155,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 UPDEOB(IBTDA) ; Update EXPLANATION OF BENEFITS file (#361.1) from return msg 8 ; IBTDA = ien of return message 9 ; Function returns ien of EOB file entry or "" if errors found 10 ; the data. Any errors found are 11 ; stored in array ^TMP("IBCERR-EOB",$J,n) in text format 12 ; n = seq # and are stored with the EOB in a wp field 13 ; 14 N IB0,IB100,IBBTCH,IBE,IBMNUM,IBT,DLAYGO,DIC,DD,DO,X,Y,Z,Z0,Z1,IBEOB,IBBAD,IBOK,IB,IBA1,IBIFN,IBFILE 15 K ^TMP($J),^TMP("IBCERR-EOB",$J) 16 ; 17 S (IBBAD,IBEOB)="" 18 S IB0=$G(^IBA(364.2,IBTDA,0)) 19 S IBMNUM=+$P(IB0,U) 20 S X=+$G(^IBA(364,+$P(IB0,U,5),0)) 21 ; 22 G:$S(IBMNUM=""!(X=""):1,1:$D(^IBM(361.1,"AC",IBMNUM))) UPDQ 23 ; 24 ; Duplicate EOB Check 25 S IBFILE="^IBA(364.2,"_IBTDA_",2)" 26 I $$DUP(IBFILE,X) D DELMSG^IBCESRV2(IBTDA) G UPDQ 27 ; 28 I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock msg file 364.2 29 S IBEOB=+$$ADD3611(IBMNUM,$P(IB0,U,5),$P(IB0,U,4),X,0,IBFILE) 30 L -^IBA(364.2,IBTDA,0) 31 ; 32 I IBEOB<0 S IBEOB="" G UPDQ 33 D UPD3611(IBEOB,IBTDA,0) 34 ; 35 UPDQ I IBEOB,$O(^TMP("IBCERR-EOB",$J,0)) D ERRUPD(IBEOB,"IBCERR-EOB") 36 K ^TMP($J),^TMP("IBCERR-EOB",$J) 37 D CLEAN^DILF 38 Q +IBEOB 39 ; 40 ; 41 ; NOTE: **** For all variables IB0,IBEGBL,IBEOB below: 42 ; IB0 = raw data received for this record type on the 835 flat file 43 ; IBEGBL = subscript to use in error global 44 ; IBEOB = ien in file 361.1 for this EOB 45 ; 46 835(IB0,IBEGBL,IBEOB) ; Store header 47 ; 48 Q $$HDR^IBCEOB1(IB0,IBEGBL,IBEOB) 49 ; 50 5(IB0,IBEGBL,IBEOB) ; Record '05' 51 ; 52 N IBOK,DA,DR,DIE,X,Y 53 K IBZDATA 54 S DR=";",IBOK=1 55 S DIE="^IBM(361.1,",DA=IBEOB 56 ; 57 I $P(IB0,U,9) S DR=DR_"1.1///"_$$DATE^IBCEU($P(IB0,U,9))_";" ; statement start date 58 I $P(IB0,U,10) S DR=DR_"1.11///"_$$DATE^IBCEU($P(IB0,U,10))_";" ; statement end date 59 S DR=$P(DR,";",2,$L(DR,";")-1) 60 I DR'="" D ^DIE S IBOK=$D(Y)=0 61 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 5 data" 62 Q IBOK 63 ; 64 6(IB0,IBEGBL,IBEOB) ; Record '06' - corrected patient name and/or ID# 65 ; This data is not going to be filed into file 361.1 so the value of this function will always be a 1 so as to 66 ; not interrupt the filing process of the EOB/MRA data into file 361.1. 67 ; 68 ; perform overall integrity checks on the incoming 06 record. If anything is out of place, don't update anything 69 ; and report the problem and get out. 70 NEW CLM,SITE,IBM,IBIFN,IBIFN1,DFN,SEQ,DIE,DA,DR 71 S DIE=361.1,DA=IBEOB,DR="61.01////^S X=IB0" D ^DIE ; archive the raw 06 record data 72 S CLM=$P(IB0,U,2),SITE=+CLM,CLM=$P(CLM,"-",2) I CLM="" D MSG(IBEOB,"The claim# in piece 2 is invalid.") G Q6 73 S IBM=$G(^IBM(361.1,IBEOB,0)) 74 I $P(IBM,U,4)'=1 D MSG(IBEOB,"This is a non-Medicare EOB.") G Q6 75 S IBIFN=+$P(IBM,U,1) ; claim# from MRA 76 S IBIFN1=+$O(^DGCR(399,"B",CLM,"")) ; claim# from 06 record 77 I IBIFN'=IBIFN1 D MSG(IBEOB,"Claim mismatch error."_IBIFN_","_IBIFN1_","_CLM_".") G Q6 78 I $P($$SITE^VASITE,U,3)'=SITE D MSG(IBEOB,"Invalid station# mismatch."_$P($$SITE^VASITE,U,3)_","_SITE_".") G Q6 79 S SEQ=$$COBN^IBCEF(IBIFN) ; current payer sequence# on claim 80 I '$$WNRBILL^IBEFUNC(IBIFN,SEQ) D MSG(IBEOB,"The current payer on this claim is not MEDICARE (WNR).") G Q6 81 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) ; patient ien 82 I 'DFN D MSG(IBEOB,"The patient DFN cannot be determined.") G Q6 83 ; 84 D UPD^IBCEOB01(IB0,IBEOB,IBIFN,DFN,SEQ) ; update patient insurance policy data 85 ; 86 Q6 ; exit point for $$6 function 87 Q 1 88 ; 89 10(IB0,IBEGBL,IBEOB) ; Record '10' 90 ; 91 N DA,DR,DIE,X,Y,VAL,IBOK 92 S DIE="^IBM(361.1,",DA=IBEOB 93 S DR=".13////"_$S($P(IB0,U,3)="Y":1,$P(IB0,U,4)="Y":2,$P(IB0,U,5)="Y":3,$P(IB0,U,6)="Y":4,1:5)_";.21////"_$P(IB0,U,7) 94 S DR=DR_";2.04////"_$$DOLLAR($P(IB0,U,10))_";1.01////"_$$DOLLAR($P(IB0,U,11))_$S($P(IB0,U,12)'="":";.14///"_$P(IB0,U,12),1:"") 95 S DR=DR_$S($P(IB0,U,13)'="":";.1///"_$P(IB0,U,13),1:"")_";.11///"_($P(IB0,U,14)/10000)_";.12///"_($P(IB0,U,15)/100) 96 I $P(IB0,U,8)'="" S DR=DR_";.08////"_$P(IB0,U,8)_$S($P(IB0,U,9)'="":";.09///"_$P(IB0,U,9),1:"") 97 ; 98 D ^DIE 99 S IBOK=($D(Y)=0) 100 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 10 data" G Q10 101 ; 102 ; File ICN in Bill 103 D ICN^IBCEOB00(IBEOB,$P(IB0,U,12),$P($G(^IBM(361.1,IBEOB,0)),U,15),.IBOK) 104 ; 105 Q10 Q IBOK 106 ; 107 15(IB0,IBEGBL,IBEOB) ; Record '15' 108 ; Moved due to space constraints 109 Q15 Q $$15^IBCEOB00(IB0,IBEGBL,IBEOB) 110 ; 111 17(IB0,IBEGBL,IBEOB) ; Record '17' 112 N A,IBOK 113 S A="3;25.01;0;1;0^4;25.02;0;1;0^5;25.03;0;1;0^6;25.04;0;1;0^7;25.05;0;1;0^8;25.06;0;1;0^9;25.07;0;1;0" 114 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 115 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 17 data" 116 Q17 Q IBOK 117 ; 118 20(IB0,IBEGBL,IBEOB) ; Record '20' 119 ; Moved due to space constraints 120 Q20 Q $$20^IBCEOB00(IB0,IBEGBL,IBEOB) 121 ; 122 30(IB0,IBEGBL,IBEOB) ; Record '30' 123 ; 124 N IBOK 125 D 30^IBCEOB0(IB0,IBEOB,.IBOK) 126 Q30 Q $G(IBOK) 127 ; 128 35(IB0,IBEGBL,IBEOB) ; Record '35' 129 ; Moved due to space constraints 130 Q35 Q $$35^IBCEOB00(IB0,IBEGBL,IBEOB) 131 ; 132 37(IB0,IBEGBL,IBEOB) ; Record '37' 133 ; Moved due to space constraints 134 Q37 Q $$37^IBCEOB00(IB0,IBEGBL,IBEOB) 135 ; 136 40(IB0,IBEGBL,IBEOB) ; Record '40' 137 ; 138 N IBOK 139 D 40^IBCEOB0(IB0,IBEOB,.IBOK) 140 Q40 Q $G(IBOK) 141 ; 142 41(IB0,IBEGBL,IBEOB) ; Record '41' 143 ; 144 N IBOK 145 D 41^IBCEOB0(IB0,IBEOB,.IBOK) 146 Q41 Q $G(IBOK) 147 ; 148 42(IB0,IBEGBL,IBEOB) ; Record '42' 149 ; 150 N IBOK 151 D 42^IBCEOB0(IB0,IBEOB,.IBOK) 152 Q42 Q $G(IBOK) 153 ; 154 45(IB0,IBEGBL,IBEOB) ; Record '45' 155 ; 156 N IBOK 157 D 45^IBCEOB0(IB0,IBEOB,.IBOK) 158 Q $G(IBOK) 159 ; 160 MSG(IBEOB,MSG) ; procedure to file message into field 6.03 161 ; Results of processing of the "06" record type 162 N DIE,DA,DR,Z 163 S DIE=361.1,DA=+$G(IBEOB) 164 I $G(MSG)="" G MSGX 165 S Z=$P($G(^IBM(361.1,DA,6)),U,3) ; already existing message 166 I Z'="" S MSG=Z_" "_MSG ; append new message to existing message 167 S MSG=$E(MSG,1,190) 168 S DR="6.03///^S X=MSG" 169 D ^DIE 170 MSGX ; 171 Q 172 ; 173 DOLLAR(X) ; Convert value in X to dollar format XXX.XX 174 Q $S(+X:$J(X/100,$L(+X),2),1:0) 175 ; 176 ADD3611(IBMNUM,IBTBILL,IBBATCH,X,IBAR,IBFILE) ; Add stub record to file 361.1 177 ; X = the ien of the referenced bill in file 399 178 ; IBTBILL = ien of transmitted bill (optional) 179 ; IBBATCH = ien of batch # the transmitted bill was in (optional) 180 ; IBMNUM = the message # from which this record originally came 181 ; IBAR = 1 only if called from AR 182 ; IBFILE = array reference of raw EOB data 183 ; 184 N DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS,MMI 185 F L +^IBM(361.1,0):10 Q:$T 186 ; 187 ; default proper review status 188 S BS=$P($G(^DGCR(399,X,0)),U,13) ; bill status 189 S REVSTAT=$S(BS=7:9,BS=3:3,BS=4:3,1:0) 190 S MMI=$$NET^XMRENT(IBMNUM) ; MailMan header info 191 S DIC(0)="L",DIC="^IBM(361.1,",DLAYGO=361.1 192 S DIC("DR")=".16////"_REVSTAT_";.17////0"_";100.02////"_IBMNUM_$S('$G(IBAR):";.19////"_+IBTBILL_";100.01////"_IBBATCH,1:"") 193 S DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE)_";62.01////^S X=MMI" 194 D FILE^DICN 195 L -^IBM(361.1,0) 196 Q +Y 197 ; 198 UPD3611(IBEOB,IBTDA,IBAR) ; From flat file 835 format, add EOB record 199 ; IBEOB = the ien of the entry in file 361.1 being updated 200 ; IBTDA = the ien in the source file 201 ; IBAR = 1 if being called from AR 202 N IBA1,IBFILE,IBEGBL,Z,IBREC,Q 203 S IBFILE=$S('$G(IBAR):"^IBA(364.2,"_IBTDA_",2)",1:"^TMP("_$J_",""RCDP-EOB"","_IBTDA_")") 204 S IBEGBL=$S('$G(IBAR):"IBCERR-EOB",1:"RCDPERR-EOB") 205 I $G(IBAR),'$$HDR^IBCEOB1($G(^TMP($J,"RCDPEOB","HDR")),IBEGBL,IBEOB) Q 206 S IBA1=0 207 F S IBA1=$O(@IBFILE@(IBA1)) Q:'IBA1 S IB0=$S('$G(IBAR):$P($G(^(IBA1,0)),"##RAW DATA: ",2),1:$G(@IBFILE@(IBA1,0))) I IB0'="" D 208 . S IBREC=+IB0 209 . I IBREC'=37 K ^TMP($J,37) 210 . I IBREC S IB="S IBOK=$$"_IBREC_"(IB0,IBEGBL,IBEOB)",Q=IBREC_"^IBCEOB" I $T(@Q)'="" X IB S:'IBOK ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=$S('$G(IBAR):" ##RAW DATA: ",1:"")_IB0 211 ; 212 Q 213 ; 214 ERRUPD(IBEOB,IBEGBL) ; Update error text in entry, if needed 215 D WP^DIE(361.1,IBEOB_",",20,"","^TMP(IBEGBL,$J)","") 216 Q 217 ; 218 ; 219 DUP(IBARRAY,IBIFN) ; Duplicate Check 220 ; This function determines if the EOB data already exists in file 221 ; 361.1 by comparing the checksums of the raw 835 data. 222 ; 223 ; IBARRAY = Literal array reference where the raw 835 data exists. 224 ; The data exists at @IBARRAY@(n,0), where n is the seq#. 225 ; For example, IBARRAY = "^IBA(364.2,IBIEN,2)" 226 ; 227 ; IBIFN = the bill # (ptr to 399). The checksums of the EOB's on 228 ; file for this bill will be compared to the checksum of the 229 ; 835 raw data in the IBARRAY reference. 230 ; 231 ; This function returns 0 if the entry is not found (no duplicate), 232 ; Otherwise, the IEN of the entry in file 361.1 is returned if this 233 ; is a duplicate EOB. 234 ; 235 NEW DUP,IBEOB,CHKSUM1,CHKSUM2 236 S DUP=0,IBIFN=+$G(IBIFN) 237 I $G(IBARRAY)=""!'IBIFN G DUPX 238 I '$D(^IBM(361.1,"B",IBIFN)) G DUPX ; no EOB's on file yet 239 S CHKSUM1=$$CHKSUM^IBCEMU1(IBARRAY) ; checksum of current EOB 240 I 'CHKSUM1 G DUPX ; must be able to be calculated 241 S IBEOB=0 242 F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D Q:DUP 243 . S CHKSUM2=+$P($G(^IBM(361.1,IBEOB,100)),U,5) ; checksum of old EOB 244 . I 'CHKSUM2 Q 245 . I CHKSUM1=CHKSUM2 S DUP=IBEOB Q ; comparison 246 . Q 247 DUPX ; 248 Q DUP 249 ; 1 IBCEOB ;ALB/TMP - 835 EDI EOB MESSAGE PROCESSING ;20-JAN-99 2 ;;2.0;INTEGRATED BILLING;**137,135,265,155**;21-MAR-94 3 Q 4 ; 5 UPDEOB(IBTDA) ; Update EXPLANATION OF BENEFITS file (#361.1) from return msg 6 ; IBTDA = ien of return message 7 ; Function returns ien of EOB file entry or "" if errors found 8 ; the data. Any errors found are 9 ; stored in array ^TMP("IBCERR-EOB",$J,n) in text format 10 ; n = seq # and are stored with the EOB in a wp field 11 ; 12 N IB0,IB100,IBBTCH,IBE,IBMNUM,IBT,DLAYGO,DIC,DD,DO,X,Y,Z,Z0,Z1,IBEOB,IBBAD,IBOK,IB,IBA1,IBIFN,IBFILE 13 K ^TMP($J),^TMP("IBCERR-EOB",$J) 14 ; 15 S (IBBAD,IBEOB)="" 16 S IB0=$G(^IBA(364.2,IBTDA,0)) 17 S IBMNUM=+$P(IB0,U) 18 S X=+$G(^IBA(364,+$P(IB0,U,5),0)) 19 ; 20 G:$S(IBMNUM=""!(X=""):1,1:$D(^IBM(361.1,"AC",IBMNUM))) UPDQ 21 ; 22 ; Duplicate EOB Check 23 S IBFILE="^IBA(364.2,"_IBTDA_",2)" 24 I $$DUP(IBFILE,X) G UPDQ 25 ; 26 I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock msg file 364.2 27 S IBEOB=+$$ADD3611(IBMNUM,$P(IB0,U,5),$P(IB0,U,4),X,0,IBFILE) 28 L -^IBA(364.2,IBTDA,0) 29 ; 30 I IBEOB<0 S IBEOB="" G UPDQ 31 D UPD3611(IBEOB,IBTDA,0) 32 ; 33 UPDQ I IBEOB,$O(^TMP("IBCERR-EOB",$J,0)) D ERRUPD(IBEOB,"IBCERR-EOB") 34 K ^TMP($J),^TMP("IBCERR-EOB",$J) 35 D CLEAN^DILF 36 Q +IBEOB 37 ; 38 ; 39 ; NOTE: **** For all variables IB0,IBEGBL,IBEOB below: 40 ; IB0 = raw data received for this record type on the 835 flat file 41 ; IBEGBL = subscript to use in error global 42 ; IBEOB = ien in file 361.1 for this EOB 43 ; 44 835(IB0,IBEGBL,IBEOB) ; Store header 45 ; 46 Q $$HDR^IBCEOB1(IB0,IBEGBL,IBEOB) 47 ; 48 5(IB0,IBEGBL,IBEOB) ; Record '05' 49 ; 50 N IBOK,IBBULL,DA,DR,DIE,X,Y 51 K IBZDATA 52 S DR=";",IBOK=1 53 S DIE="^IBM(361.1,",DA=IBEOB 54 ; 55 S IBBULL="" 56 I $$UPDNM^IBCEOB00(IBEOB,IB0,.IBBULL,.DR)!$$UPDID^IBCEOB00(IBEOB,IB0,.IBBULL,.DR) D ; New insured's name and/or HIC # found 57 . D CHGBULL^IBCEOB3(IBEOB,IBBULL) ;Send a bulletin reporting change 58 ; 59 I $P(IB0,U,9) S DR=DR_"1.1///"_$$DATE^IBCEU($P(IB0,U,9))_";" 60 I $P(IB0,U,10) S DR=DR_"1.11///"_$$DATE^IBCEU($P(IB0,U,10))_";" 61 S DR=$P(DR,";",2,$L(DR,";")-1) 62 I DR'="" D ^DIE S IBOK=$D(Y)=0 63 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 5 data" 64 Q IBOK 65 ; 66 10(IB0,IBEGBL,IBEOB) ; Record '10' 67 ; 68 N DA,DR,DIE,X,Y,VAL,IBOK 69 S DIE="^IBM(361.1,",DA=IBEOB 70 S DR=".13////"_$S($P(IB0,U,3)="Y":1,$P(IB0,U,4)="Y":2,$P(IB0,U,5)="Y":3,$P(IB0,U,6)="Y":4,1:5)_";.21////"_$P(IB0,U,7) 71 S DR=DR_";2.04////"_$$DOLLAR($P(IB0,U,10))_";1.01////"_$$DOLLAR($P(IB0,U,11))_$S($P(IB0,U,12)'="":";.14///"_$P(IB0,U,12),1:"") 72 S DR=DR_$S($P(IB0,U,13)'="":";.1///"_$P(IB0,U,13),1:"")_";.11///"_($P(IB0,U,14)/10000)_";.12///"_($P(IB0,U,15)/100) 73 I $P(IB0,U,8)'="" S DR=DR_";.08////"_$P(IB0,U,8)_$S($P(IB0,U,9)'="":";.09///"_$P(IB0,U,9),1:"") 74 ; 75 D ^DIE 76 S IBOK=($D(Y)=0) 77 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 10 data" G Q10 78 ; 79 ; File ICN in Bill 80 D ICN^IBCEOB00(IBEOB,$P(IB0,U,12),$P($G(^IBM(361.1,IBEOB,0)),U,15),.IBOK) 81 ; 82 Q10 Q IBOK 83 ; 84 15(IB0,IBEGBL,IBEOB) ; Record '15' 85 ; 86 N A,IBOK 87 ; 88 S A="3;1.03;1;0;0^4;1.04;1;0;0^5;1.05;1;0;0^6;1.07;1;0;0^7;1.08;1;0;0^8;1.09;1;0;0^9;1.02;1;0;0^10;2.05;1;0;0" 89 ; 90 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 91 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 15 data" G Q15 92 ; 93 ; For Medicare MRA's only: 94 ; If the Covered Amount is present (15 record, piece 3), then file 95 ; a claim level adjustment with Group code=OA, Reason code=AB3. 96 ; 97 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D 98 . N IB20 99 . S IB20=20_U_$P(IB0,U,2)_U_"OA"_U_"AB3"_U_$P(IB0,U,3)_U_"0000000000" 100 . S IB20=IB20_U_"Covered Amount" 101 . S IBOK=$$20(IB20,IBEGBL,IBEOB) 102 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the OA-AB3 claim level adjustment for the Covered Amount" 103 . K ^TMP($J,20) 104 . Q 105 ; 106 Q15 Q IBOK 107 ; 108 17(IB0,IBEGBL,IBEOB) ; Record '17' 109 N A,IBOK 110 S A="3;25.01;0;1;0^4;25.02;0;1;0^5;25.03;0;1;0^6;25.04;0;1;0^7;25.05;0;1;0^8;25.06;0;1;0^9;25.07;0;1;0" 111 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 112 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 17 data" 113 Q17 Q IBOK 114 ; 115 20(IB0,IBEGBL,IBEOB) ; Record '20' 116 ; 117 N A,LEVEL,IBGRP,IBDA,IBOK 118 ; 119 S IBGRP=$P(IB0,U,3) 120 I IBGRP'="" S ^TMP($J,20)=IBGRP 121 I IBGRP="" S IBGRP=$G(^TMP($J,20)) 122 I IBGRP="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Missing claim level adjustment group code" G Q20 123 ; 124 S IBDA(1)=$O(^IBM(361.1,IBEOB,10,"B",IBGRP,0)) 125 ; 126 I 'IBDA(1) D ;Needs a new entry at group level 127 . N X,Y,DA,DD,DO,DIC,DLAYGO 128 . S DIC="^IBM(361.1,"_IBEOB_",10,",DIC(0)="L",DLAYGO=361.11,DA(1)=IBEOB 129 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1,10) 130 . S X=IBGRP 131 . D FILE^DICN K DIC,DO,DD,DLAYGO 132 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment group code could not be added" Q 133 . S IBDA(1)=+Y 134 ; 135 I $G(IBDA(1)) D ;Add a new entry at the reason code level 136 . S DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.111,DA(2)=IBEOB,DA(1)=IBDA(1) 137 . S DIC("P")=$$GETSPEC^IBEFUNC(361.11,1) 138 . S X=$P(IB0,U,4) 139 . D FILE^DICN K DIC,DO,DD,DLAYGO 140 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment reason code could not be added" Q 141 . S IBDA=+Y 142 ; 143 I $G(IBDA) D 144 . S LEVEL=10,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1," 145 . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBEOB 146 . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0" 147 . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) 148 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad adjustment reason code ("_$P(IB0,U,4)_") data" Q 149 Q20 Q $G(IBOK) 150 ; 151 30(IB0,IBEGBL,IBEOB) ; Record '30' 152 ; 153 N IBOK 154 D 30^IBCEOB0(IB0,IBEOB,.IBOK) 155 Q30 Q $G(IBOK) 156 ; 157 35(IB0,IBEGBL,IBEOB) ; Record '35' 158 ; Moved due to space constraints 159 Q35 Q $$35^IBCEOB00(IB0,IBEGBL,IBEOB) 160 ; 161 37(IB0,IBEGBL,IBEOB) ; Record '37' 162 ; Moved due to space constraints 163 Q37 Q $$37^IBCEOB00(IB0,IBEGBL,IBEOB) 164 ; 165 40(IB0,IBEGBL,IBEOB) ; Record '40' 166 ; 167 N IBOK 168 D 40^IBCEOB0(IB0,IBEOB,.IBOK) 169 Q40 Q $G(IBOK) 170 ; 171 41(IB0,IBEGBL,IBEOB) ; Record '41' 172 ; 173 N IBOK 174 D 41^IBCEOB0(IB0,IBEOB,.IBOK) 175 Q41 Q $G(IBOK) 176 ; 177 42(IB0,IBEGBL,IBEOB) ; Record '42' 178 ; 179 N IBOK 180 D 42^IBCEOB0(IB0,IBEOB,.IBOK) 181 Q42 Q $G(IBOK) 182 ; 183 45(IB0,IBEGBL,IBEOB) ; Record '45' 184 ; 185 N IBOK 186 D 45^IBCEOB0(IB0,IBEOB,.IBOK) 187 Q $G(IBOK) 188 ; 189 DOLLAR(X) ; Convert value in X to dollar format XXX.XX 190 Q $S(+X:$J(X/100,$L(+X),2),1:0) 191 ; 192 ADD3611(IBMNUM,IBTBILL,IBBATCH,X,IBAR,IBFILE) ; Add stub record to file 361.1 193 ; X = the ien of the referenced bill in file 399 194 ; IBTBILL = ien of transmitted bill (optional) 195 ; IBBATCH = ien of batch # the transmitted bill was in (optional) 196 ; IBMNUM = the message # from which this record originally came 197 ; IBAR = 1 only if called from AR 198 ; IBFILE = array reference of raw EOB data 199 ; 200 N DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS 201 F L +^IBM(361.1,0):10 Q:$T 202 ; 203 ; default proper review status 204 S BS=$P($G(^DGCR(399,X,0)),U,13) ; bill status 205 S REVSTAT=$S(BS=7:9,BS=3:3,BS=4:3,1:0) 206 S DIC(0)="L",DIC="^IBM(361.1,",DLAYGO=361.1 207 S DIC("DR")=".16////"_REVSTAT_";.17////0"_";100.02////"_IBMNUM_$S('$G(IBAR):";.19////"_+IBTBILL_";100.01////"_IBBATCH,1:"") 208 S DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE) 209 D FILE^DICN 210 L -^IBM(361.1,0) 211 Q +Y 212 ; 213 UPD3611(IBEOB,IBTDA,IBAR) ; From flat file 835 format, add EOB record 214 ; IBEOB = the ien of the entry in file 361.1 being updated 215 ; IBTDA = the ien in the source file 216 ; IBAR = 1 if being called from AR 217 N IBA1,IBFILE,IBEGBL,Z,IBREC,Q 218 S IBFILE=$S('$G(IBAR):"^IBA(364.2,"_IBTDA_",2)",1:"^TMP("_$J_",""RCDP-EOB"","_IBTDA_")") 219 S IBEGBL=$S('$G(IBAR):"IBCERR-EOB",1:"RCDPERR-EOB") 220 I $G(IBAR),'$$HDR^IBCEOB1($G(^TMP($J,"RCDPEOB","HDR")),IBEGBL,IBEOB) Q 221 S IBA1=0 222 F S IBA1=$O(@IBFILE@(IBA1)) Q:'IBA1 S IB0=$S('$G(IBAR):$P($G(^(IBA1,0)),"##RAW DATA: ",2),1:$G(@IBFILE@(IBA1,0))) I IB0'="" D 223 . S IBREC=+IB0 224 . I IBREC'=37 K ^TMP($J,37) 225 . I IBREC S IB="S IBOK=$$"_IBREC_"(IB0,IBEGBL,IBEOB)",Q=IBREC_"^IBCEOB" I $T(@Q)'="" X IB S:'IBOK ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=$S('$G(IBAR):" ##RAW DATA: ",1:"")_IB0 226 ; 227 Q 228 ; 229 ERRUPD(IBEOB,IBEGBL) ; Update error text in entry, if needed 230 D WP^DIE(361.1,IBEOB_",",20,"","^TMP(IBEGBL,$J)","") 231 Q 232 ; 233 ; 234 DUP(IBARRAY,IBIFN) ; Duplicate Check 235 ; This function determines if the EOB data already exists in file 236 ; 361.1 by comparing the checksums of the raw 835 data. 237 ; 238 ; IBARRAY = Literal array reference where the raw 835 data exists. 239 ; The data exists at @IBARRAY@(n,0), where n is the seq#. 240 ; For example, IBARRAY = "^IBA(364.2,IBIEN,2)" 241 ; 242 ; IBIFN = the bill # (ptr to 399). The checksums of the EOB's on 243 ; file for this bill will be compared to the checksum of the 244 ; 835 raw data in the IBARRAY reference. 245 ; 246 ; This function returns 0 if the entry is not found (no duplicate), 247 ; Otherwise, the IEN of the entry in file 361.1 is returned if this 248 ; is a duplicate EOB. 249 ; 250 NEW DUP,IBEOB,CHKSUM1,CHKSUM2 251 S DUP=0,IBIFN=+$G(IBIFN) 252 I $G(IBARRAY)=""!'IBIFN G DUPX 253 I '$D(^IBM(361.1,"B",IBIFN)) G DUPX ; no EOB's on file yet 254 S CHKSUM1=$$CHKSUM^IBCEMU1(IBARRAY) ; checksum of current EOB 255 I 'CHKSUM1 G DUPX ; must be able to be calculated 256 S IBEOB=0 257 F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D Q:DUP 258 . S CHKSUM2=+$P($G(^IBM(361.1,IBEOB,100)),U,5) ; checksum of old EOB 259 . I 'CHKSUM2 Q 260 . I CHKSUM1=CHKSUM2 S DUP=IBEOB Q ; comparison 261 . Q 262 DUPX ; 263 Q DUP 264 ;
Note:
See TracChangeset
for help on using the changeset viewer.
