IBACVA.m

IBACVA	;ALB/CPM - PROCESS CHAMPVA PATIENT MOVEMENTS ; 27-JUL-93

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

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

	;

PROC	; Process patient movements for CHAMPVA inpatients.

	;

	; - quit if the software is not fully installed

	I '$$ON^IBACVA2() G PROCQ

	;

	; - send bulletin for CHAMPVA admissions

	I DGPMP="",$P(DGPMA,"^",2)=1 D ADM^IBACVA2 G PROCQ

	;

	; - determine if admission has been billed

	S IBCVAPM=$P($S(DGPMA:DGPMA,1:DGPMP),"^",14)

	S IBCVA=$P(+$G(^DGPM(IBCVAPM,0)),".")

	S IBBILLED=$$PREV^IBACVA1(DFN,IBCVA,IBCVAPM)

	;

	; - if admission was deleted, cancel the charge (if billed)

	I DGPMA="",$P(DGPMP,"^",2)=1 G:'IBBILLED PROCQ D  G PROCQ

	.S IBCRES=$O(^IBE(350.3,"B","CHAMPVA ADMISSION DELETED",0))

	.S:'IBCRES IBCRES=24

	.D CANCH^IBECEAU4(IBBILLED,IBCRES,0,1)

	;

	; - if delete a discharge -> bulletin

	I DGPMA="",$P(DGPMP,"^",2)=3 D WARN^IBACVA2 G PROCQ

	;

	; - if edit a discharge, change date -> bulletin

	I DGPMA,DGPMP,$P(DGPMA,"^",2)=3,$P(+DGPMA,".")'=$P(+DGPMP,".") D WARN^IBACVA2(+DGPMP,+DGPMA) G PROCQ

	;

	; - if discharged, bill the subsistence charge

	I DGPMP="",$P(DGPMA,"^",2)=3,'IBBILLED D

	.S IBSL=IBCVAPM,IBBDT=$$FMTH^XLFDT(IBCVA,1),IBEDT=$$FMTH^XLFDT(+DGPMA\1,1)

	.D BILL^IBACVA1

	;

PROCQ	K IBY,IBFAC,IBSITE,IBSERV,IBSL,IBCHGT,IBBILLED,IBBDT,IBEDT,IBD,IBDT

	K IBCHG,IBFR,IBTO,IBATYP,IBLIM,IBN,IBUNIT,IBCVA,IBBILLED,IBCVAPM

	K %H,VA,VAIP,VAERR,X

	Q

IBACVA    ;ALB/CPM - PROCESS CHAMPVA PATIENT MOVEMENTS ; 27-JUL-93

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

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

 +3       ;

PROC      ; Process patient movements for CHAMPVA inpatients.

 +1       ;

 +2       ; - quit if the software is not fully installed

 +3        IF '$$ON^IBACVA2()

               GOTO PROCQ

 +4       ;

 +5       ; - send bulletin for CHAMPVA admissions

 +6        IF DGPMP=""

               IF $PIECE(DGPMA,"^",2)=1

                   DO ADM^IBACVA2

                   GOTO PROCQ

 +7       ;

 +8       ; - determine if admission has been billed

 +9        SET IBCVAPM=$PIECE($SELECT(DGPMA:DGPMA,1:DGPMP),"^",14)

 +10       SET IBCVA=$PIECE(+$GET(^DGPM(IBCVAPM,0)),".")

 +11       SET IBBILLED=$$PREV^IBACVA1(DFN,IBCVA,IBCVAPM)

 +12      ;

 +13      ; - if admission was deleted, cancel the charge (if billed)

 +14       IF DGPMA=""

               IF $PIECE(DGPMP,"^",2)=1

                   IF 'IBBILLED

                       GOTO PROCQ

                   Begin DoDot:1

 +15                   SET IBCRES=$ORDER(^IBE(350.3,"B","CHAMPVA ADMISSION DELETED",0))

 +16                   IF 'IBCRES

                           SET IBCRES=24

 +17                   DO CANCH^IBECEAU4(IBBILLED,IBCRES,0,1)

                   End DoDot:1

                   GOTO PROCQ

 +18      ;

 +19      ; - if delete a discharge -> bulletin

 +20       IF DGPMA=""

               IF $PIECE(DGPMP,"^",2)=3

                   DO WARN^IBACVA2

                   GOTO PROCQ

 +21      ;

 +22      ; - if edit a discharge, change date -> bulletin

 +23       IF DGPMA

               IF DGPMP

                   IF $PIECE(DGPMA,"^",2)=3

                       IF $PIECE(+DGPMA,".")'=$PIECE(+DGPMP,".")

                           DO WARN^IBACVA2(+DGPMP,+DGPMA)

                           GOTO PROCQ

 +24      ;

 +25      ; - if discharged, bill the subsistence charge

 +26       IF DGPMP=""

               IF $PIECE(DGPMA,"^",2)=3

                   IF 'IBBILLED

                       Begin DoDot:1

 +27                       SET IBSL=IBCVAPM

                           SET IBBDT=$$FMTH^XLFDT(IBCVA,1)

                           SET IBEDT=$$FMTH^XLFDT(+DGPMA\1,1)

 +28                       DO BILL^IBACVA1

                       End DoDot:1

 +29      ;

PROCQ      KILL IBY,IBFAC,IBSITE,IBSERV,IBSL,IBCHGT,IBBILLED,IBBDT,IBEDT,IBD,IBDT

 +1        KILL IBCHG,IBFR,IBTO,IBATYP,IBLIM,IBN,IBUNIT,IBCVA,IBBILLED,IBCVAPM

 +2        KILL %H,VA,VAIP,VAERR,X

 +3        QUIT