IBAMTI ;ALB/CPM - SPECIAL INPATIENT BILLING CASES ; 11-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, 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|4-ec]
I '$G(DFN)!'$G(IBPM)!'$G(IBCL) G ADMQ
N DA,DIC,DIE,DR,IBC,X,Y S:IBCL=4 IBCL=3
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|4-ec]
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 Category C "_$$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.")
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 Category C at admission, is no longer Category C."
.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|4-ec]
;
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 the following Category C "_$$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|4-ec]
Q $S('$G(X):"SPECIAL",X=1:"AGENT ORANGE",X=2:"IONIZING RADIATION",X=3:"ENV CONTAMINANT",1:"SPECIAL")
;
LCCL(X) ; Return the lower case classification description.
; Input: X -- Patient class [1-ao|2-ir|4-ec]
Q $S('$G(X):"Special",X=1:"Agent Orange",X=2:"Ionizing Radiation",X=3:"Env Contaminant",1:"Special")
IBAMTI ;ALB/CPM - SPECIAL INPATIENT BILLING CASES ; 11-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, 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|4-ec]
+4 IF '$GET(DFN)!'$GET(IBPM)!'$GET(IBCL)
GOTO ADMQ
+5 NEW DA,DIC,DIE,DR,IBC,X,Y
IF IBCL=4
SET IBCL=3
+6 KILL DD,DO
SET DIC="^IBE(351.2,"
SET DIC(0)=""
SET X=DFN
DO FILE^DICN
SET IBC=+Y
+7 SET DR=".02////"_IBPM_";.03////"_IBCL_";.05////1;2.01////"_DUZ_";2.02///NOW;2.03////"_DUZ_";2.04///NOW"
+8 SET DA=IBC
SET DIE=DIC
DO ^DIE
+9 ; 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|4-ec]
+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 Category C "_$$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 IF IBEV=2
Begin DoDot:1
+12 IF '$$BIL^DGMTUB(DFN,DT)
SET IBC=IBC+1
SET IBT(IBC)=" "
SET IBC=IBC+1
SET IBT(IBC)="Note: This patient, who was Category C at admission, is no longer Category C."
+13 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
+14 DO SEND^IBACVA2
+15 QUIT
+16 ;
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|4-ec]
+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 the following Category C "_$$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|4-ec]
+2 QUIT $SELECT('$GET(X):"SPECIAL",X=1:"AGENT ORANGE",X=2:"IONIZING RADIATION",X=3:"ENV CONTAMINANT",1:"SPECIAL")
+3 ;
LCCL(X) ; Return the lower case classification description.
+1 ; Input: X -- Patient class [1-ao|2-ir|4-ec]
+2 QUIT $SELECT('$GET(X):"Special",X=1:"Agent Orange",X=2:"Ionizing Radiation",X=3:"Env Contaminant",1:"Special")
