- 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/IBRFN4.m
r613 r623 1 IBRFN4 2 ;;2.0;INTEGRATED BILLING;**301,305,389**;21-MAR-94;Build 6 3 ;;Per VHA Directive 2004-038, this routine should not be modified.4 5 IBAREXT(IBIFN,IBD) 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 .. S IBD("PRD",IBJ)=$$PINB^IBCSC5B(+IBX)_U_IBI_U_+IBTMP54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 IBACT(IBIFN,IBARRY) 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 PREREG(IBBDT,IBEDT) 104 105 106 107 108 BUFFER(IBBDT,IBEDT) 109 110 111 112 113 DAYS(IBIFN) 114 115 116 117 118 119 120 121 122 DAYSQ 123 124 REJ(IBIFN) 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 REJQ 1 IBRFN4 ;ALB/TMK - Supported functions for AR/IB DATA EXTRACT ;15-FEB-2005 2 ;;2.0;INTEGRATED BILLING;**301,305**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 IBAREXT(IBIFN,IBD) ; Returns data for claim IBIFN for IB/AR Extract 6 ; Data returned (pieces): 7 ; 1-MEDICARE Status (0=not MRA secondary, 1=MRA secondary) 8 ; 2-Last MRA requested date "S";7 (7 - INTERNAL) 9 ; 3-Last Electronic extract date "TX";2 (21 - INTERNAL) 10 ; 4-Printed via EDI "TX";7 (26 - EXTERNAL) 11 ; 5-Force Claim to Print "TX";8 (27 - EXTERNAL) 12 ; 6-Claim MRA Status "TX";5 (24 - EXTERNAL) 13 ; 7-MRA recorded date "TX";3 (22 - INTERNAL) 14 ; 8-Bill cancelled date "S";17 (17 - INTERNAL) 15 ; 9-form type 0;19 (.19 - EXTERNAL) 16 ; 10-Current Payer $$CURR^IBCEF2(IBIFN) returns IEN;NAME (file 36) 17 ; 11-DRG 0;8==> file 45 (9 - EXTERNAL) 18 ; 12-ECME # "M1";8 (460 - EXTERNAL) 19 ; 13-NON-VA Facility 20 ; 14-#Days Site Not Responsible for MRA ($$DAYS(IBIFN)) 21 ; 15-National VA id number for Ins Verification (365.12;.02 - INTERNAL) 22 ; 16-Payer name (file 365.12;.01) 23 ; 17-Offset Amount (202-INTERNAL) 24 ; 25 ; IBD("PRD",seq #)=prosthetic item name^date^bill ien 26 ; IBD("IN")= TYPE OF PLAN NAME ^ GROUP NUMBER ^ RELATIONSHIP TO INSURED 27 ; ^ SOURCE OF INFO ^ EDI ID NUMBER - INST ^ EDI ID NUMBER - PROF 28 ; ^ INSURANCE REIMBURSE 29 ; IBD("IN","MMA")= MAILING STREET ADDRESS [LINE 1] ^ 30 ; ^ MAILING STREET ADDRESS [LINE 2] ^ CITY ^ STATE NAME ^ ZIP 31 ; 32 N IB,IBI,IBJ,IBK,IBX,IBNODE,IBTMP,IBIN,Z 33 F IBNODE=0,"S","TX","M","U1" S IB(IBNODE)=$G(^DGCR(399,IBIFN,IBNODE)) 34 S IBD=$S($$MRASEC^IBCEF4(IBIFN):1,1:0) 35 S $P(IBD,U,2)=$P(IB("S"),U,7),$P(IBD,U,3)=$P(IB("TX"),U,2) 36 S $P(IBD,U,4)=$$GET1^DIQ(399,IBIFN_",",26,"E"),$P(IBD,U,5)=$$GET1^DIQ(399,IBIFN_",",27,"E") 37 S $P(IBD,U,6)=$$GET1^DIQ(399,IBIFN_",",24,"E"),$P(IBD,U,7)=$P(IB("TX"),U,3) 38 S $P(IBD,U,8)=$P(IB("S"),U,17),$P(IBD,U,9)=$$GET1^DIQ(399,IBIFN_",",.19,"E") 39 S Z=$$CURR^IBCEF2(IBIFN),$P(IBD,U,10)=Z_$S(Z:";"_$P($G(^DIC(36,Z,0)),U),1:"") 40 S Z=$P($G(^DIC(36,+Z,3)),U,10),$P(IBD,U,15)=$P($G(^IBE(365.12,+Z,0)),U,2),$P(IBD,U,16)=$P($G(^(0)),U) 41 S Z=$P(IB(0),U,8),$P(IBD,U,11)=$S(Z:$$GET1^DIQ(45,Z_",",9,"E"),1:"") 42 S $P(IBD,U,12)=$$GET1^DIQ(399,IBIFN_",",460,"E") 43 S Z=$P($G(^DGCR(399,IBIFN,"U2")),U,10),$P(IBD,U,13)=$S(Z:$P($G(^IBA(355.93,Z,0)),U,1),1:"") 44 ; 45 S $P(IBD,U,14)=$$DAYS(IBIFN) 46 S $P(IBD,U,17)=$P(IB("U1"),U,2) 47 ; 48 K IBTMP D SET^IBCSC5B(IBIFN,.IBTMP) 49 S (IBI,IBJ)=0 F S IBI=$O(IBTMP(IBI)) Q:'IBI D 50 . S IBK=0 F S IBK=$O(IBTMP(IBI,IBK)) Q:'IBK D 51 .. S IBX=IBTMP(IBI,IBK) 52 .. S IBJ=IBJ+1 53 .. S IBD("PRD",IBJ)=$P($$PIN^IBCSC5B(IBK),U,2)_U_IBI_U_+IBTMP 54 ; 55 S Z=" ",IBD("IN")="",DFN=+$P(IB(0),U,2) 56 F S Z=$O(^DPT(DFN,.312,Z),-1) Q:Z="" D Q:Z="" 57 . S IBIN=$G(^DPT(DFN,.312,Z,0)) 58 . I +IB("M")=+IBIN D 59 .. N IBQ,IBP 60 .. S IBP=+$P(IBIN,U,18),IBQ=$G(^IBA(355.3,+IBP,0)) 61 .. S IBD("IN")=$S($P(IBQ,U,9):$$GET1^DIQ(355.3,IBP_",",.09,"E"),1:"")_U_$P(IBQ,U,4)_U_$P(IBIN,U,6)_U_$P($G(^DPT(DFN,.312,Z,1)),U,9) 62 .. S Z="" 63 ; 64 S Z=$G(^DIC(36,+IB("M"),3)) 65 S $P(IBD("IN"),U,5)=$P(Z,U,4),$P(IBD("IN"),U,6)=$P(Z,U,2) 66 S $P(IBD("IN"),U,7)=$$GET1^DIQ(36,+IB("M")_",",1,"I") 67 S Z=$G(^DIC(36,+IB("M"),.11)) 68 S IBD("IN","MMA")=$P(Z,U,1)_U_$P(Z,U,2)_U_$P(Z,U,4)_U_$S($P(Z,U,5):$P($G(^DIC(5,$P(Z,U,5),0)),U,1),1:"")_U_$P(Z,U,6) 69 ; 70 Q IBD 71 ; 72 IBACT(IBIFN,IBARRY) ; Returns IB actions for bill ien IBIFN 73 ;IBARRY should be passed by reference and returns: 74 ; 75 ; IBARRY(seq)=AR bill #^reference #^external STATUS^IB ACTION TYPE NAME 76 ; ^UNITS^TOTAL CHARGE^DT BILLD FROM^DT BILLD TO^AR BILL IEN 77 ; ^DT ENTRY ADDED^PATIENT SSN^EVENT DATE^RESULTING FROM 78 ; ^INSTITUTION IEN 79 ; 80 N IBNA,IB,IB0,DFN,IBCT,Z 81 S IBNA=$$BN1^PRCAFN(IBIFN),IB="",IBCT=0 82 F S IB=$O(^IB("ABIL",IBNA,IB)) Q:IB="" D 83 . S IBCT=IBCT+1 84 . S IB0=$G(^IB(IB,0)) 85 . I $G(DFN)="" S DFN=$P(IB0,U,2) 86 . ; 87 . S IBARRY=IBNA_U_$P(IB0,U,1)_U_$$GET1^DIQ(350,IB_",",.05,"E") 88 . S Z=$P(IB0,U,3) 89 . S IBARRY=IBARRY_U_$S(Z'="":$P($G(^IBE(350.1,Z,0)),U,1),1:"") 90 . S IBARRY=IBARRY_U_$P(IB0,U,6) ; UNITS 91 . S IBARRY=IBARRY_U_$P(IB0,U,7) ; TOTAL CHARGE 92 . S IBARRY=IBARRY_U_$P(IB0,U,14) ; DT BILLD FROM 93 . S IBARRY=IBARRY_U_$P(IB0,U,15) ; DT BILLD TO 94 . S IBARRY=IBARRY_U_$P(IB0,U,11) ; AR BILL # 95 . S IBARRY=IBARRY_U_$P($P($G(^IB(IB,1)),U,2),".",1) ; DT ENTRY ADDED 96 . S IBARRY=IBARRY_U_$P(^DPT(DFN,0),U,9) ; SSN 97 . S IBARRY=IBARRY_U_$P(IB0,U,17) ; EVENT DT 98 . S IBARRY=IBARRY_U_$P(IB0,U,4) ;RESULTING FROM 99 . S IBARRY=IBARRY_U_$P(IB0,U,13) ; Institution 100 . S IBARRY(IBCT)=IBARRY,IBARRY="" 101 Q 102 ; 103 PREREG(IBBDT,IBEDT) ;Returns Pre-registration data 104 N IBDATA 105 S IBDATA=$$IBAR^IBJDIPR(IBBDT,IBEDT) 106 Q IBDATA 107 ; 108 BUFFER(IBBDT,IBEDT) ;Returns Buffer data 109 N IBDATA 110 S IBDATA=$$IBAR^IBCNBOA(IBBDT,IBEDT) 111 Q IBDATA 112 ; 113 DAYS(IBIFN) ; Returns # days site not responsible for MRA 114 N X,X1,X2,D0 115 S X="" ;No. of days 116 G:'$P(IBD,U,2) DAYSQ 117 S X2=$P(IBD,U,2) ;MRA Request Date 118 S X1=$P(IBD,U,7) ;MRA Recorded Date 119 G:'$$MRASEC^IBCEF4(IBIFN) DAYSQ ; Not MEDICARE secondary 120 I 'X1!(X1<X2) S X1=DT 121 D ^%DTC 122 DAYSQ Q X 123 ; 124 REJ(IBIFN) ; Returns 1 if any rejects found for MRA secondary claim or for 125 ; any preceding claims it was cancelled/cloned from 126 N X,Y,I,X1,X2,X3,D0,CURSEQ 127 S Y=0 ;Y=REJECT FLAG 128 G:'$$MRASEC^IBCEF4(IBIFN) REJQ ; Not MEDICARE secondary 129 S CURSEQ=$$COBN^IBCEF(IBIFN),X1=+$P($G(^DGCR(399,IBIFN,0)),U,15) 130 S D0=IBIFN 131 F D Q:'D0!Y 132 . ; claim copied from not cancelled and not MRA secondary claim 133 . I X1,$P($G(^DGCR(399,X1,0)),U,13)'=7,X1'=IBIFN S D0="" Q 134 . I X1,$P($G(^DGCR(399,X1,0)),U,19)'=$P($G(^DGCR(399,D0,0)),U,19) S D0="" Q 135 . S I=0 F S I=$O(^IBM(361,"B",D0,I)) Q:'I D Q:Y 136 .. S X2=$G(^IBM(361,I,0)) 137 .. Q:$P(X2,U,3)'="R"!'$P(X2,U,11) ;No reject or no transmit bill 138 .. S X3=$TR($P($G(^IBA(364,+$P(X2,U,11),0)),U,8),"PST","123") ;status msg seq 139 .. Q:X3'=(CURSEQ-1) 140 .. S Y=1 141 . I 'Y S D0=X1,X1=+$P($G(^DGCR(399,X1,0)),U,15) S:X1=D0 D0="" Q 142 REJQ Q Y
Note:
See TracChangeset
for help on using the changeset viewer.
