IBINRPT ;YMG/EDE - Indian Attestation (MEGABUS Act) Copay Exemption Report ;NOV 23 2021
;;2.0;INTEGRATED BILLING;**716**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to FILE #2 in ICR #7300
;
Q
;
EN ; entry point
N EXCEL,IBEND,IBSTART,QUIT
N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
K ^TMP("IBINRPT",$J)
W !!,"Indian Attestation Copay Exemption Report",!
; ask for dates
S QUIT=0 D ASKDT I QUIT Q
; export to Excel?
S EXCEL=$$GETEXCEL^IBUCMM() I EXCEL<0 Q
I EXCEL D PRTEXCEL^IBUCMM()
I 'EXCEL W !!,"This report requires 132 column display.",!
; ask for device
K IOP,IO("Q")
S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS Q:POP
I $D(IO("Q")) D Q ; queued report
.S ZTDESC="Indian Attestation Copay Exemption Report",ZTRTN="COMPILE^IBINRPT"
.S ZTSAVE("EXCEL")="",ZTSAVE("IBEND")="",ZTSAVE("IBSTART")="",ZTSAVE("ZTREQ")="@"
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! D PAUSE
.Q
D COMPILE
Q
;
COMPILE ; compile report
N IBBLNO,IBCHRG,IBCHTYPE,IBDATA,IBDFN,IBFR,IBGRP,IBIEN,IBINDTM,IBINFLG,IBINSTDT,IBNM,IBPID,IBSTATNM,IBTO,Z
S IBINDTM=IBSTART-.001 F S IBINDTM=$O(^DPT("AINC",IBINDTM)) Q:'IBINDTM!($P(IBINDTM,".")>IBEND) D
.S IBDFN=0 F S IBDFN=$O(^DPT("AINC",IBINDTM,IBDFN)) Q:'IBDFN D
..S Z=$$INDGET^IBINUT1(IBDFN)
..S IBINFLG=$P(Z,U) ; indian self-identification flag (Y/N)
..S IBINSTDT=$P(Z,U,2) ; indian self-identification start date
..S IBIEN=0 F S IBIEN=$O(^IB("C",IBDFN,IBIEN)) Q:'IBIEN D
...S IBDATA=^IB(IBIEN,0) ; file 350 node 0
...S IBTO=+$P(IBDATA,U,15) ; "Bill To" date
...I '$$INDCHKDT^IBINUT1(IBTO,IBINSTDT) Q ; bill timeframe is not covered by exemption
...S IBSTATNM=$$GET1^DIQ(350,IBIEN_",",.05,"E") ; bill status (350/.05) - external
...; check bill status
...I IBINFLG="Y","^BILLED^HOLD - RATE^HOLD - REVIEW^ON HOLD^"'[(U_IBSTATNM_U) Q
...I IBINFLG'="Y",IBSTATNM'="CANCELLED" Q
...S IBCHTYPE=$P(IBDATA,U,3) Q:IBCHTYPE="" ; charge type (350/.03)
...S IBGRP=$P(^IBE(350.1,IBCHTYPE,0),U,11) I IBGRP=7!(IBGRP=9) Q ; quit if LTC or Tricare charge
...Q:$$GET1^DIQ(350.1,IBCHTYPE,.05,"E")'="NEW"
...S IBBLNO=$P(IBDATA,U,11) ; bill #
...S Z=$$PATID(IBDFN),IBPID=$P(Z,U),IBNM=$P(Z,U,2) ; patient id and name
...S IBCHRG=$P(IBDATA,U,7) ; bill amount (350/.07)
...S IBFR=$P(IBDATA,U,14) ; "Bill From" date
...S ^TMP("IBINRPT",$J,IBDFN,IBIEN)=IBNM_U_IBPID_U_IBINDTM_U_IBINFLG_U_IBBLNO_U_IBCHTYPE_U_IBSTATNM_U_IBFR_U_IBTO_U_IBCHRG
...S ^TMP("IBINRPT",$J,"IDX",IBNM,IBDFN)=""
...Q
..Q
.Q
D PRINT
K ^TMP("IBINRPT",$J)
Q
;
PRINT ; print report
N EXTDT,IBCHRG,IBCHTYPE,IBDATA,IBDFN,IBNM,LN,PAGE,QUIT
U IO
S (PAGE,QUIT)=0
S EXTDT=$$FMTE^XLFDT(DT)
I EXCEL D
.W !,"Indian Attestation Copay Exemption Report",U,EXTDT,U,$$FMTE^XLFDT(IBSTART),"-",$$FMTE^XLFDT(IBEND)
.W !,"Name^ID^Indian change date/time^Indian status^Bill #^Charge type^Bill status^Bill From date^Bill To Date^Bill amount"
.Q
I 'EXCEL D
.I $E(IOST,1,2)["C-",'$D(ZTQUEUED) W @IOF
.D HDR
.Q
I '$D(^TMP("IBINRPT",$J)) D Q
.I EXCEL W !!,"No records found." Q
.W !!,$$CJ^XLFSTR("No records found.",132)
.I PAGE>0,'$D(ZTQUEUED) W ! D PAUSE W @IOF
.Q
S IBNM="" F S IBNM=$O(^TMP("IBINRPT",$J,"IDX",IBNM)) Q:IBNM=""!QUIT D
.S IBDFN="" F S IBDFN=$O(^TMP("IBINRPT",$J,"IDX",IBNM,IBDFN)) Q:IBDFN=""!QUIT D
..S IBIEN="" F S IBIEN=$O(^TMP("IBINRPT",$J,IBDFN,IBIEN)) Q:IBIEN=""!QUIT D
...S IBDATA=^TMP("IBINRPT",$J,IBDFN,IBIEN)
...S IBCHTYPE=$$GET1^DIQ(350.1,$P(IBDATA,U,6),.01,"E")
...S IBCHRG=$FN($P(IBDATA,U,10),"",2)
...I EXCEL D Q
....W !,$P(IBDATA,U),U,$P(IBDATA,U,2),U,$$FMTE^XLFDT($P(IBDATA,U,3),"2Z"),U,$P(IBDATA,U,4),U,$P(IBDATA,U,5),U,IBCHTYPE,U,$P(IBDATA,U,7),U
....W $$FMTE^XLFDT($P(IBDATA,U,8),"2DZ"),U,$$FMTE^XLFDT($P(IBDATA,U,9),"2DZ"),U,IBCHRG
....Q
...S LN=LN+1
...W !,$E($P(IBDATA,U),1,25),?27,$P(IBDATA,U,2),?34,$$FMTE^XLFDT($P(IBDATA,U,3),"2Z"),?54,$P(IBDATA,U,4),?59,$$CJ^XLFSTR($P(IBDATA,U,5),12),?72
...W $E(IBCHTYPE,1,12),?86,$$CJ^XLFSTR($P(IBDATA,U,7),13),?101,$$FMTE^XLFDT($P(IBDATA,U,8),"2DZ"),?112,$$FMTE^XLFDT($P(IBDATA,U,9),"2DZ"),?121,$$CJ^XLFSTR("$"_IBCHRG,11)
...I LN>(IOSL-3) D HDR I QUIT Q
...Q
..Q
.Q
I PAGE>0,'$D(ZTQUEUED),'QUIT W ! D PAUSE W @IOF
Q
;
HDR ; print header
I PAGE>0,'$D(ZTQUEUED) D PAUSE W @IOF I $G(QUIT) Q
S PAGE=PAGE+1,LN=8
W !,"Indian Attestation Copay Exemption Report",?66,EXTDT,?120,"Page: ",PAGE
W !,"Indian Attestation Change dates: ",$$FMTE^XLFDT(IBSTART)," - ",$$FMTE^XLFDT(IBEND)
W !!,"Bills with Indian Attestation Status = Y : Eligible for possible cancellation."
W !,"Bills with Indian Attestation Status = N : Eligible for possible re-billing."
W !
W !," Indian Change Indian Bill From Bill To Bill"
W !,"Name ID Date/Time Status Bill # Charge Type Bill Status Date Date Amount"
W ! D DASH(132)
Q
;
DASH(LEN) ; print line of dashes
N DASH
S $P(DASH,"-",LEN+1)="" W DASH
Q
;
PATID(DFN) ; returns Id for a given patient
;
; DFN - patient's DFN
;
; returns [first letter of the last name]_[last 4 digits of the SSN for a given patient] ^ patient name, or "" if unable to get the Id
;
N IBNM,VADM
I +$G(DFN)'>0 Q ""
D DEM^VADPT
S IBNM=VADM(1)
Q $E(IBNM,1)_$P($P(VADM(2),U,2),"-",3)_U_IBNM
;
ASKDT ; prompt for start and end dates
;
; sets IBSTART and IBEND vars to start date and end date respectively, sets QUIT=1 on user exit
;
N DIR,DUOUT,DTOUT,DIRUT,X,Y
S DIR(0)="D^::EX"
S DIR("A")="Start with Indian Attestation Change date"
S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-7),"1D")
S DIR("?")=" Please enter a valid start date."
D ^DIR
I $D(DIRUT) S QUIT=1 G ASKDTX
S IBSTART=Y
; End date
ASKDT1 ;
S DIR("A")=" End with Indian Attestation Change date"
S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT),"1D")
S DIR("?",1)=" Please enter a valid end date."
S DIR("?")=" This date must not precede the start date entered above."
D ^DIR
I $D(DIRUT) S QUIT=1 G ASKDTX
I Y<IBSTART W !," End Date must not precede the Start Date." G ASKDT1
S IBEND=Y
;
ASKDTX ; dates prompt exit point
Q
;
PAUSE ; "Type <Enter> to continue" prompt
N DIR,DUOUT,DTOUT,DIRUT,X,Y
S DIR(0)="E" D ^DIR
I $D(DIRUT) S QUIT=1
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBINRPT 6485 printed Apr 09, 2024@21:03:51 Page 2
IBINRPT ;YMG/EDE - Indian Attestation (MEGABUS Act) Copay Exemption Report ;NOV 23 2021
+1 ;;2.0;INTEGRATED BILLING;**716**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to FILE #2 in ICR #7300
+5 ;
+6 QUIT
+7 ;
EN ; entry point
+1 NEW EXCEL,IBEND,IBSTART,QUIT
+2 NEW POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
+3 KILL ^TMP("IBINRPT",$JOB)
+4 WRITE !!,"Indian Attestation Copay Exemption Report",!
+5 ; ask for dates
+6 SET QUIT=0
DO ASKDT
IF QUIT
QUIT
+7 ; export to Excel?
+8 SET EXCEL=$$GETEXCEL^IBUCMM()
IF EXCEL<0
QUIT
+9 IF EXCEL
DO PRTEXCEL^IBUCMM()
+10 IF 'EXCEL
WRITE !!,"This report requires 132 column display.",!
+11 ; ask for device
+12 KILL IOP,IO("Q")
+13 SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
if POP
QUIT
+14 ; queued report
IF $DATA(IO("Q"))
Begin DoDot:1
+15 SET ZTDESC="Indian Attestation Copay Exemption Report"
SET ZTRTN="COMPILE^IBINRPT"
+16 SET ZTSAVE("EXCEL")=""
SET ZTSAVE("IBEND")=""
SET ZTSAVE("IBSTART")=""
SET ZTSAVE("ZTREQ")="@"
+17 DO ^%ZTLOAD
DO HOME^%ZIS
+18 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
DO PAUSE
+19 QUIT
End DoDot:1
QUIT
+20 DO COMPILE
+21 QUIT
+22 ;
COMPILE ; compile report
+1 NEW IBBLNO,IBCHRG,IBCHTYPE,IBDATA,IBDFN,IBFR,IBGRP,IBIEN,IBINDTM,IBINFLG,IBINSTDT,IBNM,IBPID,IBSTATNM,IBTO,Z
+2 SET IBINDTM=IBSTART-.001
FOR
SET IBINDTM=$ORDER(^DPT("AINC",IBINDTM))
if 'IBINDTM!($PIECE(IBINDTM,".")>IBEND)
QUIT
Begin DoDot:1
+3 SET IBDFN=0
FOR
SET IBDFN=$ORDER(^DPT("AINC",IBINDTM,IBDFN))
if 'IBDFN
QUIT
Begin DoDot:2
+4 SET Z=$$INDGET^IBINUT1(IBDFN)
+5 ; indian self-identification flag (Y/N)
SET IBINFLG=$PIECE(Z,U)
+6 ; indian self-identification start date
SET IBINSTDT=$PIECE(Z,U,2)
+7 SET IBIEN=0
FOR
SET IBIEN=$ORDER(^IB("C",IBDFN,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:3
+8 ; file 350 node 0
SET IBDATA=^IB(IBIEN,0)
+9 ; "Bill To" date
SET IBTO=+$PIECE(IBDATA,U,15)
+10 ; bill timeframe is not covered by exemption
IF '$$INDCHKDT^IBINUT1(IBTO,IBINSTDT)
QUIT
+11 ; bill status (350/.05) - external
SET IBSTATNM=$$GET1^DIQ(350,IBIEN_",",.05,"E")
+12 ; check bill status
+13 IF IBINFLG="Y"
IF "^BILLED^HOLD - RATE^HOLD - REVIEW^ON HOLD^"'[(U_IBSTATNM_U)
QUIT
+14 IF IBINFLG'="Y"
IF IBSTATNM'="CANCELLED"
QUIT
+15 ; charge type (350/.03)
SET IBCHTYPE=$PIECE(IBDATA,U,3)
if IBCHTYPE=""
QUIT
+16 ; quit if LTC or Tricare charge
SET IBGRP=$PIECE(^IBE(350.1,IBCHTYPE,0),U,11)
IF IBGRP=7!(IBGRP=9)
QUIT
+17 if $$GET1^DIQ(350.1,IBCHTYPE,.05,"E")'="NEW"
QUIT
+18 ; bill #
SET IBBLNO=$PIECE(IBDATA,U,11)
+19 ; patient id and name
SET Z=$$PATID(IBDFN)
SET IBPID=$PIECE(Z,U)
SET IBNM=$PIECE(Z,U,2)
+20 ; bill amount (350/.07)
SET IBCHRG=$PIECE(IBDATA,U,7)
+21 ; "Bill From" date
SET IBFR=$PIECE(IBDATA,U,14)
+22 SET ^TMP("IBINRPT",$JOB,IBDFN,IBIEN)=IBNM_U_IBPID_U_IBINDTM_U_IBINFLG_U_IBBLNO_U_IBCHTYPE_U_IBSTATNM_U_IBFR_U_IBTO_U_IBCHRG
+23 SET ^TMP("IBINRPT",$JOB,"IDX",IBNM,IBDFN)=""
+24 QUIT
End DoDot:3
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 DO PRINT
+28 KILL ^TMP("IBINRPT",$JOB)
+29 QUIT
+30 ;
PRINT ; print report
+1 NEW EXTDT,IBCHRG,IBCHTYPE,IBDATA,IBDFN,IBNM,LN,PAGE,QUIT
+2 USE IO
+3 SET (PAGE,QUIT)=0
+4 SET EXTDT=$$FMTE^XLFDT(DT)
+5 IF EXCEL
Begin DoDot:1
+6 WRITE !,"Indian Attestation Copay Exemption Report",U,EXTDT,U,$$FMTE^XLFDT(IBSTART),"-",$$FMTE^XLFDT(IBEND)
+7 WRITE !,"Name^ID^Indian change date/time^Indian status^Bill #^Charge type^Bill status^Bill From date^Bill To Date^Bill amount"
+8 QUIT
End DoDot:1
+9 IF 'EXCEL
Begin DoDot:1
+10 IF $EXTRACT(IOST,1,2)["C-"
IF '$DATA(ZTQUEUED)
WRITE @IOF
+11 DO HDR
+12 QUIT
End DoDot:1
+13 IF '$DATA(^TMP("IBINRPT",$JOB))
Begin DoDot:1
+14 IF EXCEL
WRITE !!,"No records found."
QUIT
+15 WRITE !!,$$CJ^XLFSTR("No records found.",132)
+16 IF PAGE>0
IF '$DATA(ZTQUEUED)
WRITE !
DO PAUSE
WRITE @IOF
+17 QUIT
End DoDot:1
QUIT
+18 SET IBNM=""
FOR
SET IBNM=$ORDER(^TMP("IBINRPT",$JOB,"IDX",IBNM))
if IBNM=""!QUIT
QUIT
Begin DoDot:1
+19 SET IBDFN=""
FOR
SET IBDFN=$ORDER(^TMP("IBINRPT",$JOB,"IDX",IBNM,IBDFN))
if IBDFN=""!QUIT
QUIT
Begin DoDot:2
+20 SET IBIEN=""
FOR
SET IBIEN=$ORDER(^TMP("IBINRPT",$JOB,IBDFN,IBIEN))
if IBIEN=""!QUIT
QUIT
Begin DoDot:3
+21 SET IBDATA=^TMP("IBINRPT",$JOB,IBDFN,IBIEN)
+22 SET IBCHTYPE=$$GET1^DIQ(350.1,$PIECE(IBDATA,U,6),.01,"E")
+23 SET IBCHRG=$FNUMBER($PIECE(IBDATA,U,10),"",2)
+24 IF EXCEL
Begin DoDot:4
+25 WRITE !,$PIECE(IBDATA,U),U,$PIECE(IBDATA,U,2),U,$$FMTE^XLFDT($PIECE(IBDATA,U,3),"2Z"),U,$PIECE(IBDATA,U,4),U,$PIECE(IBDATA,U,5),U,IBCHTYPE,U,$PIECE(IBDATA,U,7),U
+26 WRITE $$FMTE^XLFDT($PIECE(IBDATA,U,8),"2DZ"),U,$$FMTE^XLFDT($PIECE(IBDATA,U,9),"2DZ"),U,IBCHRG
+27 QUIT
End DoDot:4
QUIT
+28 SET LN=LN+1
+29 WRITE !,$EXTRACT($PIECE(IBDATA,U),1,25),?27,$PIECE(IBDATA,U,2),?34,$$FMTE^XLFDT($PIECE(IBDATA,U,3),"2Z"),?54,$PIECE(IBDATA,U,4),?59,$$CJ^XLFSTR($PIECE(IBDATA,U,5),12),?72
+30 WRITE $EXTRACT(IBCHTYPE,1,12),?86,$$CJ^XLFSTR($PIECE(IBDATA,U,7),13),?101,$$FMTE^XLFDT($PIECE(IBDATA,U,8),"2DZ"),?112,$$FMTE^XLFDT($PIECE(IBDATA,U,9),"2DZ"),?121,$$CJ^XLFSTR("$"_IBCHRG,11)
+31 IF LN>(IOSL-3)
DO HDR
IF QUIT
QUIT
+32 QUIT
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 IF PAGE>0
IF '$DATA(ZTQUEUED)
IF 'QUIT
WRITE !
DO PAUSE
WRITE @IOF
+36 QUIT
+37 ;
HDR ; print header
+1 IF PAGE>0
IF '$DATA(ZTQUEUED)
DO PAUSE
WRITE @IOF
IF $GET(QUIT)
QUIT
+2 SET PAGE=PAGE+1
SET LN=8
+3 WRITE !,"Indian Attestation Copay Exemption Report",?66,EXTDT,?120,"Page: ",PAGE
+4 WRITE !,"Indian Attestation Change dates: ",$$FMTE^XLFDT(IBSTART)," - ",$$FMTE^XLFDT(IBEND)
+5 WRITE !!,"Bills with Indian Attestation Status = Y : Eligible for possible cancellation."
+6 WRITE !,"Bills with Indian Attestation Status = N : Eligible for possible re-billing."
+7 WRITE !
+8 WRITE !," Indian Change Indian Bill From Bill To Bill"
+9 WRITE !,"Name ID Date/Time Status Bill # Charge Type Bill Status Date Date Amount"
+10 WRITE !
DO DASH(132)
+11 QUIT
+12 ;
DASH(LEN) ; print line of dashes
+1 NEW DASH
+2 SET $PIECE(DASH,"-",LEN+1)=""
WRITE DASH
+3 QUIT
+4 ;
PATID(DFN) ; returns Id for a given patient
+1 ;
+2 ; DFN - patient's DFN
+3 ;
+4 ; returns [first letter of the last name]_[last 4 digits of the SSN for a given patient] ^ patient name, or "" if unable to get the Id
+5 ;
+6 NEW IBNM,VADM
+7 IF +$GET(DFN)'>0
QUIT ""
+8 DO DEM^VADPT
+9 SET IBNM=VADM(1)
+10 QUIT $EXTRACT(IBNM,1)_$PIECE($PIECE(VADM(2),U,2),"-",3)_U_IBNM
+11 ;
ASKDT ; prompt for start and end dates
+1 ;
+2 ; sets IBSTART and IBEND vars to start date and end date respectively, sets QUIT=1 on user exit
+3 ;
+4 NEW DIR,DUOUT,DTOUT,DIRUT,X,Y
+5 SET DIR(0)="D^::EX"
+6 SET DIR("A")="Start with Indian Attestation Change date"
+7 SET DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-7),"1D")
+8 SET DIR("?")=" Please enter a valid start date."
+9 DO ^DIR
+10 IF $DATA(DIRUT)
SET QUIT=1
GOTO ASKDTX
+11 SET IBSTART=Y
+12 ; End date
ASKDT1 ;
+1 SET DIR("A")=" End with Indian Attestation Change date"
+2 SET DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT),"1D")
+3 SET DIR("?",1)=" Please enter a valid end date."
+4 SET DIR("?")=" This date must not precede the start date entered above."
+5 DO ^DIR
+6 IF $DATA(DIRUT)
SET QUIT=1
GOTO ASKDTX
+7 IF Y<IBSTART
WRITE !," End Date must not precede the Start Date."
GOTO ASKDT1
+8 SET IBEND=Y
+9 ;
ASKDTX ; dates prompt exit point
+1 QUIT
+2 ;
PAUSE ; "Type <Enter> to continue" prompt
+1 NEW DIR,DUOUT,DTOUT,DIRUT,X,Y
+2 SET DIR(0)="E"
DO ^DIR
+3 IF $DATA(DIRUT)
SET QUIT=1
+4 WRITE !
+5 QUIT
