IBAMTS ;ALB/CPM - APPOINTMENT EVENT DRIVER INTERFACE ; 20-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; Main interface entry point.
;
S IBJOB=5,IBWHER="",IBDUZ=DUZ,IBY=1
I '$$BILST^DGMTUB(DFN) G ENQ ; never Category C
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,".")
..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 D:IBBILLED Q
...S IBCRES=+$O(^IBE(350.3,"B","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)
..;
..; - 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 S IBPT=$$PT^IBEFUNC(DFN)
S XMSUB="CHARGE FOR STOP CODE EXEMPT FROM CLASSIFICATION"
S IBT(1)="The following patient, who has claimed exposure to "_$$CLTY
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 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 X,Y D CL^SDCO21(DFN,IBDAT,"",.X) S Y=""
I $D(X(1)) S Y="Agent Orange" G CLTYQ
I $D(X(2)) S Y="Ionizing Radiation" G CLTYQ
I $D(X(4)) S Y="Environmental Contaminants"
CLTYQ Q Y_","
IBAMTS ;ALB/CPM - APPOINTMENT EVENT DRIVER INTERFACE ; 20-JUL-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; Main interface entry point.
+1 ;
+2 SET IBJOB=5
SET IBWHER=""
SET IBDUZ=DUZ
SET IBY=1
+3 ; never Category C
IF '$$BILST^DGMTUB(DFN)
GOTO ENQ
+4 ; can't set vital parameters
IF '$$CHECK^IBECEAU(0)
DO ^IBAERR1
GOTO ENQ
+5 ;
+6 ; - process all parent outpatient encounters
+7 SET IBORG=0
FOR
SET IBORG=$ORDER(^TMP("SDEVT",$JOB,SDHDL,IBORG))
IF 'IBORG
QUIT
Begin DoDot:1
+8 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
+9 SET IBDT=$SELECT(IBEVT:+IBEVT,1:+IBEV0)
SET IBDAT=$PIECE(IBDT,".")
+10 SET IBAPTY=$SELECT(IBEVT:$PIECE(IBEVT,"^",10),1:$PIECE(IBEV0,"^",10))
+11 SET IBBILLED=$$BFO^IBECEAU(DFN,IBDAT)
SET IBY=1
+12 ;
+13 ; - if C&P encounter, cancel charges for the day and quit
+14 IF IBAPTY=1
IF IBBILLED
Begin DoDot:3
+15 SET IBCRES=+$ORDER(^IBE(350.3,"B","COMP & PENSION VISIT RECORDED",0))
+16 IF 'IBCRES
SET IBCRES=23
SET IBWHER=""
+17 DO CANCH^IBECEAU4(IBBILLED,IBCRES,0)
End DoDot:3
QUIT
+18 ;
+19 ; - quit if there are any C&P encounters on the visit date
+20 IF $$CNP^IBECEAU(DFN,IBDAT)
QUIT
+21 ;
+22 ; - don't process child events
+23 IF IBEVT]""
IF $PIECE(IBEVT,"^",6)
QUIT
+24 IF IBEVT=""
IF IBEV0]""
IF $PIECE(IBEV0,"^",6)
QUIT
+25 ;
+26 ; - get statuses
+27 SET IBAST=+$PIECE(IBEVT,"^",12)
SET IBBST=+$PIECE(IBEV0,"^",12)
+28 ;
+29 ; - do either NEW or UPDATED processing
+30 IF IBAST=2
IF IBBST'=2
DO NEW^IBAMTS1
QUIT
+31 DO UPD^IBAMTS2
End DoDot:2
End DoDot:1
+32 ;
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
SET IBPT=$$PT^IBEFUNC(DFN)
+3 SET XMSUB="CHARGE FOR STOP CODE EXEMPT FROM CLASSIFICATION"
+4 SET IBT(1)="The following patient, who has claimed exposure to "_$$CLTY
+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 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 X,Y
DO CL^SDCO21(DFN,IBDAT,"",.X)
SET Y=""
+2 IF $DATA(X(1))
SET Y="Agent Orange"
GOTO CLTYQ
+3 IF $DATA(X(2))
SET Y="Ionizing Radiation"
GOTO CLTYQ
+4 IF $DATA(X(4))
SET Y="Environmental Contaminants"
CLTYQ QUIT Y_","
