IBOTR2 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - COMPILATION ;5-JUN-91
;;2.0;INTEGRATED BILLING;**21,42,52,80,100,118,128,451,447,529,752**;21-MAR-94;Build 20
;;Per VA Directive 6402, this routine should not be modified.
;
;MAP TO DGCROTR2
;
;***
;S XRTL=$ZU(0),XRTN="IBOTR-2" D T0^%ZOSV ;start rt clock
;
I $G(IBXTRACT) D E^IBJDE(8,1) ; Change extract status.
;
K ^TMP($J) S IBQUIT=0
S IBDA="" F S IBDA=$O(^DGCR(399,"AD",IBRT,IBDA)) Q:'IBDA D Q:IBQUIT
.D COMP I IBDA#100=0 S IBQUIT=$$STOP^IBOUTL("Trend Report")
;
; - Write the output report.
I 'IBQUIT D
.I 'IBSDIV D:"OP"[IBSORT SORT D EN^IBOTR3(0) Q
.S IBDIV=0 F S IBDIV=$S('VAUTD:$O(VAUTD(IBDIV)),1:$O(^DG(40.8,IBDIV))) Q:'IBDIV D:"OP"[IBSORT SORT D EN^IBOTR3(IBDIV) Q:IBQUIT
;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR2" D T1^%ZOSV ;stop rt clock
ENQ I $D(ZTQUEUED) S ZTREQ="@" Q
K IB,IBAO,IBAP,IBCNT,IBDA,DFN,IBBC,DIC,DA,DR,DIQ,IBDP,IBDBC,IBSCF,IBSCT
K IBCFL,IBDIV,IBQUIT,IBEVT,IBPTIN,IBPFLAG,^TMP($J) D ^%ZISC
Q
;
COMP ; - Compile Bill-Accounts Receivable records for report.
; IB*752/DTG - new var for insurance company range check
N IBINCKN S IBINCKN=""
;
S IBD=$G(^DGCR(399,IBDA,0)) I IBD="" Q
;
; - Get division, if necessary.
I 'IBSDIV S IBDIV=0
E S IBDIV=$$DIV^IBJDF2(IBDA) I 'IBDIV S IBDIV=+$$PRIM^VASITE()
I IBSDIV,'VAUTD,'$D(VAUTD(IBDIV)) Q ; Not a selected division.
;
; - Exclude receivables referred to Regional Counsel, if necessary.
I 'IBINRC,$P($G(^PRCA(430,IBDA,6)),U,4) Q
;
; IB*2.0*451 - get EEOB indicator '%' for bill
S IBPFLAG=$$EEOB^IBOA31(IBDA) ; get 1st/3rd party payment when applicable
;
S IBBN=$P(IBD,U),DFN=+$P(IBD,U,2),IBEVT=+$P(IBD,U,3),IBBC=$P(IBD,U,5)
S:IBBN="" IBBN="NULL" Q:IBBRT="O"&("12"[IBBC) Q:IBBRT="I"&("34"[IBBC)
S IBDBC=$$CLO^PRCAFN(IBDA) Q:IBARST="O"&(IBDBC>-2)!(IBARST="C"&(IBDBC<-1))
I IBDBC>0 S IBBN=$G(IBPFLAG)_IBBN_"*" ; add EEOB indicator
E S IBD=$P($$STA^PRCAFN(IBDA),U,2),IBDBC=$S($L(IBD)>8:$E(IBD,1,8),1:IBD)
I $D(IBBRN),IBBRN="S" S IBBRTY=$S("12"[IBBC:"I",1:"O")
;
; - Perform edits for insurance company.
S IBD=$P($G(^DGCR(399,IBDA,"MP")),U),IBINS=$P($G(^DIC(36,+IBD,0)),U)
I $G(IBICPT) Q:'$D(IBICPT(+IBD)) G CANC
I IBICF'="@",IBD="" Q
I $D(IBIC) Q:IBIC="ALL"&(IBD="") Q:IBIC="NULL"&(IBD]"")
I IBINS="" S IBINS="UNKNOWN" G CANC
I $G(IBIC)="ALL" G CANC
I IBICF="@",IBICL="zzzzz" G CANC
; IB*752/DTG - new var for insurance company range check
S IBINCKN=$$UP^XLFSTR(IBINS)
;I IBICF]IBINS!(IBINS]IBICL) Q
I IBICFU]$E(IBINCKN,1,$L(IBICFU))!($E(IBINCKN,1,$L(IBICLU))]IBICLU) Q
;
CANC ; - Keep cancelled bills if CANCEL BILL? field was selected or answer
; to 'Do you want to include cancelled receivables?' prompt was YES.
S IBCFL=0
;
;IB*2.0*529 - add Payer TIN to Insurance name for report output
S IBPTIN=$$PTIN(IBDA) ; Retrieve Payer TIN
S:IBPTIN="" IBPTIN="UNKNOWN"
S IBINS=IBINS_"~~"_IBPTIN_"@@"_IBD
;
Q:'$D(^DGCR(399,IBDA,"S")) S IBD=^("S")
S IBCNC=0 I "^26^39^"[(U_$P($G(^PRCA(430,IBDA,0)),U,8)_U) S IBCNC=1
I $G(IBCANC),($P(IBD,U,16)!(IBCNC)) S IBCFL=1 G PTDE ; Add canc. bill.
I $G(IBAF)'=16 Q:$P(IBD,U,16)!(IBCNC) ; Bill has been cancelled.
;
PTDE ; - Perform Printed/Treatment date edits.
S IBDP=$P(IBD,U,12)
I IBDF=1 Q:IBDP<IBBDT!(IBDP>IBEDT) ; Date printed is out of range.
S IBD=$G(^DGCR(399,IBDA,"U")),IBSCF=$P(IBD,U),IBSCT=$P(IBD,U,2)
I IBDF=2 Q:IBSCT<IBBDT!(IBSCF>IBEDT) ; Treatment dates out of range.
I '$D(IBAF) G BUILD
;
; - Find the selected field value and compare to selection parameters.
K IB S DIC=399,DA=IBDA,DR=IBAF,DIQ="IB" S:IBAFD DIQ(0)="I"
D EN^DIQ1 K DIQ S:IBAFD IB(399,IBDA,IBAF)=IB(399,IBDA,IBAF,"I")
S IB=$G(IB(399,IBDA,IBAF)) I IB="",IBAFF'="@" Q
I $D(IBAFZ) Q:IBAFZ="ALL"&(IB="") Q:IBAFZ="NULL"&(IB]"")
I IB=""!($G(IBAFZ)="ALL") G BUILD
I IBAFF="@",IBAFL="" G BUILD
; IB*752/DTG if name (#.02) make IB upper case before check
I ($G(IBAF)=".02"&('IB)) S IB=$$UP^XLFSTR(IB)
I +IBAFF=IBAFF,+IBAFL=IBAFL Q:IB<IBAFF!(IB>IBAFL)
;E Q:IBAFF]IB!(IB]IBAFL)
I '((+IBAFF=IBAFF)&(+IBAFL=IBAFL)) Q:IBAFFO]$E(IB,1,$L(IBAFFO))!($E(IB,1,$L(IBAFLO))]IBAFLO)
;
BUILD ; - Retrieve A/R data and build sort global.
N IBGRP
S IBAO=$$ORI^PRCAFN(IBDA) S:IBAO<0 IBAO=0
S IBAP=$$TPR^PRCAFN(IBDA) S:IBAP<0 IBAP=0
;
; Add group number to report P447
S IBGRP=$$POLICY^IBCEF(IBDA,18) S:IBGRP="" IBGRP=0
;S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS,$$NAMAGE(DFN,IBEVT)_"@@"_IBBN)=U_IBSCF_U_IBSCT_U_IBDP_U_IBDBC_U_IBAO_U_IBAP_U_IBCFL
S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS,IBGRP,$$NAMAGE(DFN,IBEVT)_"@@"_IBBN)=U_IBSCF_U_IBSCT_U_IBDP_U_IBDBC_U_IBAO_U_IBAP_U_IBCFL
I "OP"[IBSORT D
.;S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS)=$G(^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS))+$S(IBSORT="O":(IBAO-IBAP),1:IBAP)
.S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS,IBGRP)=$G(^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS))+$S(IBSORT="O":(IBAO-IBAP),1:IBAP)
Q
;
SORT ; - Create sort global based on amount owed/amount paid, if necessary. Add Group# w/ p447
N IBGRP
;
I 'IBSDIV S IBDIV=0
S IBX="" F S IBX=$O(^TMP($J,"IBOTR",IBDIV,IBX)) Q:IBX="" D
.S IBINS="" F S IBINS=$O(^TMP($J,"IBOTR",IBDIV,IBX,IBINS)) Q:IBINS="" D
..S IBGRP="" F S IBGRP=$O(^TMP($J,"IBOTR",IBDIV,IBX,IBINS,IBGRP)) Q:IBGRP="" D
...;S IBXX=^(IBGRP),^TMP($J,"IBOTRS",IBDIV,IBX,-IBXX,IBINS,IBGRP)=""
...S IBXX=$G(^TMP($J,"IBOTR",IBDIV,IBX,IBINS,IBGRP)),^TMP($J,"IBOTRS",IBDIV,IBX,-IBXX,IBINS,IBGRP)=""
K IBX,IBXX
Q
;
NAMAGE(DFN,EVT) ; - Return patient name and age.
; Input: DFN = Pointer to patient in file #2
; EVT = Event Date of claim
; Output: Patient name (1st 18 chars.)_"("_Age_")"
; Output after patch 447: Patient name (1st 16 chars.)_"("_Age_")"
N DPT0,X,X1,X2
S DPT0=$G(^DPT(DFN,0)),X2=$P(DPT0,U,3)
I 'X2 S X="UNK"
E S X1=EVT S:'X1 X1=DT D ^%DTC S X=X\365.25
;Q $E($P(DPT0,U),1,18)_" ("_X_")"
Q $E($P(DPT0,U),1,16)_" ("_X_")"
;
PTIN(IBDA) ; Retrieve Payer TIN for insurance company
;
; IBDA is the IEN of the bill # in file #399 and must be valid
N IBTIN,IBVAL,Z
S IBTIN="",Z=""
I '$G(IBDA) Q IBTIN
S Z=$O(^IBM(361.1,"B",IBDA,Z))
Q:'Z IBTIN
S IBVAL=$G(^IBM(361.1,Z,0))
S IBTIN=$P(IBVAL,"^",3)
Q IBTIN ; Quit with Payer TIN, if it was sent with the ERA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOTR2 6319 printed Nov 22, 2024@17:36:15 Page 2
IBOTR2 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - COMPILATION ;5-JUN-91
+1 ;;2.0;INTEGRATED BILLING;**21,42,52,80,100,118,128,451,447,529,752**;21-MAR-94;Build 20
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCROTR2
+5 ;
+6 ;***
+7 ;S XRTL=$ZU(0),XRTN="IBOTR-2" D T0^%ZOSV ;start rt clock
+8 ;
+9 ; Change extract status.
IF $GET(IBXTRACT)
DO E^IBJDE(8,1)
+10 ;
+11 KILL ^TMP($JOB)
SET IBQUIT=0
+12 SET IBDA=""
FOR
SET IBDA=$ORDER(^DGCR(399,"AD",IBRT,IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+13 DO COMP
IF IBDA#100=0
SET IBQUIT=$$STOP^IBOUTL("Trend Report")
End DoDot:1
if IBQUIT
QUIT
+14 ;
+15 ; - Write the output report.
+16 IF 'IBQUIT
Begin DoDot:1
+17 IF 'IBSDIV
if "OP"[IBSORT
DO SORT
DO EN^IBOTR3(0)
QUIT
+18 SET IBDIV=0
FOR
SET IBDIV=$SELECT('VAUTD:$ORDER(VAUTD(IBDIV)),1:$ORDER(^DG(40.8,IBDIV)))
if 'IBDIV
QUIT
if "OP"[IBSORT
DO SORT
DO EN^IBOTR3(IBDIV)
if IBQUIT
QUIT
End DoDot:1
+19 ;
+20 ;***
+21 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR2" D T1^%ZOSV ;stop rt clock
ENQ IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+1 KILL IB,IBAO,IBAP,IBCNT,IBDA,DFN,IBBC,DIC,DA,DR,DIQ,IBDP,IBDBC,IBSCF,IBSCT
+2 KILL IBCFL,IBDIV,IBQUIT,IBEVT,IBPTIN,IBPFLAG,^TMP($JOB)
DO ^%ZISC
+3 QUIT
+4 ;
COMP ; - Compile Bill-Accounts Receivable records for report.
+1 ; IB*752/DTG - new var for insurance company range check
+2 NEW IBINCKN
SET IBINCKN=""
+3 ;
+4 SET IBD=$GET(^DGCR(399,IBDA,0))
IF IBD=""
QUIT
+5 ;
+6 ; - Get division, if necessary.
+7 IF 'IBSDIV
SET IBDIV=0
+8 IF '$TEST
SET IBDIV=$$DIV^IBJDF2(IBDA)
IF 'IBDIV
SET IBDIV=+$$PRIM^VASITE()
+9 ; Not a selected division.
IF IBSDIV
IF 'VAUTD
IF '$DATA(VAUTD(IBDIV))
QUIT
+10 ;
+11 ; - Exclude receivables referred to Regional Counsel, if necessary.
+12 IF 'IBINRC
IF $PIECE($GET(^PRCA(430,IBDA,6)),U,4)
QUIT
+13 ;
+14 ; IB*2.0*451 - get EEOB indicator '%' for bill
+15 ; get 1st/3rd party payment when applicable
SET IBPFLAG=$$EEOB^IBOA31(IBDA)
+16 ;
+17 SET IBBN=$PIECE(IBD,U)
SET DFN=+$PIECE(IBD,U,2)
SET IBEVT=+$PIECE(IBD,U,3)
SET IBBC=$PIECE(IBD,U,5)
+18 if IBBN=""
SET IBBN="NULL"
if IBBRT="O"&("12"[IBBC)
QUIT
if IBBRT="I"&("34"[IBBC)
QUIT
+19 SET IBDBC=$$CLO^PRCAFN(IBDA)
if IBARST="O"&(IBDBC>-2)!(IBARST="C"&(IBDBC<-1))
QUIT
+20 ; add EEOB indicator
IF IBDBC>0
SET IBBN=$GET(IBPFLAG)_IBBN_"*"
+21 IF '$TEST
SET IBD=$PIECE($$STA^PRCAFN(IBDA),U,2)
SET IBDBC=$SELECT($LENGTH(IBD)>8:$EXTRACT(IBD,1,8),1:IBD)
+22 IF $DATA(IBBRN)
IF IBBRN="S"
SET IBBRTY=$SELECT("12"[IBBC:"I",1:"O")
+23 ;
+24 ; - Perform edits for insurance company.
+25 SET IBD=$PIECE($GET(^DGCR(399,IBDA,"MP")),U)
SET IBINS=$PIECE($GET(^DIC(36,+IBD,0)),U)
+26 IF $GET(IBICPT)
if '$DATA(IBICPT(+IBD))
QUIT
GOTO CANC
+27 IF IBICF'="@"
IF IBD=""
QUIT
+28 IF $DATA(IBIC)
if IBIC="ALL"&(IBD="")
QUIT
if IBIC="NULL"&(IBD]"")
QUIT
+29 IF IBINS=""
SET IBINS="UNKNOWN"
GOTO CANC
+30 IF $GET(IBIC)="ALL"
GOTO CANC
+31 IF IBICF="@"
IF IBICL="zzzzz"
GOTO CANC
+32 ; IB*752/DTG - new var for insurance company range check
+33 SET IBINCKN=$$UP^XLFSTR(IBINS)
+34 ;I IBICF]IBINS!(IBINS]IBICL) Q
+35 IF IBICFU]$EXTRACT(IBINCKN,1,$LENGTH(IBICFU))!($EXTRACT(IBINCKN,1,$LENGTH(IBICLU))]IBICLU)
QUIT
+36 ;
CANC ; - Keep cancelled bills if CANCEL BILL? field was selected or answer
+1 ; to 'Do you want to include cancelled receivables?' prompt was YES.
+2 SET IBCFL=0
+3 ;
+4 ;IB*2.0*529 - add Payer TIN to Insurance name for report output
+5 ; Retrieve Payer TIN
SET IBPTIN=$$PTIN(IBDA)
+6 if IBPTIN=""
SET IBPTIN="UNKNOWN"
+7 SET IBINS=IBINS_"~~"_IBPTIN_"@@"_IBD
+8 ;
+9 if '$DATA(^DGCR(399,IBDA,"S"))
QUIT
SET IBD=^("S")
+10 SET IBCNC=0
IF "^26^39^"[(U_$PIECE($GET(^PRCA(430,IBDA,0)),U,8)_U)
SET IBCNC=1
+11 ; Add canc. bill.
IF $GET(IBCANC)
IF ($PIECE(IBD,U,16)!(IBCNC))
SET IBCFL=1
GOTO PTDE
+12 ; Bill has been cancelled.
IF $GET(IBAF)'=16
if $PIECE(IBD,U,16)!(IBCNC)
QUIT
+13 ;
PTDE ; - Perform Printed/Treatment date edits.
+1 SET IBDP=$PIECE(IBD,U,12)
+2 ; Date printed is out of range.
IF IBDF=1
if IBDP<IBBDT!(IBDP>IBEDT)
QUIT
+3 SET IBD=$GET(^DGCR(399,IBDA,"U"))
SET IBSCF=$PIECE(IBD,U)
SET IBSCT=$PIECE(IBD,U,2)
+4 ; Treatment dates out of range.
IF IBDF=2
if IBSCT<IBBDT!(IBSCF>IBEDT)
QUIT
+5 IF '$DATA(IBAF)
GOTO BUILD
+6 ;
+7 ; - Find the selected field value and compare to selection parameters.
+8 KILL IB
SET DIC=399
SET DA=IBDA
SET DR=IBAF
SET DIQ="IB"
if IBAFD
SET DIQ(0)="I"
+9 DO EN^DIQ1
KILL DIQ
if IBAFD
SET IB(399,IBDA,IBAF)=IB(399,IBDA,IBAF,"I")
+10 SET IB=$GET(IB(399,IBDA,IBAF))
IF IB=""
IF IBAFF'="@"
QUIT
+11 IF $DATA(IBAFZ)
if IBAFZ="ALL"&(IB="")
QUIT
if IBAFZ="NULL"&(IB]"")
QUIT
+12 IF IB=""!($GET(IBAFZ)="ALL")
GOTO BUILD
+13 IF IBAFF="@"
IF IBAFL=""
GOTO BUILD
+14 ; IB*752/DTG if name (#.02) make IB upper case before check
+15 IF ($GET(IBAF)=".02"&('IB))
SET IB=$$UP^XLFSTR(IB)
+16 IF +IBAFF=IBAFF
IF +IBAFL=IBAFL
if IB<IBAFF!(IB>IBAFL)
QUIT
+17 ;E Q:IBAFF]IB!(IB]IBAFL)
+18 IF '((+IBAFF=IBAFF)&(+IBAFL=IBAFL))
if IBAFFO]$EXTRACT(IB,1,$LENGTH(IBAFFO))!($EXTRACT(IB,1,$LENGTH(IBAFLO))]IBAFLO)
QUIT
+19 ;
BUILD ; - Retrieve A/R data and build sort global.
+1 NEW IBGRP
+2 SET IBAO=$$ORI^PRCAFN(IBDA)
if IBAO<0
SET IBAO=0
+3 SET IBAP=$$TPR^PRCAFN(IBDA)
if IBAP<0
SET IBAP=0
+4 ;
+5 ; Add group number to report P447
+6 SET IBGRP=$$POLICY^IBCEF(IBDA,18)
if IBGRP=""
SET IBGRP=0
+7 ;S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS,$$NAMAGE(DFN,IBEVT)_"@@"_IBBN)=U_IBSCF_U_IBSCT_U_IBDP_U_IBDBC_U_IBAO_U_IBAP_U_IBCFL
+8 SET ^TMP($JOB,"IBOTR",IBDIV,IBBRTY,IBINS,IBGRP,$$NAMAGE(DFN,IBEVT)_"@@"_IBBN)=U_IBSCF_U_IBSCT_U_IBDP_U_IBDBC_U_IBAO_U_IBAP_U_IBCFL
+9 IF "OP"[IBSORT
Begin DoDot:1
+10 ;S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS)=$G(^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS))+$S(IBSORT="O":(IBAO-IBAP),1:IBAP)
+11 SET ^TMP($JOB,"IBOTR",IBDIV,IBBRTY,IBINS,IBGRP)=$GET(^TMP($JOB,"IBOTR",IBDIV,IBBRTY,IBINS))+$SELECT(IBSORT="O":(IBAO-IBAP),1:IBAP)
End DoDot:1
+12 QUIT
+13 ;
SORT ; - Create sort global based on amount owed/amount paid, if necessary. Add Group# w/ p447
+1 NEW IBGRP
+2 ;
+3 IF 'IBSDIV
SET IBDIV=0
+4 SET IBX=""
FOR
SET IBX=$ORDER(^TMP($JOB,"IBOTR",IBDIV,IBX))
if IBX=""
QUIT
Begin DoDot:1
+5 SET IBINS=""
FOR
SET IBINS=$ORDER(^TMP($JOB,"IBOTR",IBDIV,IBX,IBINS))
if IBINS=""
QUIT
Begin DoDot:2
+6 SET IBGRP=""
FOR
SET IBGRP=$ORDER(^TMP($JOB,"IBOTR",IBDIV,IBX,IBINS,IBGRP))
if IBGRP=""
QUIT
Begin DoDot:3
+7 ;S IBXX=^(IBGRP),^TMP($J,"IBOTRS",IBDIV,IBX,-IBXX,IBINS,IBGRP)=""
+8 SET IBXX=$GET(^TMP($JOB,"IBOTR",IBDIV,IBX,IBINS,IBGRP))
SET ^TMP($JOB,"IBOTRS",IBDIV,IBX,-IBXX,IBINS,IBGRP)=""
End DoDot:3
End DoDot:2
End DoDot:1
+9 KILL IBX,IBXX
+10 QUIT
+11 ;
NAMAGE(DFN,EVT) ; - Return patient name and age.
+1 ; Input: DFN = Pointer to patient in file #2
+2 ; EVT = Event Date of claim
+3 ; Output: Patient name (1st 18 chars.)_"("_Age_")"
+4 ; Output after patch 447: Patient name (1st 16 chars.)_"("_Age_")"
+5 NEW DPT0,X,X1,X2
+6 SET DPT0=$GET(^DPT(DFN,0))
SET X2=$PIECE(DPT0,U,3)
+7 IF 'X2
SET X="UNK"
+8 IF '$TEST
SET X1=EVT
if 'X1
SET X1=DT
DO ^%DTC
SET X=X\365.25
+9 ;Q $E($P(DPT0,U),1,18)_" ("_X_")"
+10 QUIT $EXTRACT($PIECE(DPT0,U),1,16)_" ("_X_")"
+11 ;
PTIN(IBDA) ; Retrieve Payer TIN for insurance company
+1 ;
+2 ; IBDA is the IEN of the bill # in file #399 and must be valid
+3 NEW IBTIN,IBVAL,Z
+4 SET IBTIN=""
SET Z=""
+5 IF '$GET(IBDA)
QUIT IBTIN
+6 SET Z=$ORDER(^IBM(361.1,"B",IBDA,Z))
+7 if 'Z
QUIT IBTIN
+8 SET IBVAL=$GET(^IBM(361.1,Z,0))
+9 SET IBTIN=$PIECE(IBVAL,"^",3)
+10 ; Quit with Payer TIN, if it was sent with the ERA
QUIT IBTIN
