IBECEAU2.m

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