IBECEA.m

IBECEA	;ALB/RLW - Cancel/Edit/Add Patient Charges ; 12-JUN-92

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

EN	; Cancel/Edit/Add Patient Charges -- invoke the List Manager.

	I '$$CHECK^IBECEAU(1) G ENQ

	K XQORS,VALMEVL D EN^VALM("IB CHARGES")

ENQ	K IBSITE,IBFAC,IBSERV

	Q

	;

INIT	; List Manager (IB CHARGES) main entry point.

	S IBJOB=4,IBWHER="IBECEA",IBDUZ=DUZ

	S IBACMAR="^TMP(""IBACM"",$J)",IBACMIDX="^TMP(""IBACMIDX"",$J)",VALMIDX="^TMP(""IBCMLIDX"",$J)"

	I '$$SLPT S VALMQUIT="" D FNL G INITQ

	I $$SLDT S VALMQUIT="" D FNL G INITQ

	I $$SLRX S VALMQUIT="" D FNL G INITQ

	D ARRAY^IBECEA0

INITQ	Q

	;

PAT	; 'Change Patient' protocol entry action.

	N IBDFN S IBDFN=DFN

	I '$$SLPT D MSG S DFN=IBDFN G PATQ

DATE	; 'Change Date' protocol entry action.

	N IBDT1,IBDT2,IBRXXX S IBDT1=IBABEG,IBDT2=IBAEND,IBRXXX=IBRX

	I $$SLDT D MSG S IBABEG=IBDT1,IBAEND=IBDT2 S:$D(IBDFN) DFN=IBDFN G PATQ

	I $$SLRX D MSG S IBABEG=IBDT1,IBAEND=IBDT2,IBRX=IBRXXX S:$D(IBDFN) DFN=IBDFN G PATQ

	D ARRAY^IBECEA0,HDR S VALMBCK="R"

PATQ	Q

	;

MSG	; Quick message display.

	N DIR,DIRUT,DUOUT,DTOUT,X,Y

	W !!,*7,"No changes were made!",!

	S DIR(0)="E" D ^DIR S VALMBCK=""

	Q

	;

HDR	; Build screen header.

	S IBNAM=$$PT^IBEFUNC(DFN)

	S VALMHDR(1)=$$SETSTR^VALM1($$FDATE^VALM1(IBABEG)_" THRU "_$$FDATE^VALM1(IBAEND),"Cancel/Edit/Add Charges",59,22)

	S VALMHDR(2)=$E("Patient: "_$P(IBNAM,"^"),1,25)_" "_$E(IBNAM)_$P(IBNAM,"^",3)

	Q

	;

SLPT()	; Select a patient.

	N DIC,X,Y

	S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC S DFN=+Y

	Q Y>0

	;

SLDT()	; Select Charge dates.

	N DIR,DIRUT,DUOUT,DTOUT,X,Y

	S DIR(0)="DA^2860101:NOW:EX",DIR("A")="Search for CHARGES from: ",DIR("B")=$$DAT2^IBOUTL($$FMADD^XLFDT(DT,-365)) D ^DIR S IBABEG=+Y G:'Y SLDTQ

	S DIR(0)="DA^"_+Y_":NOW:EX",DIR("A")="                     to: ",DIR("B")=$$DAT2^IBOUTL(DT) D ^DIR S IBAEND=+Y+.999999

SLDTQ	Q $D(DIRUT)!($D(DUOUT))

	;

SLRX()	; Include Rx copay charges?

	N DIR,DIRUT,DUOUT,DTOUT,X,Y

	S DIR(0)="Y",DIR("A")="Include RX COPAY charges",DIR("B")="NO" D ^DIR S IBRX=Y

	Q $D(DIRUT)!($D(DUOUT))

	;

FNL	; List Manager (IB CHARGES) exit action.

	K:$D(IBACMAR) @IBACMAR,IBACMAR K:$D(IBACMIDX) @IBACMIDX,IBACMIDX K:$D(VALMIDX) @VALMIDX,VALMIDX

	K IBABEG,IBAEND,DFN,IBAT,IBAX,IBY,VA,IBRX,IBWHER,X,^TMP("IBECEA",$J),^TMP("IBCMLIDX",$J),DFN,IBSAVY,IBARTYP,IBPRNT,IBDUZ,IBJOB,IBXA,IBNOW,IBLDT,IBL,IBIL,IBNAM

	Q

	;

EXIT	Q

IBECEA    ;ALB/RLW - Cancel/Edit/Add Patient Charges ; 12-JUN-92

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

EN        ; Cancel/Edit/Add Patient Charges -- invoke the List Manager.

 +1        IF '$$CHECK^IBECEAU(1)

               GOTO ENQ

 +2        KILL XQORS,VALMEVL

           DO EN^VALM("IB CHARGES")

ENQ        KILL IBSITE,IBFAC,IBSERV

 +1        QUIT 

 +2       ;

INIT      ; List Manager (IB CHARGES) main entry point.

 +1        SET IBJOB=4

           SET IBWHER="IBECEA"

           SET IBDUZ=DUZ

 +2        SET IBACMAR="^TMP(""IBACM"",$J)"

           SET IBACMIDX="^TMP(""IBACMIDX"",$J)"

           SET VALMIDX="^TMP(""IBCMLIDX"",$J)"

 +3        IF '$$SLPT

               SET VALMQUIT=""

               DO FNL

               GOTO INITQ

 +4        IF $$SLDT

               SET VALMQUIT=""

               DO FNL

               GOTO INITQ

 +5        IF $$SLRX

               SET VALMQUIT=""

               DO FNL

               GOTO INITQ

 +6        DO ARRAY^IBECEA0

INITQ      QUIT 

 +1       ;

PAT       ; 'Change Patient' protocol entry action.

 +1        NEW IBDFN

           SET IBDFN=DFN

 +2        IF '$$SLPT

               DO MSG

               SET DFN=IBDFN

               GOTO PATQ

DATE      ; 'Change Date' protocol entry action.

 +1        NEW IBDT1,IBDT2,IBRXXX

           SET IBDT1=IBABEG

           SET IBDT2=IBAEND

           SET IBRXXX=IBRX

 +2        IF $$SLDT

               DO MSG

               SET IBABEG=IBDT1

               SET IBAEND=IBDT2

               IF $DATA(IBDFN)

                   SET DFN=IBDFN

               GOTO PATQ

 +3        IF $$SLRX

               DO MSG

               SET IBABEG=IBDT1

               SET IBAEND=IBDT2

               SET IBRX=IBRXXX

               IF $DATA(IBDFN)

                   SET DFN=IBDFN

               GOTO PATQ

 +4        DO ARRAY^IBECEA0

           DO HDR

           SET VALMBCK="R"

PATQ       QUIT 

 +1       ;

MSG       ; Quick message display.

 +1        NEW DIR,DIRUT,DUOUT,DTOUT,X,Y

 +2        WRITE !!,*7,"No changes were made!",!

 +3        SET DIR(0)="E"

           DO ^DIR

           SET VALMBCK=""

 +4        QUIT 

 +5       ;

HDR       ; Build screen header.

 +1        SET IBNAM=$$PT^IBEFUNC(DFN)

 +2        SET VALMHDR(1)=$$SETSTR^VALM1($$FDATE^VALM1(IBABEG)_" THRU "_$$FDATE^VALM1(IBAEND),"Cancel/Edit/Add Charges",59,22)

 +3        SET VALMHDR(2)=$EXTRACT("Patient: "_$PIECE(IBNAM,"^"),1,25)_" "_$EXTRACT(IBNAM)_$PIECE(IBNAM,"^",3)

 +4        QUIT 

 +5       ;

SLPT()    ; Select a patient.

 +1        NEW DIC,X,Y

 +2        SET DIC="^DPT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           SET DFN=+Y

 +3        QUIT Y>0

 +4       ;

SLDT()    ; Select Charge dates.

 +1        NEW DIR,DIRUT,DUOUT,DTOUT,X,Y

 +2        SET DIR(0)="DA^2860101:NOW:EX"

           SET DIR("A")="Search for CHARGES from: "

           SET DIR("B")=$$DAT2^IBOUTL($$FMADD^XLFDT(DT,-365))

           DO ^DIR

           SET IBABEG=+Y

           IF 'Y

               GOTO SLDTQ

 +3        SET DIR(0)="DA^"_+Y_":NOW:EX"

           SET DIR("A")="                     to: "

           SET DIR("B")=$$DAT2^IBOUTL(DT)

           DO ^DIR

           SET IBAEND=+Y+.999999

SLDTQ      QUIT $DATA(DIRUT)!($DATA(DUOUT))

 +1       ;

SLRX()    ; Include Rx copay charges?

 +1        NEW DIR,DIRUT,DUOUT,DTOUT,X,Y

 +2        SET DIR(0)="Y"

           SET DIR("A")="Include RX COPAY charges"

           SET DIR("B")="NO"

           DO ^DIR

           SET IBRX=Y

 +3        QUIT $DATA(DIRUT)!($DATA(DUOUT))

 +4       ;

FNL       ; List Manager (IB CHARGES) exit action.

 +1        IF $DATA(IBACMAR)

               KILL @IBACMAR,IBACMAR

           IF $DATA(IBACMIDX)

               KILL @IBACMIDX,IBACMIDX

           IF $DATA(VALMIDX)

               KILL @VALMIDX,VALMIDX

 +2        KILL IBABEG,IBAEND,DFN,IBAT,IBAX,IBY,VA,IBRX,IBWHER,X,^TMP("IBECEA",$JOB),^TMP("IBCMLIDX",$JOB),DFN,IBSAVY,IBARTYP,IBPRNT,IBDUZ,IBJOB,IBXA,IBNOW,IBLDT,IBL,IBIL,IBNAM

 +3        QUIT 

 +4       ;

EXIT       QUIT