IBAMTS ;ALB/CPM - APPOINTMENT EVENT DRIVER INTERFACE ;20-JUL-93
;;2.0;INTEGRATED BILLING;**52,115,132,153,164,156,171,247,312,341,339**;21-MAR-94;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN ; Main interface entry point.
;
N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
I '$G(DUZ) D DUZ^XUP(.5) ;IB*2.0*341 Setting of DUZ covered by IA 4129
;
S IBJOB=5,IBWHER="",IBDUZ=DUZ,IBY=1
; Do Transfer Pricing
I '+IBSWINFO D ^IBATEO ;IB*2.0*312
; Check Encounter Related to LTC
N IBALTC D EN^IBAECO
I '$$BILST^DGMTUB(DFN) G ENQ ; never Means Test billable
I '$$CHECK^IBECEAU(0) D ^IBAERR1 G ENQ ; can't set vital parameters
;
; - process all parent outpatient encounters
S IBORG=0 F S IBORG=$O(^TMP("SDEVT",$J,SDHDL,IBORG)) Q:'IBORG D
.S IBOE=0 F S IBOE=$O(^TMP("SDEVT",$J,SDHDL,IBORG,"SDOE",IBOE)) Q:'IBOE S IBEVT=$G(^(IBOE,0,"AFTER")),IBEV0=$G(^("BEFORE")) D
..;
..S IBDT=$S(IBEVT:+IBEVT,1:+IBEV0),IBDAT=$P(IBDT,".")
..; Do NOT PROCESS on VistA if IBDAT>=Switch Eff Date ;CCR-930
..I +IBSWINFO,(IBDAT+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
..;
..S IBAPTY=$S(IBEVT:$P(IBEVT,"^",10),1:$P(IBEV0,"^",10))
..S IBBILLED=$$BFO^IBECEAU(DFN,IBDAT),IBY=1
..;
..; - if C&P encounter, cancel charges for the day and quit
..I IBAPTY=1!(IBALTC) D:IBBILLED Q
...S IBCRES=+$O(^IBE(350.3,"B",$S(IBALTC:"BILLED LTC CHARGE",1:"COMP & PENSION VISIT RECORDED"),0))
...S:'IBCRES IBCRES=23 S IBWHER=""
...D CANCH^IBECEAU4(IBBILLED,IBCRES,0)
..;
..; - quit if there are any C&P encounters on the visit date
..Q:$$CNP^IBECEAU(DFN,IBDAT)
..;
..; - quit if there are any LTC encounters on the visit date
..Q:$$LTCENC^IBAECU(DFN,IBDAT)
..;
..; - don't process child events
..I IBEVT]"" Q:$P(IBEVT,"^",6)
..I IBEVT="",IBEV0]"" Q:$P(IBEV0,"^",6)
..;
..; - get statuses
..S IBAST=+$P(IBEVT,"^",12),IBBST=+$P(IBEV0,"^",12)
..;
..; - do either NEW or UPDATED processing
..I IBAST=2,IBBST'=2 D NEW^IBAMTS1 Q
..D UPD^IBAMTS2
;
ENQ K IBJOB,IBWHER,IBORG,IBOE,IBEVT,IBEV0,IBAST,IBBST,IBDUZ,IBY
K IBDT,IBDAT,IBAPTY,IBBILLED,IBSERV,IBSITE,IBFAC,IBCRES,IBRTED
Q
;
BULL ; Send bulletin when classified patients are billed stops which
; are exempt from the classification process.
N IBT,IBC,IBPT,IBDUZ,IBX S IBPT=$$PT^IBEFUNC(DFN),IBX=$$CLTY
S XMSUB="CHARGE FOR STOP CODE EXEMPT FROM CLASSIFICATION"
S IBT(1)="The following patient, who "_$S(IBX="SC":"has a service connected disability,",IBX="CV":"is Combat Veteran",1:"has claimed exposure to "_IBX_",")
S IBT(2)="was billed the Means Test outpatient copay for a stop code which is"
S IBT(3)="exempt from classification:"
S IBT(4)=" " S IBC=4
S IBDUZ=DUZ D PAT^IBAERR1
S Y=IBDAT D DD^%DT
S IBC=IBC+1,IBT(IBC)="Stop Date: "_Y
S IBC=IBC+1,IBT(IBC)="Stop Code: "_$P($G(^DIC(40.7,+$P(IBEVT,"^",3),0)),"^")
S IBC=IBC+1,IBT(IBC)=" "
S IBC=IBC+1,IBT(IBC)="Please check this patient's medical record to determine if the care provided"
S IBC=IBC+1,IBT(IBC)="was related to the "_$S(IBX="SC":"SC disability",IBX="CV":"Combat Veteran status",1:"claimed exposure")_", and, if related, cancel the charge."
D MAIL^IBAERR1
K X,Y,XMSUB,XMY,XMTEXT,XMDUZ
Q
;
CLTY() ; Return the classification type
N IBARR,Y D CL^SDCO21(DFN,IBDAT,"",.IBARR) S Y=""
I $D(IBARR(3)) S Y="SC" G CLTYQ
I $D(IBARR(7)),+$$CVEDT^IBACV(DFN,IBDAT) S Y="CV" G CLTYQ
I $D(IBARR(1)) S Y="Agent Orange" G CLTYQ
I $D(IBARR(2)) S Y="Ionizing Radiation" G CLTYQ
I $D(IBARR(4)) S Y="Southwest Asia" G CLTYQ
I $D(IBARR(8)) S Y="Project 112/SHAD" G CLTYQ
I $D(IBARR(5)) S Y="Military Sexual Trauma" G CLTYQ
I $D(IBARR(6)) S Y="Head/Neck Cancer" G CLTYQ
CLTYQ Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTS 3818 printed Oct 16, 2024@18:07:21 Page 2
IBAMTS ;ALB/CPM - APPOINTMENT EVENT DRIVER INTERFACE ;20-JUL-93
+1 ;;2.0;INTEGRATED BILLING;**52,115,132,153,164,156,171,247,312,341,339**;21-MAR-94;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN ; Main interface entry point.
+1 ;
+2 ;IB*2.0*312
NEW IBSWINFO
SET IBSWINFO=$$SWSTAT^IBBAPI()
+3 ;IB*2.0*341 Setting of DUZ covered by IA 4129
IF '$GET(DUZ)
DO DUZ^XUP(.5)
+4 ;
+5 SET IBJOB=5
SET IBWHER=""
SET IBDUZ=DUZ
SET IBY=1
+6 ; Do Transfer Pricing
+7 ;IB*2.0*312
IF '+IBSWINFO
DO ^IBATEO
+8 ; Check Encounter Related to LTC
+9 NEW IBALTC
DO EN^IBAECO
+10 ; never Means Test billable
IF '$$BILST^DGMTUB(DFN)
GOTO ENQ
+11 ; can't set vital parameters
IF '$$CHECK^IBECEAU(0)
DO ^IBAERR1
GOTO ENQ
+12 ;
+13 ; - process all parent outpatient encounters
+14 SET IBORG=0
FOR
SET IBORG=$ORDER(^TMP("SDEVT",$JOB,SDHDL,IBORG))
if 'IBORG
QUIT
Begin DoDot:1
+15 SET IBOE=0
FOR
SET IBOE=$ORDER(^TMP("SDEVT",$JOB,SDHDL,IBORG,"SDOE",IBOE))
if 'IBOE
QUIT
SET IBEVT=$GET(^(IBOE,0,"AFTER"))
SET IBEV0=$GET(^("BEFORE"))
Begin DoDot:2
+16 ;
+17 SET IBDT=$SELECT(IBEVT:+IBEVT,1:+IBEV0)
SET IBDAT=$PIECE(IBDT,".")
+18 ; Do NOT PROCESS on VistA if IBDAT>=Switch Eff Date ;CCR-930
+19 ;IB*2.0*312
IF +IBSWINFO
IF (IBDAT+1)>$PIECE(IBSWINFO,"^",2)
QUIT
+20 ;
+21 SET IBAPTY=$SELECT(IBEVT:$PIECE(IBEVT,"^",10),1:$PIECE(IBEV0,"^",10))
+22 SET IBBILLED=$$BFO^IBECEAU(DFN,IBDAT)
SET IBY=1
+23 ;
+24 ; - if C&P encounter, cancel charges for the day and quit
+25 IF IBAPTY=1!(IBALTC)
if IBBILLED
Begin DoDot:3
+26 SET IBCRES=+$ORDER(^IBE(350.3,"B",$SELECT(IBALTC:"BILLED LTC CHARGE",1:"COMP & PENSION VISIT RECORDED"),0))
+27 if 'IBCRES
SET IBCRES=23
SET IBWHER=""
+28 DO CANCH^IBECEAU4(IBBILLED,IBCRES,0)
End DoDot:3
QUIT
+29 ;
+30 ; - quit if there are any C&P encounters on the visit date
+31 if $$CNP^IBECEAU(DFN,IBDAT)
QUIT
+32 ;
+33 ; - quit if there are any LTC encounters on the visit date
+34 if $$LTCENC^IBAECU(DFN,IBDAT)
QUIT
+35 ;
+36 ; - don't process child events
+37 IF IBEVT]""
if $PIECE(IBEVT,"^",6)
QUIT
+38 IF IBEVT=""
IF IBEV0]""
if $PIECE(IBEV0,"^",6)
QUIT
+39 ;
+40 ; - get statuses
+41 SET IBAST=+$PIECE(IBEVT,"^",12)
SET IBBST=+$PIECE(IBEV0,"^",12)
+42 ;
+43 ; - do either NEW or UPDATED processing
+44 IF IBAST=2
IF IBBST'=2
DO NEW^IBAMTS1
QUIT
+45 DO UPD^IBAMTS2
End DoDot:2
End DoDot:1
+46 ;
ENQ KILL IBJOB,IBWHER,IBORG,IBOE,IBEVT,IBEV0,IBAST,IBBST,IBDUZ,IBY
+1 KILL IBDT,IBDAT,IBAPTY,IBBILLED,IBSERV,IBSITE,IBFAC,IBCRES,IBRTED
+2 QUIT
+3 ;
BULL ; Send bulletin when classified patients are billed stops which
+1 ; are exempt from the classification process.
+2 NEW IBT,IBC,IBPT,IBDUZ,IBX
SET IBPT=$$PT^IBEFUNC(DFN)
SET IBX=$$CLTY
+3 SET XMSUB="CHARGE FOR STOP CODE EXEMPT FROM CLASSIFICATION"
+4 SET IBT(1)="The following patient, who "_$SELECT(IBX="SC":"has a service connected disability,",IBX="CV":"is Combat Veteran",1:"has claimed exposure to "_IBX_",")
+5 SET IBT(2)="was billed the Means Test outpatient copay for a stop code which is"
+6 SET IBT(3)="exempt from classification:"
+7 SET IBT(4)=" "
SET IBC=4
+8 SET IBDUZ=DUZ
DO PAT^IBAERR1
+9 SET Y=IBDAT
DO DD^%DT
+10 SET IBC=IBC+1
SET IBT(IBC)="Stop Date: "_Y
+11 SET IBC=IBC+1
SET IBT(IBC)="Stop Code: "_$PIECE($GET(^DIC(40.7,+$PIECE(IBEVT,"^",3),0)),"^")
+12 SET IBC=IBC+1
SET IBT(IBC)=" "
+13 SET IBC=IBC+1
SET IBT(IBC)="Please check this patient's medical record to determine if the care provided"
+14 SET IBC=IBC+1
SET IBT(IBC)="was related to the "_$SELECT(IBX="SC":"SC disability",IBX="CV":"Combat Veteran status",1:"claimed exposure")_", and, if related, cancel the charge."
+15 DO MAIL^IBAERR1
+16 KILL X,Y,XMSUB,XMY,XMTEXT,XMDUZ
+17 QUIT
+18 ;
CLTY() ; Return the classification type
+1 NEW IBARR,Y
DO CL^SDCO21(DFN,IBDAT,"",.IBARR)
SET Y=""
+2 IF $DATA(IBARR(3))
SET Y="SC"
GOTO CLTYQ
+3 IF $DATA(IBARR(7))
IF +$$CVEDT^IBACV(DFN,IBDAT)
SET Y="CV"
GOTO CLTYQ
+4 IF $DATA(IBARR(1))
SET Y="Agent Orange"
GOTO CLTYQ
+5 IF $DATA(IBARR(2))
SET Y="Ionizing Radiation"
GOTO CLTYQ
+6 IF $DATA(IBARR(4))
SET Y="Southwest Asia"
GOTO CLTYQ
+7 IF $DATA(IBARR(8))
SET Y="Project 112/SHAD"
GOTO CLTYQ
+8 IF $DATA(IBARR(5))
SET Y="Military Sexual Trauma"
GOTO CLTYQ
+9 IF $DATA(IBARR(6))
SET Y="Head/Neck Cancer"
GOTO CLTYQ
CLTYQ QUIT Y
