Routine: IBAMTS

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

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

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  Feb 18, 2025@23:33:05                                                                                                                                                                                                      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

IBAMTS.m