[613] | 1 | IBECEAU2 ;ALB/CPM-Cancel/Edit/Add... User Prompts ; 19-APR-93
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**7,52,153,176**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | REAS(IBX) ; Ask for the cancellation reason.
|
---|
| 6 | ; Input: IBX -- "C" (Cancel a charge), "E" (Edit a Charge)
|
---|
| 7 | S DIC="^IBE(350.3,",DIC(0)="AEMQZ",DIC("A")="Select "_$S(IBX="E":"EDIT",1:"CANCELLATION")_" REASON: "
|
---|
| 8 | S DIC("S")=$S(IBXA=7:"I 1",IBXA=6:"I $P(^(0),U,3)=3",IBXA=5:"I ($P(^(0),U,3)=1)!($P(^(0),U,3)=3)",1:"I ($P(^(0),U,3)=2)!($P(^(0),U,3)=3)")
|
---|
| 9 | D ^DIC K DIC S IBCRES=+Y I Y<0 W !!,"No ",$S(IBX="E":"edit",1:"cancellation")," reason entered - the transaction cannot be completed."
|
---|
| 10 | Q
|
---|
| 11 | ;
|
---|
| 12 | UNIT(DEF) ; Ask for units for Rx copay charges
|
---|
| 13 | ; Input: DEF -- Default value if previous charge is to be displayed
|
---|
| 14 | N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
|
---|
| 15 | S DA=IBATYP,IBDESC="RX COPAYMENT" D COST^IBAUTL S IBCHG=X1
|
---|
| 16 | S DIR(0)="N^::0^K:X<1!(X>3) X",DIR("A")="Units",DIR("?")="^D HUN^IBECEAU2"
|
---|
| 17 | S:DEF DIR("B")=DEF D ^DIR I Y S IBUNIT=Y,IBCHG=IBCHG*Y
|
---|
| 18 | I 'Y W !!,"Units not entered - transaction cannot be completed." S IBY=-1
|
---|
| 19 | Q
|
---|
| 20 | ;
|
---|
| 21 | FR(DEF) ; Ask Bill From Date
|
---|
| 22 | ; Input: DEF -- Default value if previous charge is to be displayed
|
---|
| 23 | N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
|
---|
| 24 | FRA S:$G(DEF) DIR("B")=$$DAT2^IBOUTL(DEF)
|
---|
| 25 | S DIR(0)="DA^2901001:"_IBLIM_":EX",DIR("A")=$S(IBXA=4!(IBXA=7):"Visit Date: ",1:"Charge for services from: "),DIR("?")="^D HFR^IBECEAU2"
|
---|
| 26 | D ^DIR K DIR S IBFR=Y I 'Y W !!,$S(IBXA=4!(IBXA=7):"Visit",1:"Bill From")," Date not entered - transaction cannot be completed." S IBY=-1 G FRQ
|
---|
| 27 | I IBXA=7 G FRQ
|
---|
| 28 | I IBXA'=8,IBXA'=9,'$$BIL^DGMTUB(DFN,IBFR+.24) D CATC G FRA
|
---|
| 29 | I IBXA>7,IBXA<10,$$LTCST^IBAECU(DFN,IBFR,1)<2 W !,"This patient is not LTC billable on this date.",! G FRA
|
---|
| 30 | I IBXA=4,$$BFO^IBECEAU(DFN,IBFR) W !!,"This patient has already been billed the outpatient copay charge for ",$$DAT1^IBOUTL(IBFR),".",! G FRA
|
---|
| 31 | FRQ Q
|
---|
| 32 | ;
|
---|
| 33 | TO(DEF) ; Ask Bill To Date
|
---|
| 34 | ; Input: DEF -- Default value if previous charge is to be displayed
|
---|
| 35 | N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
|
---|
| 36 | TOA S:$G(DEF) DIR("B")=$$DAT2^IBOUTL(DEF)
|
---|
| 37 | S DIR(0)="DA^"_IBFR_":"_IBLIM_":EX",DIR("A")=" Charge for services to: ",DIR("?")="^D HTO^IBECEAU2"
|
---|
| 38 | D ^DIR K DIR S IBTO=Y I 'Y W !!,"Bill To date not entered - transaction cannot be completed." S IBY=-1 G TOQ
|
---|
| 39 | I IBTO'=IBFR,'$$BIL^DGMTUB(DFN,$S(IBXA=3&'$G(DEF):$$FMADD^XLFDT(IBTO,-1),1:IBTO)+.24),IBXA'=8,IBXA'=9 D CATC G TOA
|
---|
| 40 | TOQ Q
|
---|
| 41 | ;
|
---|
| 42 | FEE(DEF) ; Ask for Fee Amount
|
---|
| 43 | ; Input: DEF -- Default value if previous charge is to be displayed
|
---|
| 44 | N DIR,DIRUT,DUOUT,DTOUT,X,Y
|
---|
| 45 | S:$G(DEF) DIR("B")=DEF
|
---|
| 46 | S DIR(0)="NA^::2^K:X<0!(X>(IBMED-IBCLDOL)) X",DIR("A")=" Fee Amount: ",DIR("?")="^D HFEE^IBECEAU2"
|
---|
| 47 | D ^DIR S IBCHG=Y I 'Y W !!,"Charge not entered - transaction cannot be completed." S IBY=-1
|
---|
| 48 | Q
|
---|
| 49 | ;
|
---|
| 50 | AMT ; Ask for Charge Amount
|
---|
| 51 | N DIR,DIRUT,DUOUT,DTOUT,X,Y
|
---|
| 52 | S DIR(0)="NA^::2^K:X<0!(X>99999) X",DIR("A")="Charge Amount: ",DIR("?")="^D HAMT^IBECEAU2"
|
---|
| 53 | D ^DIR S IBCHG=Y I 'Y W !!,"Charge not entered - transaction cannot be completed." S IBY=-1
|
---|
| 54 | Q
|
---|
| 55 | ;
|
---|
| 56 | CATC ; Display that patient is not Means Test billable.
|
---|
| 57 | W !!,"The patient ",$S(IBFR<DT:"was",1:"is")," not Means Test billable on this date.",!
|
---|
| 58 | Q
|
---|
| 59 | ;
|
---|
| 60 | HUN ; Help for units
|
---|
| 61 | W !!,"Please enter 1, 2, or 3 to denote a 30, 60, or 90 days supply of"
|
---|
| 62 | W !,"medication, or '^' to quit."
|
---|
| 63 | Q
|
---|
| 64 | ;
|
---|
| 65 | HFR ; Help for Bill From date
|
---|
| 66 | W !!,"Please enter the ",$S(IBXA=4!(IBXA=7):"patient's outpatient visit date",1:"'Bill From' date for this charge"),", which must follow"
|
---|
| 67 | W !,"10/1/90",$S(IBXA=4!(IBXA=7):"",1:" (and be prior to today)"),", or '^' to quit."
|
---|
| 68 | Q
|
---|
| 69 | ;
|
---|
| 70 | HTO ; Help for Bill To date
|
---|
| 71 | W !!,"Please enter the 'Bill To' date for this charge, which may not precede"
|
---|
| 72 | W !,$$DAT1^IBOUTL(IBFR),", or '^' to quit."
|
---|
| 73 | Q
|
---|
| 74 | ;
|
---|
| 75 | HFEE ; Help for Fee Amount
|
---|
| 76 | W !!,"Please enter the charge for this Fee Service, which may not be greater than"
|
---|
| 77 | W !,"the difference between the Medicare Deductible amount and the "
|
---|
| 78 | W $$INPT^IBECEAU(IBCLDAY)," 90 days",!,"copay billed ($",IBMED-IBCLDOL,"), or '^' to quit."
|
---|
| 79 | Q
|
---|
| 80 | ;
|
---|
| 81 | HAMT ; Help for Charge Amount
|
---|
| 82 | W !!,"Please enter the charge for this copayment."
|
---|
| 83 | Q
|
---|