- 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 Jan 18, 2025@03:07:52 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)," ","-")