IBAMTI ;ALB/CPM - SPECIAL INPATIENT BILLING CASES ; 11-AUG-93
;;2.0;INTEGRATED BILLING;**52,132,153,156,234,247,339**;21-MAR-94;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
ADM(DFN,IBPM,IBCL) ; Create a new case record upon admission
; Input: DFN -- Pointer to the patient in file #2
; IBPM -- Pointer to the adm movement in file #405
; IBCL -- Patient class [1-ao|2-ir|3-sc|4-swa|5-mst|6-hnc|7-cv|8-shad]
I '$G(DFN)!'$G(IBPM)!'$G(IBCL) G ADMQ
N DA,DIC,DIE,DR,IBC,X,Y
;
; - need to swap the input of 3 (SC) to 4, and 4 (EC) to 3
S IBCL=$S(IBCL=3:4,IBCL=4:3,IBCL=5:5,1:IBCL)
;
K DD,DO S DIC="^IBE(351.2,",DIC(0)="",X=DFN D FILE^DICN S IBC=+Y
S DR=".02////"_IBPM_";.03////"_IBCL_";.05////1;2.01////"_DUZ_";2.02///NOW;2.03////"_DUZ_";2.04///NOW"
S DA=IBC,DIE=DIC D ^DIE
D BULL(1,IBCL) ; send admission bulletin
ADMQ Q
;
DIS(IBPM) ; Update the case record upon discharge
; Input: IBPM -- Pointer to the adm movement in file #405
N DA,DIE,DR,IBC
S IBC=$O(^IBE(351.2,"AC",+$G(IBPM),0)) I 'IBC G DISQ
S DR=".05////2;.06////"_DT_";2.03////"_DUZ_";2.04///NOW"
S DA=IBC,DIE="^IBE(351.2," D ^DIE
D BULL(2,+$P($G(^IBE(351.2,IBC,0)),"^",3)) ; send discharge bulletin
DISQ Q
;
BGJ ; Perform nightly background monitoring of all case records.
N IBC,IBCD,IBNUM
S IBC=0 F S IBC=$O(^IBE(351.2,IBC)) Q:'IBC S IBCD=$G(^(IBC,0)) D
.Q:$P(IBCD,"^",8) ; case has been dispositioned
.Q:$P(IBCD,"^",5)=1 ; patient still admitted
.I '$P(IBCD,"^",6) S $P(^IBE(351.2,IBC,0),"^",6)=DT Q ; no disch date
.S IBNUM=$$FMDIFF^XLFDT(DT,$P(IBCD,"^",6))
.Q:IBNUM<45 ; still time to disposition the case
.D NOTICE(IBNUM,+IBCD,+$P(IBCD,"^",2),+$P(IBCD,"^",3)) ; send reminder to disposition
Q
;
BULL(IBEV,IBCL) ; Send a bulletin at admission and discharge.
; Input: IBEV -- Event [1:admission|2:discharge]
; IBCL -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
K IBT S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - "_$$UCCL(IBCL)_$S($G(IBEV)=1:" ADM",1:" DISCH")
S IBT(1)="The following Means Test copay "_$$LCCL(IBCL)_" patient was just "_$S($G(IBEV)=1:"admitted:",1:"discharged:")
S IBT(2)=" " S IBC=2
S IBDUZ=DUZ D PAT^IBAERR1
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)=$S($G(IBEV)=1:"Please note that a special inpatient case record has been created for",1:"Please note that you have 45 days to determine if this episode of care")
S IBC=IBC+1,IBT(IBC)=$S($G(IBEV)=1:"this admission.",1:"should be billed.")
;---CV
I IBCL=7,$G(IBEV)=2 D
. N Y,X,IBZ,IBFL,IBEXP,IBTODAY,IBDIS
. S (Y,X,IBZ,IBFL,IBEXP,IBTODAY,IBDIS)=0
. D NOW^%DTC S IBTODAY=%\1
. S IBZ=$$CVEDT^IBACV(DFN,IBTODAY)
. I +IBZ=1 Q ;patient is still CV
. S IBEXP=+$P(IBZ,"^",2)\1
. S IBDIS=+$G(^DGPM(+$P($G(^DGPM(+$G(IBPM),0)),"^",17),0))\1
. ; if CV expired during inpatient stay
. I IBDIS>0,IBEXP'>IBDIS D
. . S IBFL=1
. . S Y=IBEXP D DD^%DT S IBEXP=Y
. . S IBC=IBC+1,IBT(IBC)=""
. . S IBC=IBC+1,IBT(IBC)="WARNING: Patient's CV status has expired on "_IBEXP_" during the"
. . S IBC=IBC+1,IBT(IBC)="inpatient stay. Billing needs to be adjusted accordingly."
. ; if discharge move was entered after actual discharge date
. I IBFL=0 D
. . S Y=IBEXP D DD^%DT S IBEXP=Y
. . S IBC=IBC+1,IBT(IBC)=""
. . S IBC=IBC+1,IBT(IBC)="WARNING: Patient CV status has expired on "_IBEXP_""
;---
I IBEV=2 D
.I '$$BIL^DGMTUB(DFN,DT) S IBC=IBC+1,IBT(IBC)=" ",IBC=IBC+1,IBT(IBC)="Note: This patient, who was MT copay at admission, is no longer MT billable."
.I $$BFO^IBECEAU(DFN,+$G(^DGPM(IBPM,0))\1) S IBC=IBC+1,IBT(IBC)=" ",IBC=IBC+1,IBT(IBC)="Note: This patient was billed the outpatient copayment at admission."
D SEND^IBACVA2
Q
;
NOTICE(IBNUM,DFN,IBPM,IBCL) ; Notice to disposition billing case
; Input: IBNUM -- Number of days since discharge
; DFN -- Pointer to the patient in file #2
; IBPM -- Pointer to the admission in file #405
; IBCL -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
;
Q:IBNUM#15 ; send notice every 15 days only
N IBC K IBT S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB="NOTICE TO DISPOSITION SPECIAL INPATIENT BILLING CASE"
S IBT(1)="The case record for this Means Test copay "_$$LCCL(IBCL)_" patient"
S IBT(2)="is now "_IBNUM_" days old and should be dispositioned:"
S IBT(3)=" " S IBC=3
S IBDUZ=DUZ D PAT^IBAERR1
S Y=+$G(^DGPM(+$G(IBPM),0)) D DD^%DT
S IBC=IBC+1,IBT(IBC)=" Adm Date: "_Y
S Y=+$G(^DGPM(+$P($G(^DGPM(+$G(IBPM),0)),"^",17),0)) D DD^%DT
S IBC=IBC+1,IBT(IBC)="Disc Date: "_Y
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="Please determine if this episode of care should be billed, and use"
S IBC=IBC+1,IBT(IBC)="the Cancel/Edit/Add Patient Charges option to add charges, or the"
S IBC=IBC+1,IBT(IBC)="Disposition Special Inpatient Billing Cases option to enter the reason"
S IBC=IBC+1,IBT(IBC)="for not billing."
D SEND^IBACVA2
Q
;
UCCL(X) ; Return the upper case classification description.
; Input: X -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
Q $S('$G(X):"SPECIAL",1:$$PATTYPE^IBACV(X))
;
LCCL(X) ; Return the lower case classification description.
; Input: X -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
Q $S('$G(X):"Special",1:$$PATTYPE^IBACV(X,"M"))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTI 5471 printed Oct 16, 2024@18:07:19 Page 2
IBAMTI ;ALB/CPM - SPECIAL INPATIENT BILLING CASES ; 11-AUG-93
+1 ;;2.0;INTEGRATED BILLING;**52,132,153,156,234,247,339**;21-MAR-94;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ADM(DFN,IBPM,IBCL) ; Create a new case record upon admission
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; IBPM -- Pointer to the adm movement in file #405
+3 ; IBCL -- Patient class [1-ao|2-ir|3-sc|4-swa|5-mst|6-hnc|7-cv|8-shad]
+4 IF '$GET(DFN)!'$GET(IBPM)!'$GET(IBCL)
GOTO ADMQ
+5 NEW DA,DIC,DIE,DR,IBC,X,Y
+6 ;
+7 ; - need to swap the input of 3 (SC) to 4, and 4 (EC) to 3
+8 SET IBCL=$SELECT(IBCL=3:4,IBCL=4:3,IBCL=5:5,1:IBCL)
+9 ;
+10 KILL DD,DO
SET DIC="^IBE(351.2,"
SET DIC(0)=""
SET X=DFN
DO FILE^DICN
SET IBC=+Y
+11 SET DR=".02////"_IBPM_";.03////"_IBCL_";.05////1;2.01////"_DUZ_";2.02///NOW;2.03////"_DUZ_";2.04///NOW"
+12 SET DA=IBC
SET DIE=DIC
DO ^DIE
+13 ; send admission bulletin
DO BULL(1,IBCL)
ADMQ QUIT
+1 ;
DIS(IBPM) ; Update the case record upon discharge
+1 ; Input: IBPM -- Pointer to the adm movement in file #405
+2 NEW DA,DIE,DR,IBC
+3 SET IBC=$ORDER(^IBE(351.2,"AC",+$GET(IBPM),0))
IF 'IBC
GOTO DISQ
+4 SET DR=".05////2;.06////"_DT_";2.03////"_DUZ_";2.04///NOW"
+5 SET DA=IBC
SET DIE="^IBE(351.2,"
DO ^DIE
+6 ; send discharge bulletin
DO BULL(2,+$PIECE($GET(^IBE(351.2,IBC,0)),"^",3))
DISQ QUIT
+1 ;
BGJ ; Perform nightly background monitoring of all case records.
+1 NEW IBC,IBCD,IBNUM
+2 SET IBC=0
FOR
SET IBC=$ORDER(^IBE(351.2,IBC))
if 'IBC
QUIT
SET IBCD=$GET(^(IBC,0))
Begin DoDot:1
+3 ; case has been dispositioned
if $PIECE(IBCD,"^",8)
QUIT
+4 ; patient still admitted
if $PIECE(IBCD,"^",5)=1
QUIT
+5 ; no disch date
IF '$PIECE(IBCD,"^",6)
SET $PIECE(^IBE(351.2,IBC,0),"^",6)=DT
QUIT
+6 SET IBNUM=$$FMDIFF^XLFDT(DT,$PIECE(IBCD,"^",6))
+7 ; still time to disposition the case
if IBNUM<45
QUIT
+8 ; send reminder to disposition
DO NOTICE(IBNUM,+IBCD,+$PIECE(IBCD,"^",2),+$PIECE(IBCD,"^",3))
End DoDot:1
+9 QUIT
+10 ;
BULL(IBEV,IBCL) ; Send a bulletin at admission and discharge.
+1 ; Input: IBEV -- Event [1:admission|2:discharge]
+2 ; IBCL -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
+3 KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+4 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - "_$$UCCL(IBCL)_$SELECT($GET(IBEV)=1:" ADM",1:" DISCH")
+5 SET IBT(1)="The following Means Test copay "_$$LCCL(IBCL)_" patient was just "_$SELECT($GET(IBEV)=1:"admitted:",1:"discharged:")
+6 SET IBT(2)=" "
SET IBC=2
+7 SET IBDUZ=DUZ
DO PAT^IBAERR1
+8 SET IBC=IBC+1
SET IBT(IBC)=" "
+9 SET IBC=IBC+1
SET IBT(IBC)=$SELECT($GET(IBEV)=1:"Please note that a special inpatient case record has been created for",1:"Please note that you have 45 days to determine if this episode of care")
+10 SET IBC=IBC+1
SET IBT(IBC)=$SELECT($GET(IBEV)=1:"this admission.",1:"should be billed.")
+11 ;---CV
+12 IF IBCL=7
IF $GET(IBEV)=2
Begin DoDot:1
+13 NEW Y,X,IBZ,IBFL,IBEXP,IBTODAY,IBDIS
+14 SET (Y,X,IBZ,IBFL,IBEXP,IBTODAY,IBDIS)=0
+15 DO NOW^%DTC
SET IBTODAY=%\1
+16 SET IBZ=$$CVEDT^IBACV(DFN,IBTODAY)
+17 ;patient is still CV
IF +IBZ=1
QUIT
+18 SET IBEXP=+$PIECE(IBZ,"^",2)\1
+19 SET IBDIS=+$GET(^DGPM(+$PIECE($GET(^DGPM(+$GET(IBPM),0)),"^",17),0))\1
+20 ; if CV expired during inpatient stay
+21 IF IBDIS>0
IF IBEXP'>IBDIS
Begin DoDot:2
+22 SET IBFL=1
+23 SET Y=IBEXP
DO DD^%DT
SET IBEXP=Y
+24 SET IBC=IBC+1
SET IBT(IBC)=""
+25 SET IBC=IBC+1
SET IBT(IBC)="WARNING: Patient's CV status has expired on "_IBEXP_" during the"
+26 SET IBC=IBC+1
SET IBT(IBC)="inpatient stay. Billing needs to be adjusted accordingly."
End DoDot:2
+27 ; if discharge move was entered after actual discharge date
+28 IF IBFL=0
Begin DoDot:2
+29 SET Y=IBEXP
DO DD^%DT
SET IBEXP=Y
+30 SET IBC=IBC+1
SET IBT(IBC)=""
+31 SET IBC=IBC+1
SET IBT(IBC)="WARNING: Patient CV status has expired on "_IBEXP_""
End DoDot:2
End DoDot:1
+32 ;---
+33 IF IBEV=2
Begin DoDot:1
+34 IF '$$BIL^DGMTUB(DFN,DT)
SET IBC=IBC+1
SET IBT(IBC)=" "
SET IBC=IBC+1
SET IBT(IBC)="Note: This patient, who was MT copay at admission, is no longer MT billable."
+35 IF $$BFO^IBECEAU(DFN,+$GET(^DGPM(IBPM,0))\1)
SET IBC=IBC+1
SET IBT(IBC)=" "
SET IBC=IBC+1
SET IBT(IBC)="Note: This patient was billed the outpatient copayment at admission."
End DoDot:1
+36 DO SEND^IBACVA2
+37 QUIT
+38 ;
NOTICE(IBNUM,DFN,IBPM,IBCL) ; Notice to disposition billing case
+1 ; Input: IBNUM -- Number of days since discharge
+2 ; DFN -- Pointer to the patient in file #2
+3 ; IBPM -- Pointer to the admission in file #405
+4 ; IBCL -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
+5 ;
+6 ; send notice every 15 days only
if IBNUM#15
QUIT
+7 NEW IBC
KILL IBT
SET IBPT=$$PT^IBEFUNC(DFN)
+8 SET XMSUB="NOTICE TO DISPOSITION SPECIAL INPATIENT BILLING CASE"
+9 SET IBT(1)="The case record for this Means Test copay "_$$LCCL(IBCL)_" patient"
+10 SET IBT(2)="is now "_IBNUM_" days old and should be dispositioned:"
+11 SET IBT(3)=" "
SET IBC=3
+12 SET IBDUZ=DUZ
DO PAT^IBAERR1
+13 SET Y=+$GET(^DGPM(+$GET(IBPM),0))
DO DD^%DT
+14 SET IBC=IBC+1
SET IBT(IBC)=" Adm Date: "_Y
+15 SET Y=+$GET(^DGPM(+$PIECE($GET(^DGPM(+$GET(IBPM),0)),"^",17),0))
DO DD^%DT
+16 SET IBC=IBC+1
SET IBT(IBC)="Disc Date: "_Y
+17 SET IBC=IBC+1
SET IBT(IBC)=" "
+18 SET IBC=IBC+1
SET IBT(IBC)="Please determine if this episode of care should be billed, and use"
+19 SET IBC=IBC+1
SET IBT(IBC)="the Cancel/Edit/Add Patient Charges option to add charges, or the"
+20 SET IBC=IBC+1
SET IBT(IBC)="Disposition Special Inpatient Billing Cases option to enter the reason"
+21 SET IBC=IBC+1
SET IBT(IBC)="for not billing."
+22 DO SEND^IBACVA2
+23 QUIT
+24 ;
UCCL(X) ; Return the upper case classification description.
+1 ; Input: X -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
+2 QUIT $SELECT('$GET(X):"SPECIAL",1:$$PATTYPE^IBACV(X))
+3 ;
LCCL(X) ; Return the lower case classification description.
+1 ; Input: X -- Patient class [1-ao|2-ir|3-swa|4-sc|5-mst|6-hnc|7-cv|8-shad]
+2 QUIT $SELECT('$GET(X):"Special",1:$$PATTYPE^IBACV(X,"M"))
+3 ;
