IBECEA5.m

IBECEA5	;ALB/CPM - Cancel/Edit/Add... Update Events ; 05-MAY-93

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

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

	;

EN	; Update Events -- invoke the List Manager.

	N VALMIDX,VALMHDR

	D EN^VALM("IB EVENTS")

	Q

	;

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

	N IBAX,IBD,IBN,IBND,IBSTAT,IBLAST,IBWARD

	S IBACME="^TMP(""IBACME"",$J)",IBACMEI="^TMP(""IBACMEI"",$J)",IBD=""

	S VALMIDX="^TMP(""IBACMLI"",$J)",VALMBG=1,VALMCNT=0,VALMBCK="R"

	K @IBACME,@IBACMEI,@VALMIDX

	F  S IBD=$O(^IB("AFDT",DFN,IBD)) Q:'IBD  D

	.S IBN=0 F  S IBN=$O(^IB("AFDT",DFN,IBD,IBN)) Q:'IBN  D

	..S IBND=$G(^IB(IBN,0)) Q:$P(IBND,"^",8)'["ADMISSION"

	..S IBSTAT=$S($P(IBND,"^",5)=1:"OPEN",1:"CLOSED"),IBLAST=$P(IBND,"^",18)

	..S Y=+$P($P(IBND,"^",4),":",2),Y=+$P($G(^DGPM(Y,0)),"^",6),Y=$E($P($G(^DIC(42,Y,0)),"^"),1,20)

	..S VALMCNT=VALMCNT+1,IBWARD=$S(Y]"":Y,1:"*** unknown ***")

	..S IBAX=$$SETSTR^VALM1($P(IBND,"^",8),VALMCNT,+$P(VALMDDF("TYPE"),"^",2),+$P(VALMDDF("TYPE"),"^",3))

	..S IBAX=$$SETSTR^VALM1(IBWARD,IBAX,+$P(VALMDDF("WARD"),"^",2),+$P(VALMDDF("WARD"),"^",3))

	..S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P(IBND,"^",17)),IBAX,+$P(VALMDDF("EDATE"),"^",2),+$P(VALMDDF("EDATE"),"^",3))

	..S IBAX=$$SETSTR^VALM1(IBSTAT,IBAX,+$P(VALMDDF("STATUS"),"^",2),+$P(VALMDDF("STATUS"),"^",3))

	..S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL(IBLAST),IBAX,+$P(VALMDDF("LCALC"),"^",2),+$P(VALMDDF("LCALC"),"^",3))

	..S @IBACME@(VALMCNT,0)=IBAX,@IBACME@("IDX",VALMCNT,VALMCNT)="",@VALMIDX@(VALMCNT)=VALMCNT

	..S @IBACMEI@(VALMCNT)=IBSTAT_"^"_IBLAST_"^"_IBN_"^"_$P(IBND,"^",17)

	I '$O(@IBACME@(0)) S @IBACME@(1,0)=" ",@IBACME@(2,0)="  This patient has no inpatient event records stored in Billing.",VALMCNT=2,@VALMIDX@(1)=1,@VALMIDX@(2)=2

	Q

	;

HDR	; Build screen header.

	S VALMHDR(1)=$$SETSTR^VALM1("Update Billable Events","Cancel/Edit/Add Charges",59,22)

	S VALMHDR(2)=$$SETSTR^VALM1("Date Charges",$E("Patient: "_$P(IBNAM,"^"),1,25)_" "_$E(IBNAM)_$P(IBNAM,"^",3),68,12)

	Q

	;

EXIT	; List Manager (IB EVENTS) exit action.

	K:$D(IBACME) @IBACME K:$D(IBACMEI) IBACMEI

	K IBACME,IBACMEI

	D FULL^VALM1,CLEAN^VALM10

	;D CLEAN^VALM10,CLEAR^VALM1

	Q

IBECEA5   ;ALB/CPM - Cancel/Edit/Add... Update Events ; 05-MAY-93

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

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

 +3       ;

EN        ; Update Events -- invoke the List Manager.

 +1        NEW VALMIDX,VALMHDR

 +2        DO EN^VALM("IB EVENTS")

 +3        QUIT 

 +4       ;

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

 +1        NEW IBAX,IBD,IBN,IBND,IBSTAT,IBLAST,IBWARD

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

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

           SET IBD=""

 +3        SET VALMIDX="^TMP(""IBACMLI"",$J)"

           SET VALMBG=1

           SET VALMCNT=0

           SET VALMBCK="R"

 +4        KILL @IBACME,@IBACMEI,@VALMIDX

 +5        FOR 

               SET IBD=$ORDER(^IB("AFDT",DFN,IBD))

               IF 'IBD

                   QUIT 

               Begin DoDot:1

 +6                SET IBN=0

                   FOR 

                       SET IBN=$ORDER(^IB("AFDT",DFN,IBD,IBN))

                       IF 'IBN

                           QUIT 

                       Begin DoDot:2

 +7                        SET IBND=$GET(^IB(IBN,0))

                           IF $PIECE(IBND,"^",8)'["ADMISSION"

                               QUIT 

 +8                        SET IBSTAT=$SELECT($PIECE(IBND,"^",5)=1:"OPEN",1:"CLOSED")

                           SET IBLAST=$PIECE(IBND,"^",18)

 +9                        SET Y=+$PIECE($PIECE(IBND,"^",4),":",2)

                           SET Y=+$PIECE($GET(^DGPM(Y,0)),"^",6)

                           SET Y=$EXTRACT($PIECE($GET(^DIC(42,Y,0)),"^"),1,20)

 +10                       SET VALMCNT=VALMCNT+1

                           SET IBWARD=$SELECT(Y]"":Y,1:"*** unknown ***")

 +11                       SET IBAX=$$SETSTR^VALM1($PIECE(IBND,"^",8),VALMCNT,+$PIECE(VALMDDF("TYPE"),"^",2),+$PIECE(VALMDDF("TYPE"),"^",3))

 +12                       SET IBAX=$$SETSTR^VALM1(IBWARD,IBAX,+$PIECE(VALMDDF("WARD"),"^",2),+$PIECE(VALMDDF("WARD"),"^",3))

 +13                       SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($PIECE(IBND,"^",17)),IBAX,+$PIECE(VALMDDF("EDATE"),"^",2),+$PIECE(VALMDDF("EDATE"),"^",3))

 +14                       SET IBAX=$$SETSTR^VALM1(IBSTAT,IBAX,+$PIECE(VALMDDF("STATUS"),"^",2),+$PIECE(VALMDDF("STATUS"),"^",3))

 +15                       SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL(IBLAST),IBAX,+$PIECE(VALMDDF("LCALC"),"^",2),+$PIECE(VALMDDF("LCALC"),"^",3))

 +16                       SET @IBACME@(VALMCNT,0)=IBAX

                           SET @IBACME@("IDX",VALMCNT,VALMCNT)=""

                           SET @VALMIDX@(VALMCNT)=VALMCNT

 +17                       SET @IBACMEI@(VALMCNT)=IBSTAT_"^"_IBLAST_"^"_IBN_"^"_$PIECE(IBND,"^",17)

                       End DoDot:2

               End DoDot:1

 +18       IF '$ORDER(@IBACME@(0))

               SET @IBACME@(1,0)=" "

               SET @IBACME@(2,0)="  This patient has no inpatient event records stored in Billing."

               SET VALMCNT=2

               SET @VALMIDX@(1)=1

               SET @VALMIDX@(2)=2

 +19       QUIT 

 +20      ;

HDR       ; Build screen header.

 +1        SET VALMHDR(1)=$$SETSTR^VALM1("Update Billable Events","Cancel/Edit/Add Charges",59,22)

 +2        SET VALMHDR(2)=$$SETSTR^VALM1("Date Charges",$EXTRACT("Patient: "_$PIECE(IBNAM,"^"),1,25)_" "_$EXTRACT(IBNAM)_$PIECE(IBNAM,"^",3),68,12)

 +3        QUIT 

 +4       ;

EXIT      ; List Manager (IB EVENTS) exit action.

 +1        IF $DATA(IBACME)

               KILL @IBACME

           IF $DATA(IBACMEI)

               KILL IBACMEI

 +2        KILL IBACME,IBACMEI

 +3        DO FULL^VALM1

           DO CLEAN^VALM10

 +4       ;D CLEAN^VALM10,CLEAR^VALM1

 +5        QUIT