- Timestamp:
- Dec 4, 2009, 12:11:15 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBRFN3.m
r613 r623 1 IBRFN3 2 ;;2.0;INTEGRATED BILLING;**61,133,210,309,389**;21-MAR-94;Build 6 3 ;;Per VHA Directive 2004-038, this routine should not be modified.4 5 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 BILL(IBIFN,ARRAY) 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 INS 72 73 74 75 76 77 RC 78 79 80 81 82 83 OPV 84 85 86 87 88 89 PRC 90 91 92 93 94 95 96 97 98 99 100 DX 101 102 103 104 105 106 107 108 RX 109 110 111 112 113 114 115 116 117 118 PD 119 120 121 122 123 124 .. S ARRAY("PRD",IBJ)=$$PINB^IBCSC5B(+IBX)_U_IBI125 126 CC 127 128 129 130 131 132 133 134 135 STATE(X) 136 137 ZIP(X) 138 139 140 RTI(X) 141 142 143 1 IBRFN3 ;ALB/ARH - PASS BILL/CLAIM TO AR ;3/18/96 2 ;;2.0;INTEGRATED BILLING;**61,133,210,309**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ; Returns information on the bill passed in, all data returned in external format, for AR's RC project 6 ; 7 ; If the bill can not be found then returns ARRAY=0 (should be called with ARRAY passed by reference) 8 ; Otherwise ARRAY=1 and the following array elements may be defined 9 ; these array elements will only be defined is there is data to return 10 ; those elements that have multiple entries will be in the form ARRAY("SUB",X) where X=1:1:... 11 ; 12 ; ARRAY("BN") = BILL NUMBER 13 ; ARRAY("SR") = SENSITIVE RECORD? (Y or N) 14 ; ARRAY("STF") = STATEMENT COVERS FROM DATE - first date covered by bill 15 ; ARRAY("STT") = STATEMENT COVERS TO DATE - last date covered by bill 16 ; ARRAY("TCG") = TOTAL CHARGES^OFFSET AMT (PRIOR PAYMENTS)^OFFSET DESC 17 ; ARRAY("TOC") = BILL TYPE (INPATIENT OR OUTPATIENT) 18 ; ARRAY("TCF") = BILL FORM TYPE 19 ; ARRAY("DFP") = DATE FIRST PRINTED 20 ; ARRAY("TAX") = FEDERAL TAX NUMBER - for facility, a site parameter 21 ; 22 ; ARRAY("PIN") = DEBTOR INSURANCE NAME ^ HOSPITAL PROVIDER NUMBER ^ GROUP NAME ^ GROUP NUMBER ^ 23 ; NAME OF INSURED ^ SUBSCRIBER ID ^ RELATIONSHIP TO INSURED 24 ; 25 ; ARRAY("PIN","MMA") = DEBTOR MAILING STREET ADDRESS [LINE 1] ^ 26 ; MAILING STREET ADDRESS [LINE 2] ^ MAILING STREET ADDRESS [LINE 3] ^ CITY ^ 27 ; STATE (ABBREVIATED) ^ ZIP ^ PHONE NUMBER 28 ; 29 ; ARRAY("RVC") = NUMBER OF REVENUE CODES ON BILL 30 ; ARRAY("RVC",X) = REVENUE CODE ^ REVENUE CODE DESCRIPTION ^ CHARGE (PER UNIT) ^ UNITS ^ 31 ; TOTAL CHARGE FOR REV CODE 32 ; 33 ; ARRAY("OPV") = NUMBER OF OUTPATIENT VISIT DATES ON BILL 34 ; ARRAY("OPV",X) = OUTPATIENT VISIT DATE 35 ; 36 ; ARRAY("PRC") = NUMBER OF PROCEDURES ON BILL 37 ; ARRAY("PRC",X) = PROCEDURE CODE ^ PROCEDURE DESCRIPTION ^ PROCEDURE DATE ^ 38 ; PLACE OF SERVICE CODE ^ PLACE OF SERVICE ^ TYPE OF SERVICE CODE ^ TYPE OF SERVICE 39 ; 40 ; ARRAY("DXS") = NUMBER OF DIAGNOSIS ON BILL 41 ; ARRAY("DXS,X) = DIAGNOSIS CODE ^ DIAGNOSIS 42 ; 43 ; ARRAY("RXF") = NUMBER OF PRESCRIPTION REFILLS ON BILL 44 ; ARRAY("RXF",X) = PRESCRIPTION # ^ REFILL DATE ^ DRUG NAME ^ DAYS SUPPLY ^ QUANTITY ^ NDC # 45 ; 46 ; ARRAY("PRD") = NUMBER OF PROSTHETIC ITEMS ON BILL 47 ; ARRAY("PRD",X) = PROSTHETIC DEVICE ^ DELIVERY DATE 48 ; 49 ; IF CONDITION RELATED TO EMPLOYMENT: ARRAY("CRE") = "EMPLOYMENT" 50 ; IF CONDITION RELATED TO AN AUTO ACCIDENT: ARRAY("CRA") = "AUTO ACCIDENT" ^ STATE (ABBREVIATION) 51 ; IF CONDITION RELATED TO AN OTHER ACCIDENT: ARRAY("CRO") = "OTHER ACCIDENT" 52 ; 53 BILL(IBIFN,ARRAY) ; returns array of information on a specific bill, based on RC requirements 54 ; 55 N IBI,IBJ,IBK,IBX,IBY,IBTMP,IBD0,IBDU,IBDU1,IBDI1,IBDS,IBDATE 56 K ARRAY S ARRAY=1 I '$G(IBIFN)!($G(^DGCR(399,+$G(IBIFN),0))="") S ARRAY=0 Q 57 F IBI=0,"U","U1","S" S @("IBD"_IBI)=$G(^DGCR(399,IBIFN,IBI)) 58 S IBX=$P(IBD0,U,21),IBX=$S(IBX="P":"I1",IBX="S":"I2",IBX="T":"I3",1:" ") 59 S IBDI1=$G(^DGCR(399,IBIFN,IBX)) 60 ; 61 S ARRAY("TCG")=$P(IBDU1,U,1,3) 62 S ARRAY("BN")=$P(IBD0,U,1) 63 S ARRAY("SR")=$S($P(IBDU,U,5)=1:"Y",1:"N") 64 S ARRAY("STF")=$P(IBDU,U,1) 65 S ARRAY("STT")=$P(IBDU,U,2) 66 S ARRAY("TOC")=$S($P(IBD0,U,5)<3:"INPATIENT",1:"OUTPATIENT") 67 S ARRAY("TCF")=$$FTN^IBCU3($$FT^IBCU3(IBIFN)) 68 S ARRAY("DFP")=$P(IBDS,U,12) 69 S ARRAY("TAX")=$P($G(^IBE(350.9,1,1)),U,5) 70 ; 71 INS ; insurance information 72 S IBX=$G(^DGCR(399,+IBIFN,"M")) 73 S ARRAY("PIN")=$P(IBX,U,4)_U_$P($G(^DIC(36,+IBDI1,0)),U,11)_U_$P(IBDI1,U,15)_U_$P(IBDI1,U,3)_U_$P(IBDI1,U,17)_U_$P(IBDI1,U,2)_U_$$RTI($P(IBDI1,U,16)) 74 S ARRAY("PIN","MMA")=$P(IBX,U,5)_U_$P(IBX,U,6)_U_$P($G(^DGCR(399,+IBIFN,"M1")),U,1)_U_$P(IBX,U,7)_U_$$STATE($P(IBX,U,8)) 75 S ARRAY("PIN","MMA")=ARRAY("PIN","MMA")_U_$$ZIP($P(IBX,U,9))_U_$P($G(^DIC(36,+IBDI1,.13)),U,1) 76 ; 77 RC ; revenue codes 78 S (IBI,IBJ)=0,ARRAY("RVC")=IBJ F S IBI=$O(^DGCR(399,IBIFN,"RC",IBI)) Q:'IBI D 79 . S IBX=$G(^DGCR(399,IBIFN,"RC",IBI,0)) Q:IBX="" S IBY=$G(^DGCR(399.2,+IBX,0)) 80 . S IBJ=IBJ+1,ARRAY("RVC")=IBJ 81 . S ARRAY("RVC",IBJ)=$P(IBY,U,1)_U_$P(IBY,U,2)_U_$P(IBX,U,2)_U_$P(IBX,U,3)_U_$P(IBX,U,4) 82 ; 83 OPV ; outpatient visit dates 84 S (IBI,IBJ)=0,ARRAY("OPV")=IBJ F S IBI=$O(^DGCR(399,IBIFN,"OP",IBI)) Q:'IBI D 85 . S IBX=$G(^DGCR(399,IBIFN,"OP",IBI,0)) Q:'IBX 86 . S IBJ=IBJ+1,ARRAY("OPV")=IBJ 87 . S ARRAY("OPV",IBJ)=+IBX 88 ; 89 PRC ; procedure codes 90 S (IBI,IBJ)=0,ARRAY("PRC")=IBJ F S IBI=$O(^DGCR(399,IBIFN,"CP",IBI)) Q:'IBI D 91 . S IBX=$G(^DGCR(399,IBIFN,"CP",IBI,0)),IBY="" 92 . S IBDATE=$P(IBX,U,2) I 'IBDATE S IBDATE=$$BDATE^IBACSV(IBIFN) 93 . S IBY=$P($$PRCD^IBCEF1($P(IBX,U),1,IBDATE),U,2,3) 94 . Q:$P(IBY,U)="" 95 . S IBJ=IBJ+1,ARRAY("PRC")=IBJ 96 . S ARRAY("PRC",IBJ)=IBY_U_$P(IBX,U,2) 97 . S IBY=$G(^IBE(353.1,+$P(IBX,U,9),0)),ARRAY("PRC",IBJ)=ARRAY("PRC",IBJ)_U_$P(IBY,U)_U_$P(IBY,U,3) 98 . S IBY=$G(^IBE(353.2,+$P(IBX,U,10),0)),ARRAY("PRC",IBJ)=ARRAY("PRC",IBJ)_U_$P(IBY,U)_U_$P(IBY,U,3) 99 ; 100 DX ; diagnosis codes 101 K IBTMP D SET^IBCSC4D(IBIFN,"",.IBTMP) 102 S IBDATE=$$BDATE^IBACSV(IBIFN) 103 S (IBI,IBJ)=0,ARRAY("DXS")=IBJ F S IBI=$O(IBTMP(IBI)) Q:'IBI D 104 . S IBX=IBTMP(IBI),IBY=$$ICD9^IBACSV(+IBX,IBDATE) Q:IBY="" 105 . S IBJ=IBJ+1,ARRAY("DXS")=IBJ 106 . S ARRAY("DXS",IBJ)=$P(IBY,U)_U_$P(IBY,U,3) 107 ; 108 RX ; prescription refills 109 K IBTMP D SET^IBCSC5A(IBIFN,.IBTMP) 110 S (IBI,IBJ)=0,ARRAY("RXF")=IBJ F S IBI=$O(IBTMP(IBI)) Q:'IBI D 111 . S IBK=0 F S IBK=$O(IBTMP(IBI,IBK)) Q:'IBK D 112 .. S IBX=IBTMP(IBI,IBK) D ZERO^IBRXUTL(+$P(IBX,U,2)) S IBY=$G(^TMP($J,"IBDRUG",+$P(IBX,U,2),.01)) 113 .. S IBJ=IBJ+1,ARRAY("RXF")=IBJ 114 .. S ARRAY("RXF",IBJ)=IBI_U_IBK_U_IBY_U_$P(IBX,U,3)_U_$P(IBX,U,4)_U_$P(IBX,U,5) 115 .. K ^TMP($J,"IBDRUG") 116 .. Q 117 ; 118 PD ; prosthetic items 119 K IBTMP D SET^IBCSC5B(IBIFN,.IBTMP) 120 S (IBI,IBJ)=0,ARRAY("PRD")=IBJ F S IBI=$O(IBTMP(IBI)) Q:'IBI D 121 . S IBK=0 F S IBK=$O(IBTMP(IBI,IBK)) Q:'IBK D 122 .. S IBX=IBTMP(IBI,IBK) 123 .. S IBJ=IBJ+1,ARRAY("PRD")=IBJ 124 .. S ARRAY("PRD",IBJ)=$P($$PIN^IBCSC5B(IBK),U,2)_U_IBI 125 ; 126 CC ; condition related to employment, auto accident (place), other accident 127 S IBI=0 F S IBI=$O(^DGCR(399,IBIFN,"CC",IBI)) Q:'IBI I $G(^(IBI,0))="02" S ARRAY("CRE")="EMPLOYMENT" 128 S IBI=0 F S IBI=$O(^DGCR(399,IBIFN,"OC",IBI)) Q:'IBI S IBX=$G(^(IBI,0)) I +IBX D 129 . S IBY=$G(^DGCR(399.1,+IBX,0)) Q:IBY="" 130 . I $P(IBY,U,9)=1 S ARRAY("CRE")="EMPLOYMENT" 131 . I $P(IBY,U,9)=2 S ARRAY("CRA")="AUTO ACCIDENT"_U_$$STATE($P(IBX,U,3)) 132 . I $P(IBY,U,9)=3 S ARRAY("CRO")="OTHER ACCIDENT" 133 Q 134 ; 135 STATE(X) ; returns 2 letter abbreviation for state 136 Q $P($G(^DIC(5,+X,0)),U,2) 137 ZIP(X) ; returns zip in external form 138 S X=$E(X,1,5)_$S($E(X,6,9)]"":"-"_$E(X,6,9),1:"") 139 Q X 140 RTI(X) ; returns external form of relationship to insured 141 I X'="" S X=$S(X="01":"PATIENT",X="02":"SPOUSE",X="03":"NATURAL CHILD",X="08":"EMPLOYEE",X="09":"UNKNOWN",X="11":"ORGAN DONOR",X="15":"INJURED PLANTIFF",X="18":"PARENT",1:"") 142 Q X 143 ;IBRFN3
Note:
See TracChangeset
for help on using the changeset viewer.
