| 1 | IBAMTV2 ;ALB/CPM - CREATE CHARGES FOR BILLABLE EPISODES ; 01-JUN-94 | 
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**15,153,204**;21-MAR-94 | 
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | BLD ; Create back charges for an array of episodes. | 
|---|
| 6 | ; | 
|---|
| 7 | ; Input: IBSTART  --  First date that the patient is Means Test billable | 
|---|
| 8 | ;          IBEND  --  Last date that the patient is Means Test billable | 
|---|
| 9 | ;            DFN  --  Pointer to the patient in file #2 | 
|---|
| 10 | ; | 
|---|
| 11 | ;        ^TMP("IBAMTV",$J,episode date) = 1^2^3, where | 
|---|
| 12 | ;                         1 = adm date for inpatient care | 
|---|
| 13 | ;                             visit date for outpatient care | 
|---|
| 14 | ;                         2 = disch/last bill date for inpatient care | 
|---|
| 15 | ;                             null for outpatient care | 
|---|
| 16 | ;                         3 = null for inpatient care | 
|---|
| 17 | ;                             softlink for outpatient care | 
|---|
| 18 | ; | 
|---|
| 19 | S IBJOB=9,(IBWHER,IBY,Y)=1,IBDUZ=$S($G(DUZ):DUZ,1:.5) | 
|---|
| 20 | D SITE^IBAUTL I Y<1 S IBY=Y G BLDQ | 
|---|
| 21 | D SERV^IBAUTL2 I IBY<1 G BLDQ | 
|---|
| 22 | ; | 
|---|
| 23 | ; - is there an old clock to use? | 
|---|
| 24 | S IBCLDA=$$OLDCL(DFN,+$O(^TMP("IBAMTV",$J,0))) | 
|---|
| 25 | I IBCLDA D CLDATA^IBAUTL3,DED^IBAUTL3 | 
|---|
| 26 | ; | 
|---|
| 27 | ; - bill all episodes of care | 
|---|
| 28 | S IBEPDT=0 F  S IBEPDT=$O(^TMP("IBAMTV",$J,IBEPDT)) Q:'IBEPDT  S IBEPSTR=$G(^(IBEPDT)) I IBEPSTR D @$S($P(IBEPSTR,"^",2):"INPT",1:"OPT") Q:IBY<0 | 
|---|
| 29 | I IBY<0 G BLDQ | 
|---|
| 30 | ; | 
|---|
| 31 | ; - close clock if over a year old | 
|---|
| 32 | I IBCLDA,$$FMDIFF^XLFDT(DT,IBCLDT)>364 K IBCLDOL D CLOCKCL^IBAUTL3 | 
|---|
| 33 | ; | 
|---|
| 34 | BLDQ I IBY<0 D ^IBAERR1 | 
|---|
| 35 | D KILL1^IBAMTC K IBEPDT,IBEPSTR | 
|---|
| 36 | Q | 
|---|
| 37 | ; | 
|---|
| 38 | ; | 
|---|
| 39 | INPT ; Bill inpatient care. | 
|---|
| 40 | S IBEVDA=0 | 
|---|
| 41 | I IBCLDA S IBCLCT=$$FMDIFF^XLFDT(+IBEPSTR,IBCLDT) | 
|---|
| 42 | S IBBDT=$$FMTH^XLFDT(+IBEPSTR,1) | 
|---|
| 43 | S IBEDT=$$FMTH^XLFDT($P(IBEPSTR,"^",2),1)-1 | 
|---|
| 44 | D ^IBAUTL4 G:IBY<0 INPTQ | 
|---|
| 45 | ; | 
|---|
| 46 | I $G(IBCHPDA) D UPD(IBCHPDA) | 
|---|
| 47 | I $G(IBCHCDA) D UPD(IBCHCDA) | 
|---|
| 48 | I IBCLDA D CLUPD^IBAUTL3 | 
|---|
| 49 | I IBEVDA,$D(IBDT) S IBEVCLD=IBDT D @($S($$CLEV():"EVCLOSE",1:"EVUPD")_"^IBAUTL3") | 
|---|
| 50 | ; | 
|---|
| 51 | INPTQ K IBCHPDA,IBCHCDA,IBCHG,IBCHFR,IBCHTO,IBCHTOTL,IBBS,IBNH,IBTRAN,IBATYP,IBDATE | 
|---|
| 52 | K IBEVDA,IBEVDT,IBEVCLD,IBEVCAL,IBEVNEW,IBEVOLD,IBTOTL,IBDESC,IBIL,IBSL | 
|---|
| 53 | Q | 
|---|
| 54 | ; | 
|---|
| 55 | OPT ; Bill the Outpatient copayment. | 
|---|
| 56 | ;  Input:  IBEPSTR  --  1^2^3, where | 
|---|
| 57 | ;                        1 => visit date | 
|---|
| 58 | ;                        2 => null | 
|---|
| 59 | ;                        3 => softlink (may be null) | 
|---|
| 60 | ;              DFN  --  Pointer to the patient in file #2 | 
|---|
| 61 | ; | 
|---|
| 62 | N %,IBSTOPDA,IBTYPE | 
|---|
| 63 | ; | 
|---|
| 64 | I IBCLDA,$$FMDIFF^XLFDT(+IBEPSTR,IBCLDT)>364 K IBCLDOL D CLOCKCL^IBAUTL3 G:IBY<0 OPTQ | 
|---|
| 65 | I 'IBCLDA S IBCLDT=+IBEPSTR D CLADD^IBAUTL3 G:IBY<0 OPTQ S (IBCLDAY,IBCLDOL)=0 | 
|---|
| 66 | ; | 
|---|
| 67 | ; - build the charge | 
|---|
| 68 | I $P(IBEPSTR,"^",3) S IBSL="409.68:"_$P(IBEPSTR,"^",3) | 
|---|
| 69 | S IBX="O",(IBFR,IBTO,IBDT,IBEVDT)=+IBEPSTR | 
|---|
| 70 | ; | 
|---|
| 71 | ; look up the copay tier info | 
|---|
| 72 | S %=$$GETSC^IBEMTSCU(IBSL,IBEVDT) I % S IBSTOPDA=% | 
|---|
| 73 | ;  get the rate, ibtype = primary or specialty | 
|---|
| 74 | S IBTYPE=$P($G(^IBE(352.5,+$G(IBSTOPDA),0)),"^",3) G:IBTYPE=0 OPTQ | 
|---|
| 75 | ;  if the type is not defined, must be a local created sc, set it to primary | 
|---|
| 76 | I 'IBTYPE S IBTYPE=1 | 
|---|
| 77 | ; | 
|---|
| 78 | ; | 
|---|
| 79 | D TYPE^IBAUTL2 G:IBY<0 OPTQ | 
|---|
| 80 | S IBUNIT=1,IBEVDA="*" | 
|---|
| 81 | D ADD^IBECEAU3 G:IBY<0 OPTQ | 
|---|
| 82 | ; | 
|---|
| 83 | ; - place charge in the 'review' status | 
|---|
| 84 | D UPD(IBN) | 
|---|
| 85 | ; | 
|---|
| 86 | OPTQ K IBUNIT,IBFR,IBTO,IBSL,IBEVDA,IBX,IBDESC,IBATYP,IBCHG,IBRTED,IBN,IBBS,IBEVDT | 
|---|
| 87 | Q | 
|---|
| 88 | ; | 
|---|
| 89 | ; | 
|---|
| 90 | OLDCL(DFN,IBDT) ; Can an old billing clock be used? | 
|---|
| 91 | ;  Input:     DFN  --  Pointer to the patient in file #2 | 
|---|
| 92 | ;            IBDT --  Date of first potentially billable episode | 
|---|
| 93 | ; Output:       0  --  No old billing clock available | 
|---|
| 94 | ;              >0  --  Pointer to old billing clock in file #351 | 
|---|
| 95 | I '$G(DFN) G OLDCLQ | 
|---|
| 96 | N IBX,IBY,IBZ,IBST S IBST=0 | 
|---|
| 97 | S IBX=-(IBDT+.1) F  S IBX=$O(^IBE(351,"AIVDT",DFN,IBX)) Q:'IBX  D  Q:IBST | 
|---|
| 98 | .S IBY=0 F  S IBY=$O(^IBE(351,"AIVDT",DFN,IBX,IBY)) Q:'IBY  D  Q:IBST | 
|---|
| 99 | ..S IBZ=$G(^IBE(351,IBY,0)) Q:'IBZ!($P(IBZ,"^",4)=3) | 
|---|
| 100 | ..I $$FMDIFF^XLFDT(IBDT,$P(IBZ,"^",3))<365 S IBST=1 | 
|---|
| 101 | OLDCLQ Q +$G(IBY) | 
|---|
| 102 | ; | 
|---|
| 103 | UPD(IBN) ; Place the charge in a review status. | 
|---|
| 104 | ;  Input:   IBN  --  Pointer to the charge in file #350 | 
|---|
| 105 | S DIE="^IB(",DA=IBN,DR=".05////21" D ^DIE K DIE,DA,DR | 
|---|
| 106 | Q | 
|---|
| 107 | ; | 
|---|
| 108 | CLEV() ; Should the event record be closed? | 
|---|
| 109 | ;  Input:  variables   IBEVDA  --  Pointer to event in file #350 | 
|---|
| 110 | ;                       IBEND  --  Last date through which to bill | 
|---|
| 111 | ; Output:    1  --  yes, close event | 
|---|
| 112 | ;            0  --  don't close event | 
|---|
| 113 | N IBX,IBZ S IBX=0 | 
|---|
| 114 | I '$G(IBEVDA)!'$G(IBEND) S IBX=1 G CLEVQ | 
|---|
| 115 | I IBEND<$$FMADD^XLFDT(DT,-1) S IBX=1 G CLEVQ | 
|---|
| 116 | S IBZ=+$P($P($G(^IB(IBEVDA,0)),"^",4),":",2),IBZ=$P($G(^DGPM(IBZ,0)),"^",14) | 
|---|
| 117 | I IBZ,$P($G(^DGPM(IBZ,0)),"^",17) S IBX=1 | 
|---|
| 118 | CLEVQ Q IBX | 
|---|