- 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 Jan 18, 2025@03:07:51 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 ;