- 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/IBCEF21.m
r613 r623 1 IBCEF21 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS CONTINUED ;06-FEB-96 2 ;;2.0;INTEGRATED BILLING;**51,296,371,389**;21-MAR-94;Build 6 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 COID(IBIFN) ; Claim office ID 6 N IBCOID,IBCOID1,IBIN 7 S IBIN=$$CURR^IBCEF2(IBIFN),IBCOID1="",IBCOID=$P($$ADDRESS^IBCNSC0(IBIN,.11,5),U,11) 8 ; 9 I IBIN D 10 . I $D(^IBA(364.2,"C",IBIFN)) S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.18,5),U,11) Q ;Rx 11 . I $P($G(^DGCR(399,IBIFN,0)),U,5)<3 S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.12,5),U,11) Q ;Inpt 12 . I $P($G(^DGCR(399,IBIFN,0)),U,5)'<3 S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.16,5),U,11) Q ;Outpt 13 ; 14 Q $S(IBCOID1'="":IBCOID1,1:IBCOID) 15 ; 16 ESGHPST(IBIFN,COB) ; return insureds employment status if the bill policy defined by COB is an Employer Sponsored Group Health Plan 17 ; ESGHP FLAG (2.312,2.1) ^ the employment status (2.312,2.11) 18 ; 19 N PPOL,DFN,X,Y S Y="" 20 S PPOL=$$PPOL^IBCEF2($G(IBIFN),$G(COB)),DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) 21 I +PPOL,+DFN S X=$G(^DPT(DFN,.312,+PPOL,2)) S Y=+$P(X,U,10)_U_$P(X,U,11) 22 Q Y 23 ; 24 ESGHPNL(IBIFN,COB) ; return employer name and location if the bill policy defined by COB is an Employer Sponsored Group Health Plan 25 ; ESGHP FLAG (2.312,2.1) ^ employer name (2.312,2.015) ^ employer city (2.312,2.05) 26 ; ^ employer state abbr (2.312,2.06) ^ employer state ifn (2.312,2.06) 27 ; 28 N PPOL,DFN,X,Y S Y="" 29 S PPOL=$$PPOL^IBCEF2($G(IBIFN),$G(COB)),DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) 30 I +PPOL,+DFN S X=$G(^DPT(DFN,.312,+PPOL,2)) S Y=+$P(X,U,10)_U_$P(X,U,9)_U_$P(X,U,5)_U_$P($G(^DIC(5,+$P(X,U,6),0)),U,2)_U_$P(X,U,6) 31 Q Y 32 ; 33 REMARKS(IBIFN) ; Compile array of bill remarks 34 ;IBIFN = bill ien 35 N Z,Z0,Z1,IBARRAY,IBSM 36 S Z=0 37 ;S:$P($G(^DGCR(399,IBIFN,"U1")),U,2) Z=Z+1,Z0=$P(^("U1"),U,2),IBXDATA(Z)="OFFSET AMOUNT: "_"$"_+$P(Z0,".")_"."_$E($P(Z0,".",2)_"00",1,2) 38 S:$P($G(^DGCR(399,IBIFN,"U1")),U,8)'="" Z=Z+1,IBXDATA(Z)=$P(^("U1"),U,8) ;Bill comment on bill 39 S Z0=$G(^DGCR(399,IBIFN,0)),Z1=$G(^DGCR(399.3,+$P(Z0,U,7),0)) 40 D SET^IBCSC5B(IBIFN,.IBARRAY) 41 I $P($G(IBARRAY),U,2) D ;Prosthetics 42 . S Z0=0 F S Z0=$O(IBARRAY(Z0)) Q:Z0="" S Z1=0 F S Z1=$O(IBARRAY(Z0,Z1)) Q:'Z1 S Z=Z+1,IBXDATA(Z)="Prosthetic: "_$E($$PINB^IBCSC5B(+IBARRAY(Z0,Z1)),1,39)_" "_$E(Z0,4,5)_"/"_$E(Z0,6,7)_"/"_$E(Z0,1,2) 43 Q 44 ; 45 CREM(IBIFN) ; Compile array of bill remarks common to every bill 46 ;IBIFN = bill ien 47 N Z 48 S Z=0 49 S:$P($G(^IBE(350.9,1,1)),U,4)'="" Z=Z+1,IBXDATA(Z)=$P(^(1),U,4) ;Site specific 'every bill' comment 50 Q 51 ; 52 ADMDT(IBIFN,NOOUTCK) ; Calculate admission/start of care date/time 53 ; IBIFN = bill ien 54 ; NOOUTCK = flag that will: 55 ; (1) no check for inpt episode overlap for outpt 56 ; (0 or null) performs check for inpt episode overlap for outpt 57 ; 58 ; Returns IBXDATA = fileman date format 59 N Z,Z0,Z1 60 S Z=$G(^DGCR(399,IBIFN,0)),Z1=$P($G(^("U")),U,20),Z0=$$INPAT^IBCEF(IBIFN,1) 61 S IBXDATA=$S(Z0&$P(Z,U,8):$P($G(^DGPT(+$P(Z,U,8),0)),U,2),1:"") 62 S:'IBXDATA IBXDATA=$P(Z,U,3)_$S(Z0&(Z1<25):"."_$E("0",$L(Z1))_Z1,1:"") 63 ; Check to see if outpt episode (date in event date) overlaps inpt 64 ; episode - use admit date if it does 65 I 'Z0,IBXDATA,'$G(NOOUTCK) D 66 . N VAINDT,VAIN,DFN 67 . S VAINDT=IBXDATA,DFN=$P($G(^DGCR(399,IBIFN,0)),U) 68 . D INP^VADPT S IBXDATA=+VAIN(7) S:'IBXDATA IBXDATA="" 69 I 'IBXDATA,'Z0 S IBXDATA=$$SERVDT^IBCEF(IBIFN,,2) 70 Q 71 ; 72 DISDT(IBIFN) ; Calculate discharge date 73 ; IBIFN = bill ien 74 N Z,Z0 75 S Z=$$INPAT^IBCEF(IBIFN,1),Z0=$G(^DGCR(399,IBIFN,0)) 76 I Z S IBXDATA=+$G(^DGPT(+$P(Z0,U,8),70)) S:'IBXDATA IBXDATA=$P(Z0,U,16) 77 I 'Z N VAINDT,VAIN,DFN S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2) D INP^VADPT I VAIN(1) S IBXDATA=+$G(^DGPM(+$P($G(^DGPM(+VAIN(1),0)),U,17),0)) 78 Q 79 ; 80 INSSECID(IBIFN,TYPE,SEQ) ; Extract subscriber and patient prim/sec ID's 81 ; IBIFN required 82 ; TYPE is either "PAT" or "SUB" to indicate we need to extract either 83 ; patient or subscriber ID information. Default="SUB". 84 ; SEQ is the insurance sequence# (1,2,3). Default is current ins seq#. 85 ; 86 ; Output: 87 ; Function returns an 8-piece string as follows. 88 ; [1] primary qualifier 89 ; [2] primary ID 90 ; [3] secondary qual(1) 91 ; [4] secondary ID(1) 92 ; [5] secondary qual(2) 93 ; [6] secondary ID(2) 94 ; [7] secondary qual(3) 95 ; [8] secondary ID(3) 96 ; 97 NEW DATA,DFN,POL,IB0,IB5,REL 98 S DATA="" 99 S IBIFN=+$G(IBIFN) I 'IBIFN G INSSX 100 I $G(TYPE)="" S TYPE="SUB" ; default type of ID's to get 101 I '$F(".PAT.SUB.","."_TYPE_".") G INSSX 102 I '$G(SEQ) S SEQ=$$COBN^IBCEF(IBIFN) ; default current ins seq# 103 I '$F(".1.2.3.","."_SEQ_".") G INSSX 104 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) I 'DFN G INSSX 105 S POL=+$P($G(^DGCR(399,IBIFN,"M")),U,SEQ+11) I 'POL G INSSX 106 S IB0=$G(^DPT(DFN,.312,POL,0)) I IB0="" G INSSX 107 S IB5=$G(^DPT(DFN,.312,POL,5)) 108 S REL=+$P(IB0,U,16) ; pat rel to insured 109 S $P(DATA,U,1)="MI" 110 S $P(DATA,U,2)=$P(IB0,U,2) ; subscriber primary ID 111 S $P(DATA,U,3,8)=$P(IB5,U,2,7) ; subscriber secondary data 112 I TYPE="PAT",REL'=1 D 113 . S $P(DATA,U,2)=$P(IB5,U,1) ; patient primary ID 114 . S $P(DATA,U,3,8)=$P(IB5,U,8,13) ; patient secondary data 115 . Q 116 ; 117 S DATA=$$SCRUB(DATA) ; scrub the data 118 INSSX ; 119 Q DATA 120 ; 121 SCRUB(DATA) ; Scrub the 8-piece string gathered above 122 NEW PCE 123 ; 124 ; make sure you can't have an ID without a qualifier or a qualifier 125 ; without an ID. Check all 4 pairs. 126 F PCE=1,3,5,7 D 127 . I $P(DATA,U,PCE)'="",$P(DATA,U,PCE+1)'="" Q 128 . S ($P(DATA,U,PCE),$P(DATA,U,PCE+1))="" 129 . Q 130 ; 131 ; fill in secondary gaps. If Set1 and Set2 are blank, but Set3 exists 132 ; then move Set3 to Set1 and delete Set3. 133 I $P(DATA,U,3)="",$P(DATA,U,5)="",$P(DATA,U,7)'="" D 134 . S $P(DATA,U,3)=$P(DATA,U,7),$P(DATA,U,4)=$P(DATA,U,8) 135 . S ($P(DATA,U,7),$P(DATA,U,8))="" 136 . Q 137 ; 138 ; fill in secondary gaps more generically. 139 ; If Set(n) is blank, but Set(n+1) exists, then move it up. 140 F PCE=3,5 D 141 . I $P(DATA,U,PCE)="",$P(DATA,U,PCE+2)'="" D 142 .. S $P(DATA,U,PCE)=$P(DATA,U,PCE+2) 143 .. S $P(DATA,U,PCE+1)=$P(DATA,U,PCE+3) 144 .. S ($P(DATA,U,PCE+2),$P(DATA,U,PCE+3))="" 145 .. Q 146 . Q 147 ; 148 Q DATA 149 ; 1 IBCEF21 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS CONTINUED ;06-FEB-96 2 ;;2.0;INTEGRATED BILLING;**51,296**;21-MAR-94 3 ; 4 COID(IBIFN) ; Claim office ID 5 N IBCOID,IBCOID1,IBIN 6 S IBIN=$$CURR^IBCEF2(IBIFN),IBCOID1="",IBCOID=$P($$ADDRESS^IBCNSC0(IBIN,.11,5),U,11) 7 ; 8 I IBIN D 9 . I $D(^IBA(364.2,"C",IBIFN)) S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.18,5),U,11) Q ;Rx 10 . I $P($G(^DGCR(399,IBIFN,0)),U,5)<3 S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.12,5),U,11) Q ;Inpt 11 . I $P($G(^DGCR(399,IBIFN,0)),U,5)'<3 S IBCOID1=$P($$ADDRESS^IBCNSC0(IBIN,.16,5),U,11) Q ;Outpt 12 ; 13 Q $S(IBCOID1'="":IBCOID1,1:IBCOID) 14 ; 15 ESGHPST(IBIFN,COB) ; return insureds employment status if the bill policy defined by COB is an Employer Sponsored Group Health Plan 16 ; ESGHP FLAG (2.312,2.1) ^ the employment status (2.312,2.11) 17 ; 18 N PPOL,DFN,X,Y S Y="" 19 S PPOL=$$PPOL^IBCEF2($G(IBIFN),$G(COB)),DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) 20 I +PPOL,+DFN S X=$G(^DPT(DFN,.312,+PPOL,2)) S Y=+$P(X,U,10)_U_$P(X,U,11) 21 Q Y 22 ; 23 ESGHPNL(IBIFN,COB) ; return employer name and location if the bill policy defined by COB is an Employer Sponsored Group Health Plan 24 ; ESGHP FLAG (2.312,2.1) ^ employer name (2.312,2.015) ^ employer city (2.312,2.05) 25 ; ^ employer state abbr (2.312,2.06) ^ employer state ifn (2.312,2.06) 26 ; 27 N PPOL,DFN,X,Y S Y="" 28 S PPOL=$$PPOL^IBCEF2($G(IBIFN),$G(COB)),DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) 29 I +PPOL,+DFN S X=$G(^DPT(DFN,.312,+PPOL,2)) S Y=+$P(X,U,10)_U_$P(X,U,9)_U_$P(X,U,5)_U_$P($G(^DIC(5,+$P(X,U,6),0)),U,2)_U_$P(X,U,6) 30 Q Y 31 ; 32 REMARKS(IBIFN) ; Compile array of bill remarks 33 ;IBIFN = bill ien 34 N Z,Z0,Z1,IBARRAY,IBSM 35 S Z=0 36 ;S:$P($G(^DGCR(399,IBIFN,"U1")),U,2) Z=Z+1,Z0=$P(^("U1"),U,2),IBXDATA(Z)="OFFSET AMOUNT: "_"$"_+$P(Z0,".")_"."_$E($P(Z0,".",2)_"00",1,2) 37 S:$P($G(^DGCR(399,IBIFN,"U1")),U,8)'="" Z=Z+1,IBXDATA(Z)=$P(^("U1"),U,8) ;Bill comment on bill 38 S Z0=$G(^DGCR(399,IBIFN,0)),Z1=$G(^DGCR(399.3,+$P(Z0,U,7),0)) 39 D SET^IBCSC5B(IBIFN,.IBARRAY) 40 I $P($G(IBARRAY),U,2) D ;Prosthetics 41 . S Z0=0 F S Z0=$O(IBARRAY(Z0)) Q:Z0="" S Z1=0 F S Z1=$O(IBARRAY(Z0,Z1)) Q:'Z1 S Z=Z+1,IBXDATA(Z)="Prosthetic: "_$E($P($$PIN^IBCSC5B(Z1),U,2),1,39)_" "_$E(Z0,4,5)_"/"_$E(Z0,6,7)_"/"_$E(Z0,1,2) 42 Q 43 ; 44 CREM(IBIFN) ; Compile array of bill remarks common to every bill 45 ;IBIFN = bill ien 46 N Z 47 S Z=0 48 S:$P($G(^IBE(350.9,1,1)),U,4)'="" Z=Z+1,IBXDATA(Z)=$P(^(1),U,4) ;Site specific 'every bill' comment 49 Q 50 ; 51 ADMDT(IBIFN,NOOUTCK) ; Calculate admission/start of care date/time 52 ; IBIFN = bill ien 53 ; NOOUTCK = flag that will: 54 ; (1) no check for inpt episode overlap for outpt 55 ; (0 or null) performs check for inpt episode overlap for outpt 56 ; 57 ; Returns IBXDATA = fileman date format 58 N Z,Z0,Z1 59 S Z=$G(^DGCR(399,IBIFN,0)),Z1=$P($G(^("U")),U,20),Z0=$$INPAT^IBCEF(IBIFN,1) 60 S IBXDATA=$S(Z0&$P(Z,U,8):$P($G(^DGPT(+$P(Z,U,8),0)),U,2),1:"") 61 S:'IBXDATA IBXDATA=$P(Z,U,3)_$S(Z0&(Z1<25):"."_$E("0",$L(Z1))_Z1,1:"") 62 ; Check to see if outpt episode (date in event date) overlaps inpt 63 ; episode - use admit date if it does 64 I 'Z0,IBXDATA,'$G(NOOUTCK) D 65 . N VAINDT,VAIN,DFN 66 . S VAINDT=IBXDATA,DFN=$P($G(^DGCR(399,IBIFN,0)),U) 67 . D INP^VADPT S IBXDATA=+VAIN(7) S:'IBXDATA IBXDATA="" 68 I 'IBXDATA,'Z0 S IBXDATA=$$SERVDT^IBCEF(IBIFN,,2) 69 Q 70 ; 71 DISDT(IBIFN) ; Calculate discharge date 72 ; IBIFN = bill ien 73 N Z,Z0 74 S Z=$$INPAT^IBCEF(IBIFN,1),Z0=$G(^DGCR(399,IBIFN,0)) 75 I Z S IBXDATA=+$G(^DGPT(+$P(Z0,U,8),70)) S:'IBXDATA IBXDATA=$P(Z0,U,16) 76 I 'Z N VAINDT,VAIN,DFN S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2) D INP^VADPT I VAIN(1) S IBXDATA=+$G(^DGPM(+$P($G(^DGPM(+VAIN(1),0)),U,17),0)) 77 Q 78 ;
Note:
See TracChangeset
for help on using the changeset viewer.
