- IBECEAU2 ;ALB/CPM - Cancel/Edit/Add... User Prompts ; 19-APR-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- REAS(IBX) ; Ask for the cancellation reason.
- ; Input: IBX -- "C" (Cancel a charge), "E" (Edit a Charge)
- S DIC="^IBE(350.3,",DIC(0)="AEMQZ",DIC("A")="Select "_$S(IBX="E":"EDIT",1:"CANCELLATION")_" REASON: "
- S DIC("S")=$S(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)")
- 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."
- Q
- ;
- UNIT(DEF) ; Ask for units for Rx copay charges
- ; Input: DEF -- Default value if previous charge is to be displayed
- N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
- S DA=IBATYP,IBDESC="RX COPAYMENT" D COST^IBAUTL S IBCHG=X1
- S DIR(0)="N^::0^K:X<1!(X>3) X",DIR("A")="Units",DIR("?")="^D HUN^IBECEAU2"
- S:DEF DIR("B")=DEF D ^DIR I Y S IBUNIT=Y,IBCHG=IBCHG*Y
- I 'Y W !!,"Units not entered - transaction cannot be completed." S IBY=-1
- Q
- ;
- FR(DEF) ; Ask Bill From Date
- ; Input: DEF -- Default value if previous charge is to be displayed
- N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
- FRA S:$G(DEF) DIR("B")=$$DAT2^IBOUTL(DEF)
- S DIR(0)="DA^2901001:"_IBLIM_":EX",DIR("A")=$S(IBXA=4:"Visit Date: ",1:"Charge for services from: "),DIR("?")="^D HFR^IBECEAU2"
- D ^DIR K DIR S IBFR=Y I 'Y W !!,$S(IBXA=4:"Visit",1:"Bill From")," Date not entered - transaction cannot be completed." S IBY=-1 G FRQ
- I '$$BIL^DGMTUB(DFN,IBFR+.24) D CATC G FRA
- I IBXA=4,$$BFO^IBECEAU(DFN,IBFR) W !!,"This patient has already been billed the outpatient copay charge for ",$$DAT1^IBOUTL(IBFR),".",! G FRA
- FRQ Q
- ;
- TO(DEF) ; Ask Bill To Date
- ; Input: DEF -- Default value if previous charge is to be displayed
- N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
- TOA S:$G(DEF) DIR("B")=$$DAT2^IBOUTL(DEF)
- S DIR(0)="DA^"_IBFR_":"_IBLIM_":EX",DIR("A")=" Charge for services to: ",DIR("?")="^D HTO^IBECEAU2"
- D ^DIR K DIR S IBTO=Y I 'Y W !!,"Bill To date not entered - transaction cannot be completed." S IBY=-1 G TOQ
- I '$$BIL^DGMTUB(DFN,IBTO+.24) D CATC G TOA
- TOQ Q
- ;
- FEE(DEF) ; Ask for Fee Amount
- ; Input: DEF -- Default value if previous charge is to be displayed
- N DIR,DIRUT,DUOUT,DTOUT,X,Y
- S:$G(DEF) DIR("B")=DEF
- S DIR(0)="NA^::2^K:X<0!(X>(IBMED-IBCLDOL)) X",DIR("A")=" Fee Amount: ",DIR("?")="^D HFEE^IBECEAU2"
- D ^DIR S IBCHG=Y I 'Y W !!,"Charge not entered - transaction cannot be completed." S IBY=-1
- Q
- ;
- CATC ; Display that patient is not Category C.
- W !!,"The patient ",$S(IBFR<DT:"was",1:"is")," not Category C on this date.",!
- Q
- ;
- HUN ; Help for units
- W !!,"Please enter 1, 2, or 3 to denote a 30, 60, or 90 days supply of"
- W !,"medication, or '^' to quit."
- Q
- ;
- HFR ; Help for Bill From date
- W !!,"Please enter the ",$S(IBXA=4:"patient's outpatient visit date",1:"'Bill From' date for this charge"),", which must follow"
- W !,"10/1/90",$S(IBXA'=4:" (and be prior to today)",1:""),", or '^' to quit."
- Q
- ;
- HTO ; Help for Bill To date
- W !!,"Please enter the 'Bill To' date for this charge, which may not precede"
- W !,$$DAT1^IBOUTL(IBFR),", or '^' to quit."
- Q
- ;
- HFEE ; Help for Fee Amount
- W !!,"Please enter the charge for this Fee Service, which may not be greater than"
- W !,"the difference between the Medicare Deductible amount and the "
- W $$INPT^IBECEAU(IBCLDAY)," 90 days",!,"copay billed ($",IBMED-IBCLDOL,"), or '^' to quit."
- Q
- IBECEAU2 ;ALB/CPM - Cancel/Edit/Add... User Prompts ; 19-APR-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- REAS(IBX) ; Ask for the cancellation reason.
- +1 ; Input: IBX -- "C" (Cancel a charge), "E" (Edit a Charge)
- +2 SET DIC="^IBE(350.3,"
- SET DIC(0)="AEMQZ"
- SET DIC("A")="Select "_$SELECT(IBX="E":"EDIT",1:"CANCELLATION")_" REASON: "
- +3 SET DIC("S")=$SELECT(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)")
- +4 DO ^DIC
- KILL DIC
- SET IBCRES=+Y
- IF Y<0
- WRITE !!,"No ",$SELECT(IBX="E":"edit",1:"cancellation")," reason entered - the transaction cannot be completed."
- +5 QUIT
- +6 ;
- UNIT(DEF) ; Ask for units for Rx copay charges
- +1 ; Input: DEF -- Default value if previous charge is to be displayed
- +2 NEW DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
- +3 SET DA=IBATYP
- SET IBDESC="RX COPAYMENT"
- DO COST^IBAUTL
- SET IBCHG=X1
- +4 SET DIR(0)="N^::0^K:X<1!(X>3) X"
- SET DIR("A")="Units"
- SET DIR("?")="^D HUN^IBECEAU2"
- +5 IF DEF
- SET DIR("B")=DEF
- DO ^DIR
- IF Y
- SET IBUNIT=Y
- SET IBCHG=IBCHG*Y
- +6 IF 'Y
- WRITE !!,"Units not entered - transaction cannot be completed."
- SET IBY=-1
- +7 QUIT
- +8 ;
- FR(DEF) ; Ask Bill From Date
- +1 ; Input: DEF -- Default value if previous charge is to be displayed
- +2 NEW DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
- FRA IF $GET(DEF)
- SET DIR("B")=$$DAT2^IBOUTL(DEF)
- +1 SET DIR(0)="DA^2901001:"_IBLIM_":EX"
- SET DIR("A")=$SELECT(IBXA=4:"Visit Date: ",1:"Charge for services from: ")
- SET DIR("?")="^D HFR^IBECEAU2"
- +2 DO ^DIR
- KILL DIR
- SET IBFR=Y
- IF 'Y
- WRITE !!,$SELECT(IBXA=4:"Visit",1:"Bill From")," Date not entered - transaction cannot be completed."
- SET IBY=-1
- GOTO FRQ
- +3 IF '$$BIL^DGMTUB(DFN,IBFR+.24)
- DO CATC
- GOTO FRA
- +4 IF IBXA=4
- IF $$BFO^IBECEAU(DFN,IBFR)
- WRITE !!,"This patient has already been billed the outpatient copay charge for ",$$DAT1^IBOUTL(IBFR),".",!
- GOTO FRA
- FRQ QUIT
- +1 ;
- TO(DEF) ; Ask Bill To Date
- +1 ; Input: DEF -- Default value if previous charge is to be displayed
- +2 NEW DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
- TOA IF $GET(DEF)
- SET DIR("B")=$$DAT2^IBOUTL(DEF)
- +1 SET DIR(0)="DA^"_IBFR_":"_IBLIM_":EX"
- SET DIR("A")=" Charge for services to: "
- SET DIR("?")="^D HTO^IBECEAU2"
- +2 DO ^DIR
- KILL DIR
- SET IBTO=Y
- IF 'Y
- WRITE !!,"Bill To date not entered - transaction cannot be completed."
- SET IBY=-1
- GOTO TOQ
- +3 IF '$$BIL^DGMTUB(DFN,IBTO+.24)
- DO CATC
- GOTO TOA
- TOQ QUIT
- +1 ;
- FEE(DEF) ; Ask for Fee Amount
- +1 ; Input: DEF -- Default value if previous charge is to be displayed
- +2 NEW DIR,DIRUT,DUOUT,DTOUT,X,Y
- +3 IF $GET(DEF)
- SET DIR("B")=DEF
- +4 SET DIR(0)="NA^::2^K:X<0!(X>(IBMED-IBCLDOL)) X"
- SET DIR("A")=" Fee Amount: "
- SET DIR("?")="^D HFEE^IBECEAU2"
- +5 DO ^DIR
- SET IBCHG=Y
- IF 'Y
- WRITE !!,"Charge not entered - transaction cannot be completed."
- SET IBY=-1
- +6 QUIT
- +7 ;
- CATC ; Display that patient is not Category C.
- +1 WRITE !!,"The patient ",$SELECT(IBFR<DT:"was",1:"is")," not Category C on this date.",!
- +2 QUIT
- +3 ;
- HUN ; Help for units
- +1 WRITE !!,"Please enter 1, 2, or 3 to denote a 30, 60, or 90 days supply of"
- +2 WRITE !,"medication, or '^' to quit."
- +3 QUIT
- +4 ;
- HFR ; Help for Bill From date
- +1 WRITE !!,"Please enter the ",$SELECT(IBXA=4:"patient's outpatient visit date",1:"'Bill From' date for this charge"),", which must follow"
- +2 WRITE !,"10/1/90",$SELECT(IBXA'=4:" (and be prior to today)",1:""),", or '^' to quit."
- +3 QUIT
- +4 ;
- HTO ; Help for Bill To date
- +1 WRITE !!,"Please enter the 'Bill To' date for this charge, which may not precede"
- +2 WRITE !,$$DAT1^IBOUTL(IBFR),", or '^' to quit."
- +3 QUIT
- +4 ;
- HFEE ; Help for Fee Amount
- +1 WRITE !!,"Please enter the charge for this Fee Service, which may not be greater than"
- +2 WRITE !,"the difference between the Medicare Deductible amount and the "
- +3 WRITE $$INPT^IBECEAU(IBCLDAY)," 90 days",!,"copay billed ($",IBMED-IBCLDOL,"), or '^' to quit."
- +4 QUIT