IBAMTI1 ;ALB/CPM - SPECIAL INPATIENT BILLING CASES (CON'T.) ; 11-AUG-93
;;2.0;INTEGRATED BILLING;**52,132,156,199,234,339**;21-MAR-94;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
DISP ; Manually disposition a case record.
W !!,"This option is used to disposition case records for special inpatient"
W !,"episodes of care which are not to be billed. (AO/IR/SWA/SC/MST/HNC/CV/SHAD)"
W !,"After identifying the case, please enter the reason (up to 80 characters)"
W !,"for non-billing."
;
; - main processing loop
S IBQ=0 F W ! D SEL Q:IBQ
K IBQ
Q
;
SEL ; Select an inpatient billing case and enter the reason for non-billing.
S DIC="^IBE(351.2,",DIC(0)="QEAMZ",DIC("A")="Select PATIENT: "
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
D ^DIC S IBC=+Y I Y<0 S IBQ=1 G SELQ
I $P(Y(0),"^",5)=1 W !!,"You must wait until this patient has been discharged to disposition the case." G SELQ
I $P(Y(0),"^",4) S IBBILLED=1 W !!,"Please note that it appears as if this case has been billed."
I $P(Y(0),"^",8) W !!,"Please note that this case has already been dispositioned."
;
; - display case record
W ! D DSPL(IBC)
;
; - allow user update of record
S IBHC=$P(Y(0),"^",7),IBHR=$G(^IBE(351.2,IBC,1))
S DIE="^IBE(351.2,",DA=IBC,DR=$S($G(IBBILLED):".07;",1:"")_1 D ^DIE
;
S IBNC=$P(^IBE(351.2,IBC,0),"^",7),IBNR=$G(^IBE(351.2,IBC,1))
I IBHC=IBNC,IBHR=IBNR W !!,"No changes made to the case record!" G SELQ
I IBNR]"" W !!,"This case record will be dispositioned."
S DR="2.03////"_DUZ_";2.04///NOW"
I IBNR]"" S DR=".07////1;.08////1;"_DR
S DIE="^IBE(351.2,",DA=IBC D ^DIE
SELQ K DA,DIC,DIE,DR,IBC,IBHC,IBHR,IBNC,IBNR,IBBILLED
Q
;
CEA(IBPM,IBEVT) ; Automatically disposition the case from Cancel/Edit/Add.
; Input: IBPM -- Pointer to the adm movement in file #405
; IBEVT -- Pointer to the billing event record in file #350
I '$G(IBEVT) G CEAQ
N DA,DIE,DR,IBC
S IBC=$O(^IBE(351.2,"AC",+$G(IBPM),0)) I IBC D UPD(0)
CEAQ Q
;
CHK(IBC,IBEVT) ; Review the case after adding a charge from Cancel/Edit/Add.
; Input: IBC -- Pointer to the case in file #351.2
; IBEVT -- Pointer to the billing event record in file #350
I '$G(IBC)!'$G(IBEVT) G CHKQ
N DA,DIE,DR,IBCD,IBCD1
S IBCD=$G(^IBE(351.2,IBC,0)),IBCD1=$G(^(1))
I $P(IBCD,"^",7)!'$P(IBCD,"^",8)!(IBCD1]"") D UPD(1)
CHKQ Q
;
UPD(IND) ; Disposition the case record.
; Input: IND -- 0 = dispositioning | 1 = reviewing
; variables -- IBC => ptr to case record
; IBEVT => ptr to event record in #350
W !,"Dispositioning the special inpatient billing case record"
W:$G(IND) " (as billable)" W "..."
K ^IBE(351.2,IBC,1)
S DR=".04////"_IBEVT_";.07////0;.08////1;2.03////"_DUZ_";2.04///NOW"
S DIE="^IBE(351.2,",DA=IBC D ^DIE W " done."
Q
;
DSPL(IBC) ; Display a case record.
; Input: IBC -- Pointer to the case record in file #351.2
I '$G(IBC) G DSPLQ
N DFN,IBCD,IBC1,IBC2,IBATYP,IBPT,IBDIS,IBCL,IBEVT,IBN,IBND,Y
S IBCD=$G(^IBE(351.2,IBC,0)),IBC1=$G(^(1)),IBC2=$G(^(2))
S DFN=+IBCD,IBPT=$$PT^IBEFUNC(DFN),IBCL=$P(IBCD,"^",3)
W !,$$DASH(),!?1,"Pt. Name: ",$E($P(IBPT,"^"),1,17)," (",$P(IBPT,"^",3),")"
W ?38,"Care related to ",$$PATTYAB^IBACV(IBCL),": ",$S($P(IBCD,"^",7):"YES",$P(IBCD,"^",7)=0:"NO",1:"UNANSWERED")
W !?5,"Type: ",$$UCCL^IBAMTI(IBCL),?39,"Case Dispositioned: ",$S($P(IBCD,"^",8):"YES",1:"NO")
W !?1,"Adm Date: ",$$DAT1^IBOUTL(+$G(^DGPM(+$P(IBCD,"^",2),0)),1),?41,"Date Last Edited: ",$$DAT1^IBOUTL(+$P(IBC2,"^",4),1)
S IBDIS=+$G(^DGPM(+$P($G(^DGPM(+$P(IBCD,"^",2),0)),"^",17),0))
W !,"Disc Date: ",$S(IBDIS:$$DAT1^IBOUTL(IBDIS,1),1:"Still Admitted"),?43,"Last Edited By: ",$E($P($G(^VA(200,+$P(IBC2,"^",3),0)),"^"),1,20),!,$$DASH()
;
S IBEVT=+$P(IBCD,"^",4)
I $O(^IB("AF",IBEVT,IBEVT)) W !?1,"Charges Billed:" D
.S IBN=0 F S IBN=$O(^IB("AF",IBEVT,IBN)) Q:'IBN I IBN'=IBEVT D
..S IBND=$G(^IB(IBN,0))
..S IBATYP=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")
..S:$E(IBATYP,1,2)="DG" IBATYP=$E(IBATYP,4,99)
..W !?5,IBATYP,?35,$$DAT1^IBOUTL($P(IBND,"^",14)),?46,$$DAT1^IBOUTL($P(IBND,"^",15))
..W ?57,"$",$P(IBND,"^",7),?64,$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",2)
.W !,$$DASH()
;
I IBC1]"" W !?1,"Reason for Non-Billing:",!,IBC1,!,$$DASH(),!
DSPLQ Q
;
DASH() ; Return a dashed line.
Q $TR($J("",80)," ","-")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTI1 4459 printed Dec 13, 2024@02:06:38 Page 2
IBAMTI1 ;ALB/CPM - SPECIAL INPATIENT BILLING CASES (CON'T.) ; 11-AUG-93
+1 ;;2.0;INTEGRATED BILLING;**52,132,156,199,234,339**;21-MAR-94;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
DISP ; Manually disposition a case record.
+1 WRITE !!,"This option is used to disposition case records for special inpatient"
+2 WRITE !,"episodes of care which are not to be billed. (AO/IR/SWA/SC/MST/HNC/CV/SHAD)"
+3 WRITE !,"After identifying the case, please enter the reason (up to 80 characters)"
+4 WRITE !,"for non-billing."
+5 ;
+6 ; - main processing loop
+7 SET IBQ=0
FOR
WRITE !
DO SEL
if IBQ
QUIT
+8 KILL IBQ
+9 QUIT
+10 ;
SEL ; Select an inpatient billing case and enter the reason for non-billing.
+1 SET DIC="^IBE(351.2,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select PATIENT: "
+2 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+3 DO ^DIC
SET IBC=+Y
IF Y<0
SET IBQ=1
GOTO SELQ
+4 IF $PIECE(Y(0),"^",5)=1
WRITE !!,"You must wait until this patient has been discharged to disposition the case."
GOTO SELQ
+5 IF $PIECE(Y(0),"^",4)
SET IBBILLED=1
WRITE !!,"Please note that it appears as if this case has been billed."
+6 IF $PIECE(Y(0),"^",8)
WRITE !!,"Please note that this case has already been dispositioned."
+7 ;
+8 ; - display case record
+9 WRITE !
DO DSPL(IBC)
+10 ;
+11 ; - allow user update of record
+12 SET IBHC=$PIECE(Y(0),"^",7)
SET IBHR=$GET(^IBE(351.2,IBC,1))
+13 SET DIE="^IBE(351.2,"
SET DA=IBC
SET DR=$SELECT($GET(IBBILLED):".07;",1:"")_1
DO ^DIE
+14 ;
+15 SET IBNC=$PIECE(^IBE(351.2,IBC,0),"^",7)
SET IBNR=$GET(^IBE(351.2,IBC,1))
+16 IF IBHC=IBNC
IF IBHR=IBNR
WRITE !!,"No changes made to the case record!"
GOTO SELQ
+17 IF IBNR]""
WRITE !!,"This case record will be dispositioned."
+18 SET DR="2.03////"_DUZ_";2.04///NOW"
+19 IF IBNR]""
SET DR=".07////1;.08////1;"_DR
+20 SET DIE="^IBE(351.2,"
SET DA=IBC
DO ^DIE
SELQ KILL DA,DIC,DIE,DR,IBC,IBHC,IBHR,IBNC,IBNR,IBBILLED
+1 QUIT
+2 ;
CEA(IBPM,IBEVT) ; Automatically disposition the case from Cancel/Edit/Add.
+1 ; Input: IBPM -- Pointer to the adm movement in file #405
+2 ; IBEVT -- Pointer to the billing event record in file #350
+3 IF '$GET(IBEVT)
GOTO CEAQ
+4 NEW DA,DIE,DR,IBC
+5 SET IBC=$ORDER(^IBE(351.2,"AC",+$GET(IBPM),0))
IF IBC
DO UPD(0)
CEAQ QUIT
+1 ;
CHK(IBC,IBEVT) ; Review the case after adding a charge from Cancel/Edit/Add.
+1 ; Input: IBC -- Pointer to the case in file #351.2
+2 ; IBEVT -- Pointer to the billing event record in file #350
+3 IF '$GET(IBC)!'$GET(IBEVT)
GOTO CHKQ
+4 NEW DA,DIE,DR,IBCD,IBCD1
+5 SET IBCD=$GET(^IBE(351.2,IBC,0))
SET IBCD1=$GET(^(1))
+6 IF $PIECE(IBCD,"^",7)!'$PIECE(IBCD,"^",8)!(IBCD1]"")
DO UPD(1)
CHKQ QUIT
+1 ;
UPD(IND) ; Disposition the case record.
+1 ; Input: IND -- 0 = dispositioning | 1 = reviewing
+2 ; variables -- IBC => ptr to case record
+3 ; IBEVT => ptr to event record in #350
+4 WRITE !,"Dispositioning the special inpatient billing case record"
+5 if $GET(IND)
WRITE " (as billable)"
WRITE "..."
+6 KILL ^IBE(351.2,IBC,1)
+7 SET DR=".04////"_IBEVT_";.07////0;.08////1;2.03////"_DUZ_";2.04///NOW"
+8 SET DIE="^IBE(351.2,"
SET DA=IBC
DO ^DIE
WRITE " done."
+9 QUIT
+10 ;
DSPL(IBC) ; Display a case record.
+1 ; Input: IBC -- Pointer to the case record in file #351.2
+2 IF '$GET(IBC)
GOTO DSPLQ
+3 NEW DFN,IBCD,IBC1,IBC2,IBATYP,IBPT,IBDIS,IBCL,IBEVT,IBN,IBND,Y
+4 SET IBCD=$GET(^IBE(351.2,IBC,0))
SET IBC1=$GET(^(1))
SET IBC2=$GET(^(2))
+5 SET DFN=+IBCD
SET IBPT=$$PT^IBEFUNC(DFN)
SET IBCL=$PIECE(IBCD,"^",3)
+6 WRITE !,$$DASH(),!?1,"Pt. Name: ",$EXTRACT($PIECE(IBPT,"^"),1,17)," (",$PIECE(IBPT,"^",3),")"
+7 WRITE ?38,"Care related to ",$$PATTYAB^IBACV(IBCL),": ",$SELECT($PIECE(IBCD,"^",7):"YES",$PIECE(IBCD,"^",7)=0:"NO",1:"UNANSWERED")
+8 WRITE !?5,"Type: ",$$UCCL^IBAMTI(IBCL),?39,"Case Dispositioned: ",$SELECT($PIECE(IBCD,"^",8):"YES",1:"NO")
+9 WRITE !?1,"Adm Date: ",$$DAT1^IBOUTL(+$GET(^DGPM(+$PIECE(IBCD,"^",2),0)),1),?41,"Date Last Edited: ",$$DAT1^IBOUTL(+$PIECE(IBC2,"^",4),1)
+10 SET IBDIS=+$GET(^DGPM(+$PIECE($GET(^DGPM(+$PIECE(IBCD,"^",2),0)),"^",17),0))
+11 WRITE !,"Disc Date: ",$SELECT(IBDIS:$$DAT1^IBOUTL(IBDIS,1),1:"Still Admitted"),?43,"Last Edited By: ",$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBC2,"^",3),0)),"^"),1,20),!,$$DASH()
+12 ;
+13 SET IBEVT=+$PIECE(IBCD,"^",4)
+14 IF $ORDER(^IB("AF",IBEVT,IBEVT))
WRITE !?1,"Charges Billed:"
Begin DoDot:1
+15 SET IBN=0
FOR
SET IBN=$ORDER(^IB("AF",IBEVT,IBN))
if 'IBN
QUIT
IF IBN'=IBEVT
Begin DoDot:2
+16 SET IBND=$GET(^IB(IBN,0))
+17 SET IBATYP=$PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")
+18 if $EXTRACT(IBATYP,1,2)="DG"
SET IBATYP=$EXTRACT(IBATYP,4,99)
+19 WRITE !?5,IBATYP,?35,$$DAT1^IBOUTL($PIECE(IBND,"^",14)),?46,$$DAT1^IBOUTL($PIECE(IBND,"^",15))
+20 WRITE ?57,"$",$PIECE(IBND,"^",7),?64,$PIECE($GET(^IBE(350.21,+$PIECE(IBND,"^",5),0)),"^",2)
End DoDot:2
+21 WRITE !,$$DASH()
End DoDot:1
+22 ;
+23 IF IBC1]""
WRITE !?1,"Reason for Non-Billing:",!,IBC1,!,$$DASH(),!
DSPLQ QUIT
+1 ;
DASH() ; Return a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",80)," ","-")
