IBCNERP4 ;DAOU/BHS - IBCNE USER INTERFACE eIV PAYER REPORT ;03-JUN-2002
;;2.0;INTEGRATED BILLING;**184,271,300,416,528,668,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; eIV - Insurance Verification Interface
;
; IB*737/TAZ - Remove refrences to ~NO PAYER
;
; Input parameter: N/A
; Other relevant variables:
; IBCNERTN = "IBCNERP4" (current routine name for queueing the
; COMPILE process)
; IBCNESPC("BEGDT") = start date for date range
; IBCNESPC("ENDDT") = end date for date range
; IBCNESPC("PYR") = payer ien for report, if = "", then include all
; IBCNESPC("SORT") = 1 - Payer name OR 2 - Total Inqs (PAYER)
; IBCNESPC("DTL") = 1 - YES OR 0 - NO Include Rejection Detail in
; report output - rejections broken down by code
;
; Enter only from EN tag
;
; Added tag DATA as split out from program IBCNERP5 for size restrictions
QUIT
;
; Entry point
EN ;
; Initialize variables
NEW STOP,IBCNERTN,POP,IBCNESPC,IBOUT
;
S STOP=0
S IBCNERTN="IBCNERP4"
W @IOF
W !,"eIV Payer Report",!
W !,"Insurance verification inquiries are created daily."
W !,"Select a date range in which inquiries were created by the eIV extracts."
;
; Prompts for Payer Report
; Date Range parameters
P10 D DTRANGE I STOP G EXIT
; Payer Selection parameter
P20 D PYRSEL^IBCNERP1 I STOP G:$$STOP^IBCNERP1 EXIT G P10
; Include Rejection Detail in Payer report
P30 D REJDTL I STOP G:$$STOP^IBCNERP1 EXIT G P20
; Sort by parameter - Payer or Total Inquiries
P40 D SORT I STOP G:$$STOP^IBCNERP1 EXIT G P30
; Select the output type
P60 S IBOUT=$$OUT I STOP G:$$STOP^IBCNERP1 EXIT G P40
; Select the output device
P100 D DEVICE^IBCNERP1(IBCNERTN,.IBCNESPC,IBOUT) I STOP G:$$STOP^IBCNERP1 EXIT G P40
;
EXIT ; Quit this routine
QUIT
;
;
SORT ; Prompt to allow users to sort the report
; by Payer(default) OR Total Inquiries, then Payer
; Initialize variables
NEW DIR,X,Y,DIRUT
;
S DIR(0)="S^1:Payer Name;2:Total Inquiries"
S DIR("A")=" Select the primary sort field"
S DIR("B")=1
S DIR("?",1)=" 1 - Payer Name is the only sort. (Default)"
S DIR("?",2)=" 2 - Total Inquiries is the primary sort, Payer Name is"
S DIR("?")=" the secondary sort."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G SORTX
S IBCNESPC("SORT")=Y
;
SORTX ; SORT exit point
QUIT
;
;
REJDTL ; Prompt to allow users to include the Rejection Detail in the report
; Initialize variables
NEW DIR,X,Y,DIRUT
;
S DIR(0)="Y"
S DIR("A")=" Include Rejection Detail"
S DIR("B")="NO"
S DIR("?",1)=" N - No, exclude Rejection Detail totals from report. (Default)"
S DIR("?")=" Y - Yes, include Rejection Detail totals in report."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G REJDTLX
S IBCNESPC("DTL")=Y
;
REJDTLX ; REJDTL exit point
QUIT
;
;
DTRANGE ; Determine the start and end dates for the date range parameter
; Initialize variables
NEW X,Y,DIRUT
;
W !
;
S DIR(0)="D^::EX"
S DIR("A")="Start DATE"
S DIR("?",1)=" Please enter a valid date for which an eIV Inquiry"
S DIR("?")=" would have been created."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G DTRANGX
S IBCNESPC("BEGDT")=Y
; End date
DTRANG1 S DIR(0)="D^::EX"
S DIR("A")=" End DATE"
S DIR("?",1)=" Please enter a valid date for which an eIV Inquiry"
S DIR("?",2)=" would have been created. This date must not precede"
S DIR("?")=" the Start Date."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G DTRANGX
I Y<IBCNESPC("BEGDT") D G DTRANG1
. W !," End Date must not precede the Start Date."
. W !," Please reenter."
S IBCNESPC("ENDDT")=Y
;
DTRANGX ; DTRANGE exit point
QUIT
;
;
; called from IBCNERP5
; Loop through the eIV Response File (#365)
; By DATE/TIME RECEIVED & PAYER & PATIENT Cross-Reference ("AE")
;
;IB*737/TAZ - Remove references to Most Popular Payer and "~NO PAYER"
DATA N DEACT,RDATA,RDATA1,TQDATA,IBCNEDT,IBCNEPTR,IBCNEPAT,RPYRIEN,RPYNM,PYRIEN,IBPNM,ERRCON
N IBPIEN,PC,ERR,ERRTXT,PYRNM,APIEN,IBCNEPTD,TQIEN
S IBCNEDT=$O(^IBCN(365,"AD",IBCNEDT1),-1)
F S IBCNEDT=$O(^IBCN(365,"AD",IBCNEDT)) Q:IBCNEDT=""!($P(IBCNEDT,".",1)>IBCNEDT2) D Q:$G(ZTSTOP)
. I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 QUIT
. S IBCNEPAT=0
. F S IBCNEPAT=$O(^IBCN(365,"AD",IBCNEDT,IBCNEPAT)) Q:'IBCNEPAT D Q:$G(ZTSTOP)
.. S IBCNEPTD=0
.. F S IBCNEPTD=$O(^IBCN(365,"AD",IBCNEDT,IBCNEPAT,IBCNEPTD)) Q:'IBCNEPTD D Q:$G(ZTSTOP)
... S IBCNEPTR=0
... F S IBCNEPTR=$O(^IBCN(365,"AD",IBCNEDT,IBCNEPAT,IBCNEPTD,IBCNEPTR)) Q:'IBCNEPTR D Q:$G(ZTSTOP)
.... ; Get data from Resp File
.... S RDATA=$G(^IBCN(365,IBCNEPTR,0))
.... I RDATA="" Q
.... ; ONLY select Transmission status 3
.... I $P($G(RDATA),U,6)'=3 Q
.... ; Determine Payer name from Payer File (#365.12)
.... S RPYRIEN=$P($G(RDATA),U,3)
.... I 'RPYRIEN Q
.... ; Check payer filter
.... I IBCNEPY'="",RPYRIEN'=IBCNEPY Q
.... S RPYNM=$P($G(^IBE(365.12,RPYRIEN,0)),U)
.... I RPYNM="" Q
.... ; link to TQ file
.... S TQIEN=$P($G(RDATA),U,5)
.... I TQIEN="" Q
.... ; Get data from TQ file (365.1)
.... S TQDATA=$G(^IBCN(365.1,TQIEN,0))
.... I TQDATA="" Q
.... ; Get TQ Payer from (365.1) File
.... S PYRIEN=$P($G(TQDATA),U,3) Q:PYRIEN=""
.... S PYRNM=$P($G(^IBE(365.12,PYRIEN,0)),U)
.... ; Cancelled (7) - Payer deactivated
.... I $P($G(TQDATA),U,4)=7 Q
.... ;IB*668/TAZ - Call PYRDEACT to get Payer Deactivated from new file location.
.... ; Determine Deactivation DTM for eIV application
.... S DEACT=$$PYRDEACT^IBCNINSU(RPYRIEN)
.... I +DEACT S $P(^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*"),U,11)=$P(DEACT,U,2)
.... ; Determine Deactivation DTM for eIV application
.... I PYRIEN'=RPYRIEN D
..... S DEACT=$$PYRDEACT^IBCNINSU(PYRIEN)
..... I +DEACT S $P(^TMP($J,IBCNERTN,PYNM,PYRIEN,"*"),U,11)=$P(DEACT,U,2)
.... ; Get error text
.... S ERRTXT=$G(^IBCN(365,IBCNEPTR,4))
.... ; Now get the data from Response file for the report
.... S RDATA1=$G(^IBCN(365,IBCNEPTR,1)),ERRCON=$P($G(RDATA1),U,14)
.... ; Increment for non-error (GOOD) response and quit
.... I ERRCON="",ERRTXT="" D Q
..... S $P(^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*"),U,6)=$P($G(^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*")),U,6)+1
.... ; Rejection is defined as having a value in the Error Condition field or Error Text field
.... ; Increment for error response
.... S $P(^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*"),U,7)=$P($G(^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*")),U,7)+1
.... ; Store rejection detail only if user requested it
.... I 'IBCNEDTL Q
.... I ERRCON S ^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*",ERRCON)=$G(^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*",ERRCON))+1
.... I 'ERRCON,ERRTXT'="" S ^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*",0_U_ERRTXT)=$G(^TMP($J,IBCNERTN,RPYNM,RPYRIEN,"*",0_U_ERRTXT))+1
Q
;
OUT() ; Prompt to allow users to select output format
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR I $D(DIRUT) S STOP=1 Q ""
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERP4 7142 printed Apr 09, 2024@21:33:24 Page 2
IBCNERP4 ;DAOU/BHS - IBCNE USER INTERFACE eIV PAYER REPORT ;03-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,300,416,528,668,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; eIV - Insurance Verification Interface
+5 ;
+6 ; IB*737/TAZ - Remove refrences to ~NO PAYER
+7 ;
+8 ; Input parameter: N/A
+9 ; Other relevant variables:
+10 ; IBCNERTN = "IBCNERP4" (current routine name for queueing the
+11 ; COMPILE process)
+12 ; IBCNESPC("BEGDT") = start date for date range
+13 ; IBCNESPC("ENDDT") = end date for date range
+14 ; IBCNESPC("PYR") = payer ien for report, if = "", then include all
+15 ; IBCNESPC("SORT") = 1 - Payer name OR 2 - Total Inqs (PAYER)
+16 ; IBCNESPC("DTL") = 1 - YES OR 0 - NO Include Rejection Detail in
+17 ; report output - rejections broken down by code
+18 ;
+19 ; Enter only from EN tag
+20 ;
+21 ; Added tag DATA as split out from program IBCNERP5 for size restrictions
+22 QUIT
+23 ;
+24 ; Entry point
EN ;
+1 ; Initialize variables
+2 NEW STOP,IBCNERTN,POP,IBCNESPC,IBOUT
+3 ;
+4 SET STOP=0
+5 SET IBCNERTN="IBCNERP4"
+6 WRITE @IOF
+7 WRITE !,"eIV Payer Report",!
+8 WRITE !,"Insurance verification inquiries are created daily."
+9 WRITE !,"Select a date range in which inquiries were created by the eIV extracts."
+10 ;
+11 ; Prompts for Payer Report
+12 ; Date Range parameters
P10 DO DTRANGE
IF STOP
GOTO EXIT
+1 ; Payer Selection parameter
P20 DO PYRSEL^IBCNERP1
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P10
+1 ; Include Rejection Detail in Payer report
P30 DO REJDTL
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P20
+1 ; Sort by parameter - Payer or Total Inquiries
P40 DO SORT
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P30
+1 ; Select the output type
P60 SET IBOUT=$$OUT
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P40
+1 ; Select the output device
P100 DO DEVICE^IBCNERP1(IBCNERTN,.IBCNESPC,IBOUT)
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P40
+1 ;
EXIT ; Quit this routine
+1 QUIT
+2 ;
+3 ;
SORT ; Prompt to allow users to sort the report
+1 ; by Payer(default) OR Total Inquiries, then Payer
+2 ; Initialize variables
+3 NEW DIR,X,Y,DIRUT
+4 ;
+5 SET DIR(0)="S^1:Payer Name;2:Total Inquiries"
+6 SET DIR("A")=" Select the primary sort field"
+7 SET DIR("B")=1
+8 SET DIR("?",1)=" 1 - Payer Name is the only sort. (Default)"
+9 SET DIR("?",2)=" 2 - Total Inquiries is the primary sort, Payer Name is"
+10 SET DIR("?")=" the secondary sort."
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
SET STOP=1
GOTO SORTX
+13 SET IBCNESPC("SORT")=Y
+14 ;
SORTX ; SORT exit point
+1 QUIT
+2 ;
+3 ;
REJDTL ; Prompt to allow users to include the Rejection Detail in the report
+1 ; Initialize variables
+2 NEW DIR,X,Y,DIRUT
+3 ;
+4 SET DIR(0)="Y"
+5 SET DIR("A")=" Include Rejection Detail"
+6 SET DIR("B")="NO"
+7 SET DIR("?",1)=" N - No, exclude Rejection Detail totals from report. (Default)"
+8 SET DIR("?")=" Y - Yes, include Rejection Detail totals in report."
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
SET STOP=1
GOTO REJDTLX
+11 SET IBCNESPC("DTL")=Y
+12 ;
REJDTLX ; REJDTL exit point
+1 QUIT
+2 ;
+3 ;
DTRANGE ; Determine the start and end dates for the date range parameter
+1 ; Initialize variables
+2 NEW X,Y,DIRUT
+3 ;
+4 WRITE !
+5 ;
+6 SET DIR(0)="D^::EX"
+7 SET DIR("A")="Start DATE"
+8 SET DIR("?",1)=" Please enter a valid date for which an eIV Inquiry"
+9 SET DIR("?")=" would have been created."
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET STOP=1
GOTO DTRANGX
+12 SET IBCNESPC("BEGDT")=Y
+13 ; End date
DTRANG1 SET DIR(0)="D^::EX"
+1 SET DIR("A")=" End DATE"
+2 SET DIR("?",1)=" Please enter a valid date for which an eIV Inquiry"
+3 SET DIR("?",2)=" would have been created. This date must not precede"
+4 SET DIR("?")=" the Start Date."
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
SET STOP=1
GOTO DTRANGX
+7 IF Y<IBCNESPC("BEGDT")
Begin DoDot:1
+8 WRITE !," End Date must not precede the Start Date."
+9 WRITE !," Please reenter."
End DoDot:1
GOTO DTRANG1
+10 SET IBCNESPC("ENDDT")=Y
+11 ;
DTRANGX ; DTRANGE exit point
+1 QUIT
+2 ;
+3 ;
+4 ; called from IBCNERP5
+5 ; Loop through the eIV Response File (#365)
+6 ; By DATE/TIME RECEIVED & PAYER & PATIENT Cross-Reference ("AE")
+7 ;
+8 ;IB*737/TAZ - Remove references to Most Popular Payer and "~NO PAYER"
DATA NEW DEACT,RDATA,RDATA1,TQDATA,IBCNEDT,IBCNEPTR,IBCNEPAT,RPYRIEN,RPYNM,PYRIEN,IBPNM,ERRCON
+1 NEW IBPIEN,PC,ERR,ERRTXT,PYRNM,APIEN,IBCNEPTD,TQIEN
+2 SET IBCNEDT=$ORDER(^IBCN(365,"AD",IBCNEDT1),-1)
+3 FOR
SET IBCNEDT=$ORDER(^IBCN(365,"AD",IBCNEDT))
if IBCNEDT=""!($PIECE(IBCNEDT,".",1)>IBCNEDT2)
QUIT
Begin DoDot:1
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+5 SET IBCNEPAT=0
+6 FOR
SET IBCNEPAT=$ORDER(^IBCN(365,"AD",IBCNEDT,IBCNEPAT))
if 'IBCNEPAT
QUIT
Begin DoDot:2
+7 SET IBCNEPTD=0
+8 FOR
SET IBCNEPTD=$ORDER(^IBCN(365,"AD",IBCNEDT,IBCNEPAT,IBCNEPTD))
if 'IBCNEPTD
QUIT
Begin DoDot:3
+9 SET IBCNEPTR=0
+10 FOR
SET IBCNEPTR=$ORDER(^IBCN(365,"AD",IBCNEDT,IBCNEPAT,IBCNEPTD,IBCNEPTR))
if 'IBCNEPTR
QUIT
Begin DoDot:4
+11 ; Get data from Resp File
+12 SET RDATA=$GET(^IBCN(365,IBCNEPTR,0))
+13 IF RDATA=""
QUIT
+14 ; ONLY select Transmission status 3
+15 IF $PIECE($GET(RDATA),U,6)'=3
QUIT
+16 ; Determine Payer name from Payer File (#365.12)
+17 SET RPYRIEN=$PIECE($GET(RDATA),U,3)
+18 IF 'RPYRIEN
QUIT
+19 ; Check payer filter
+20 IF IBCNEPY'=""
IF RPYRIEN'=IBCNEPY
QUIT
+21 SET RPYNM=$PIECE($GET(^IBE(365.12,RPYRIEN,0)),U)
+22 IF RPYNM=""
QUIT
+23 ; link to TQ file
+24 SET TQIEN=$PIECE($GET(RDATA),U,5)
+25 IF TQIEN=""
QUIT
+26 ; Get data from TQ file (365.1)
+27 SET TQDATA=$GET(^IBCN(365.1,TQIEN,0))
+28 IF TQDATA=""
QUIT
+29 ; Get TQ Payer from (365.1) File
+30 SET PYRIEN=$PIECE($GET(TQDATA),U,3)
if PYRIEN=""
QUIT
+31 SET PYRNM=$PIECE($GET(^IBE(365.12,PYRIEN,0)),U)
+32 ; Cancelled (7) - Payer deactivated
+33 IF $PIECE($GET(TQDATA),U,4)=7
QUIT
+34 ;IB*668/TAZ - Call PYRDEACT to get Payer Deactivated from new file location.
+35 ; Determine Deactivation DTM for eIV application
+36 SET DEACT=$$PYRDEACT^IBCNINSU(RPYRIEN)
+37 IF +DEACT
SET $PIECE(^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*"),U,11)=$PIECE(DEACT,U,2)
+38 ; Determine Deactivation DTM for eIV application
+39 IF PYRIEN'=RPYRIEN
Begin DoDot:5
+40 SET DEACT=$$PYRDEACT^IBCNINSU(PYRIEN)
+41 IF +DEACT
SET $PIECE(^TMP($JOB,IBCNERTN,PYNM,PYRIEN,"*"),U,11)=$PIECE(DEACT,U,2)
End DoDot:5
+42 ; Get error text
+43 SET ERRTXT=$GET(^IBCN(365,IBCNEPTR,4))
+44 ; Now get the data from Response file for the report
+45 SET RDATA1=$GET(^IBCN(365,IBCNEPTR,1))
SET ERRCON=$PIECE($GET(RDATA1),U,14)
+46 ; Increment for non-error (GOOD) response and quit
+47 IF ERRCON=""
IF ERRTXT=""
Begin DoDot:5
+48 SET $PIECE(^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*"),U,6)=$PIECE($GET(^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*")),U,6)+1
End DoDot:5
QUIT
+49 ; Rejection is defined as having a value in the Error Condition field or Error Text field
+50 ; Increment for error response
+51 SET $PIECE(^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*"),U,7)=$PIECE($GET(^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*")),U,7)+1
+52 ; Store rejection detail only if user requested it
+53 IF 'IBCNEDTL
QUIT
+54 IF ERRCON
SET ^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*",ERRCON)=$GET(^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*",ERRCON))+1
+55 IF 'ERRCON
IF ERRTXT'=""
SET ^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*",0_U_ERRTXT)=$GET(^TMP($JOB,IBCNERTN,RPYNM,RPYRIEN,"*",0_U_ERRTXT))+1
End DoDot:4
if $GET(ZTSTOP)
QUIT
End DoDot:3
if $GET(ZTSTOP)
QUIT
End DoDot:2
if $GET(ZTSTOP)
QUIT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+56 QUIT
+57 ;
OUT() ; Prompt to allow users to select output format
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
QUIT ""
+7 QUIT Y
