IBAMTD1 ;ALB/CPM-MOVEMENT EVENT DRIVER INTERFACE (CON'T) ;21-OCT-91
;;2.0;INTEGRATED BILLING;**45,153,179,183,202**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; Create charges for one-day admissions
; Input: DFN, DGPMA, IBDT, IBBS, IBCLDA
; IBCLCT/IBCLDAY/IBCLDOL/IBCLDT (if IBCLDA'=0)
;
; - quit if patient is not a Means Test patient at discharge
G:'$$BIL^DGMTUB(DFN,+DGPMA) END
N IBGMT,IBGMTR,IBGMTEFD
S IBGMT=$$ISGMTPT^IBAGMT(DFN,+DGPMA),IBGMTR=0
S IBGMTEFD=$$GMTEFD^IBAGMT()
; - handle clock
I $D(IBCLDT),IBCLDT>IBDT S IBY="-1^IB034" G END
I IBCLDA D COUNT^IBAMTD S IBCLCT=IBCLCT+1 I IBCLCT>365 S IBWHER=2 D CLOCKCL^IBAUTL3 G:IBY<1 END S IBCLDA=0
I 'IBCLDA S IBCLDT=IBDT,IBWHER=7 D CLADD^IBAUTL3 G:IBY<1 END S IBCLCT=1,(IBCLDAY,IBCLDOL)=0
; - build event
S IBNH=$P($G(^DGCR(399.1,IBBS,0)),"^")["NURSING",IBSL="405:"_$P(DGPMA,"^",14),IBEVDT=IBDT,IBWHER=6
D EVADD^IBAUTL3 G:IBY<1 END
S IBCLDAY=IBCLDAY+1
; - cancel any OPT charges
D OPT(DFN,IBDT)
; - process per diem
G:IBDT<$$DIEM^IBAUTL5 COPAY
S IBX="P",IBWHER=8 D TYPE^IBAUTL2 G:IBY<1 END
;If the patient has GMT Status, and the Action Type is MT Inpt (must be), then reduce the charge
S IBGMTR=0 I IBGMT>0,DGPMA'<IBGMTEFD,$$ISGMTTYP^IBAGMT(IBATYP) S IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) ;GMT Charge Adjustment
S IBWHER=13 D CHADD^IBAUTL2 G:IBY<1 END
S IBNOS=IBN,IBWHER=26 D FILER^IBAUTL5 G:IBY<1 END
COPAY ; - process co-payment
G:IBCLDAY>360 LAST
I IBCLDAY>1,IBCLDAY#90=1 S IBCLDOL=0
S IBMAX=IBMED
I IBGMT>0,DGPMA'<IBGMTEFD S IBMAX=$$REDUCE^IBAGMT(IBMAX) ;GMT Adjustment of Medicare Deductible
I IBCLDAY>90,'IBNH S IBMAX=IBMAX/2
G:IBCLDOL'<IBMAX LAST
S IBWHER=14 D COPAY^IBAUTL2 G:IBY<1 END
;If the patient has GMT Status, then reduce the charge
S IBGMTR=0 I IBGMT>0,DGPMA'<IBGMTEFD S IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG)
S IBCHARG=IBMAX-IBCLDOL I IBCHG<IBCHARG S IBCHARG=IBCHG
S IBCHG=IBCHARG S:IBCHG<0 IBCHG=0
S IBCLDOL=IBCLDOL+IBCHG
S IBWHER=18 D CHADD^IBAUTL2 G:IBY<1 END
S IBNOS=IBN,IBWHER=27 D FILER^IBAUTL5 G:IBY<1 END
LAST ; - close event, update billing clock
S IBWHER=23,IBEVCLD=IBDT D EVCLOSE^IBAUTL3,CLUPD^IBAUTL3,CLOCKCL^IBAUTL3:IBCLCT>364
END Q
;
;
UNFLAG ; Unflag continuous patient, if not transferring from the facility.
N TRAN S TRAN=$P(DGPMA,"^",18)=10
I 'TRAN!(IBASIH) W:'$G(DGQUIET) !,"Unflagging patient as continuous since 7/1/86..." D
. D NOW^%DTC S DIE="^IBE(351.1,",DA=+$O(^IBE(351.1,"B",DFN,0))
. S DR=".02////"_$P(+DGPMA,".")_";.05////"_DUZ_";.06////"_% D ^DIE K DIE,DA,DR
. W:'$G(DGQUIET) "completed."
; - send bulletin to Means Test Billing mailgroup, if patient did not die.
I $P($G(^DG(405.1,+$P(DGPMA,"^",4),0)),"^")'["DEATH" D CTPT^IBAMTBU
Q
;
OPT(DFN,IBDATE) ; Cancel any OPT charges on days billed for inpatient care.
; Input: DFN -- Pointer to patient in file #2
; IBDATE -- Date to check for OPT charges
N IBN,IBCRES,IBDUZ S IBDUZ=DUZ
S IBN=$$BFO^IBECEAU(DFN,IBDATE) I 'IBN G OPTQ
S IBCRES=$O(^IBE(350.3,"B","RECD INPATIENT CARE",0))
S:'IBCRES IBCRES=25
D CANCH^IBECEAU4(IBN,IBCRES)
OPTQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTD1 3185 printed Apr 09, 2024@21:30:22 Page 2
IBAMTD1 ;ALB/CPM-MOVEMENT EVENT DRIVER INTERFACE (CON'T) ;21-OCT-91
+1 ;;2.0;INTEGRATED BILLING;**45,153,179,183,202**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; Create charges for one-day admissions
+1 ; Input: DFN, DGPMA, IBDT, IBBS, IBCLDA
+2 ; IBCLCT/IBCLDAY/IBCLDOL/IBCLDT (if IBCLDA'=0)
+3 ;
+4 ; - quit if patient is not a Means Test patient at discharge
+5 if '$$BIL^DGMTUB(DFN,+DGPMA)
GOTO END
+6 NEW IBGMT,IBGMTR,IBGMTEFD
+7 SET IBGMT=$$ISGMTPT^IBAGMT(DFN,+DGPMA)
SET IBGMTR=0
+8 SET IBGMTEFD=$$GMTEFD^IBAGMT()
+9 ; - handle clock
+10 IF $DATA(IBCLDT)
IF IBCLDT>IBDT
SET IBY="-1^IB034"
GOTO END
+11 IF IBCLDA
DO COUNT^IBAMTD
SET IBCLCT=IBCLCT+1
IF IBCLCT>365
SET IBWHER=2
DO CLOCKCL^IBAUTL3
if IBY<1
GOTO END
SET IBCLDA=0
+12 IF 'IBCLDA
SET IBCLDT=IBDT
SET IBWHER=7
DO CLADD^IBAUTL3
if IBY<1
GOTO END
SET IBCLCT=1
SET (IBCLDAY,IBCLDOL)=0
+13 ; - build event
+14 SET IBNH=$PIECE($GET(^DGCR(399.1,IBBS,0)),"^")["NURSING"
SET IBSL="405:"_$PIECE(DGPMA,"^",14)
SET IBEVDT=IBDT
SET IBWHER=6
+15 DO EVADD^IBAUTL3
if IBY<1
GOTO END
+16 SET IBCLDAY=IBCLDAY+1
+17 ; - cancel any OPT charges
+18 DO OPT(DFN,IBDT)
+19 ; - process per diem
+20 if IBDT<$$DIEM^IBAUTL5
GOTO COPAY
+21 SET IBX="P"
SET IBWHER=8
DO TYPE^IBAUTL2
if IBY<1
GOTO END
+22 ;If the patient has GMT Status, and the Action Type is MT Inpt (must be), then reduce the charge
+23 ;GMT Charge Adjustment
SET IBGMTR=0
IF IBGMT>0
IF DGPMA'<IBGMTEFD
IF $$ISGMTTYP^IBAGMT(IBATYP)
SET IBGMTR=1
SET IBCHG=$$REDUCE^IBAGMT(IBCHG)
+24 SET IBWHER=13
DO CHADD^IBAUTL2
if IBY<1
GOTO END
+25 SET IBNOS=IBN
SET IBWHER=26
DO FILER^IBAUTL5
if IBY<1
GOTO END
COPAY ; - process co-payment
+1 if IBCLDAY>360
GOTO LAST
+2 IF IBCLDAY>1
IF IBCLDAY#90=1
SET IBCLDOL=0
+3 SET IBMAX=IBMED
+4 ;GMT Adjustment of Medicare Deductible
IF IBGMT>0
IF DGPMA'<IBGMTEFD
SET IBMAX=$$REDUCE^IBAGMT(IBMAX)
+5 IF IBCLDAY>90
IF 'IBNH
SET IBMAX=IBMAX/2
+6 if IBCLDOL'<IBMAX
GOTO LAST
+7 SET IBWHER=14
DO COPAY^IBAUTL2
if IBY<1
GOTO END
+8 ;If the patient has GMT Status, then reduce the charge
+9 SET IBGMTR=0
IF IBGMT>0
IF DGPMA'<IBGMTEFD
SET IBGMTR=1
SET IBCHG=$$REDUCE^IBAGMT(IBCHG)
+10 SET IBCHARG=IBMAX-IBCLDOL
IF IBCHG<IBCHARG
SET IBCHARG=IBCHG
+11 SET IBCHG=IBCHARG
if IBCHG<0
SET IBCHG=0
+12 SET IBCLDOL=IBCLDOL+IBCHG
+13 SET IBWHER=18
DO CHADD^IBAUTL2
if IBY<1
GOTO END
+14 SET IBNOS=IBN
SET IBWHER=27
DO FILER^IBAUTL5
if IBY<1
GOTO END
LAST ; - close event, update billing clock
+1 SET IBWHER=23
SET IBEVCLD=IBDT
DO EVCLOSE^IBAUTL3
DO CLUPD^IBAUTL3
if IBCLCT>364
DO CLOCKCL^IBAUTL3
END QUIT
+1 ;
+2 ;
UNFLAG ; Unflag continuous patient, if not transferring from the facility.
+1 NEW TRAN
SET TRAN=$PIECE(DGPMA,"^",18)=10
+2 IF 'TRAN!(IBASIH)
if '$GET(DGQUIET)
WRITE !,"Unflagging patient as continuous since 7/1/86..."
Begin DoDot:1
+3 DO NOW^%DTC
SET DIE="^IBE(351.1,"
SET DA=+$ORDER(^IBE(351.1,"B",DFN,0))
+4 SET DR=".02////"_$PIECE(+DGPMA,".")_";.05////"_DUZ_";.06////"_%
DO ^DIE
KILL DIE,DA,DR
+5 if '$GET(DGQUIET)
WRITE "completed."
End DoDot:1
+6 ; - send bulletin to Means Test Billing mailgroup, if patient did not die.
+7 IF $PIECE($GET(^DG(405.1,+$PIECE(DGPMA,"^",4),0)),"^")'["DEATH"
DO CTPT^IBAMTBU
+8 QUIT
+9 ;
OPT(DFN,IBDATE) ; Cancel any OPT charges on days billed for inpatient care.
+1 ; Input: DFN -- Pointer to patient in file #2
+2 ; IBDATE -- Date to check for OPT charges
+3 NEW IBN,IBCRES,IBDUZ
SET IBDUZ=DUZ
+4 SET IBN=$$BFO^IBECEAU(DFN,IBDATE)
IF 'IBN
GOTO OPTQ
+5 SET IBCRES=$ORDER(^IBE(350.3,"B","RECD INPATIENT CARE",0))
+6 if 'IBCRES
SET IBCRES=25
+7 DO CANCH^IBECEAU4(IBN,IBCRES)
OPTQ QUIT
