- 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 Jan 18, 2025@03:16:14 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