IBCNERPJ ;IB/BAA/AWC - IBCNE EIV HL7 RESPONSE REPORT;25 Feb 2015
;;2.0;INTEGRATED BILLING;**528,668,737,763**;21-MAR-94;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
; Variables:
; IB*763/TAZ - Change IBCNERTN comment to reference proper routine.
; IBCNERTN = "IBCNERPJ" (current routine name for queueing the
; COMPILE process)
; INCNESPJ("BEGDT") = start date for date range
; INCNESPJ("ENDDT") = end date for date range
; INCNESPJ("PYR",ien) = payer iens for report, if INCNESPJ("PYR")="A", then include all
; IBCNESPJ("PAT",ien) = patient iens for report, if IBCNESPJ("PAT")="A", then include all
; INCNESPJ("TYPE") = report type: "R" - Report, "E" - Excel
;
Q
EN ; entry point
N STOP,IBCNERTN,INCNESPJ,I,IBCNESPJ
;
I $G(DT)="" S DT=$$DT^XLFDT ; IB*737/DTG make sure system date is there
;
S STOP=0,IBCNERTN="IBCNERPJ"
K ^TMP($J,IBCNERTN)
W @IOF
W !,"eIV HL7 Response Report",!
; Prompts for HL7 Response Report
; Report Type - Report or Excel
P10 D TYPE I STOP G EXIT
; Payer Selection parameter
P20 D PAYER I STOP G:$$STOP^IBCNERP1 EXIT G P10
; Date Range parameters
P30 D DTRANGE I STOP G:$$STOP^IBCNERP1 EXIT G P20
; Patient Selection parameter
P40 D PATIENT I STOP G:$$STOP^IBCNERP1 EXIT G P30
; Select the output device
P100 D DEVICE
;
EXIT ;
Q
;
PAYER ;
;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR("A")="Run for (A)ll Payers or (S)elected Payers: "
S DIR("A",1)="PAYER SELECTION:"
S DIR(0)="SA^A:All;S:Selected",DIR("B")="A"
D ^DIR
I $D(DIRUT) S STOP=1 Q
I Y="A" S INCNESPJ("PYR")="A" Q ; "All Payers" selected
S DIC(0)="ABEQ"
S DIC("A")="Select Payer(s): "
; Do not allow selection of non-eIV payers
;IB*668/TAZ - Changed Payer Application from IIV to EIV
S DIC("S")="I $$PYRAPP^IBCNEUT5(""EIV"",$G(Y))'="""""
S DIC="^IBE(365.12,"
PAYER1 ;
D ^DIC
I $D(DUOUT)!$D(DTOUT)!(Y=-1) S STOP=1 K INCNESPJ("PYR") Q
S INCNESPJ("PYR",$P(Y,U,1))=""
I $$ANOTHER G PAYER1
Q
;
PATIENT ;
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
; summary report is always run for all patients
W !
S DIR("A")="Run for (A)ll Patients or (S)elected Patients: "
S DIR("A",1)="PATIENT SELECTION:"
S DIR(0)="SA^A:All;S:Selected",DIR("B")="A"
D ^DIR
I $D(DIRUT) S STOP=1 Q
I Y="A" S INCNESPJ("PAT")="A" Q ; "All Patients" selected
S DIC(0)="ABEQ"
S DIC("A")="Select Patient: "
S DIC="^DPT("
PATIENT1 ;
D ^DIC
I $D(DUOUT)!$D(DTOUT)!(Y=-1) S STOP=1 K IBCNESPC("PAT") Q
S INCNESPJ("PAT",$P(Y,U,1))=""
I $$ANOTHER G PATIENT1
Q
;
DTRANGE ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
;S DIR(0)="D^::EX",DIR("B")="Today"
S DIR(0)="D^:DT:EX",DIR("B")="Today" ; IB*737/DTG max is current Date
S DIR("A")="Earliest Date Received"
S DIR("A",1)="RESPONSE RECEIVED DATE RANGE SELECTION:"
D ^DIR I $D(DIRUT) S STOP=1 Q
S INCNESPJ("BEGDT")=Y
; End date
DTRANGE1 ;
K DIR("A") S DIR("A")=" Latest Date Received"
D ^DIR I $D(DIRUT) S STOP=1 Q
I Y<INCNESPJ("BEGDT") W !," Latest Date must not precede the Earliest Date." G DTRANGE1
S INCNESPJ("ENDDT")=Y
Q
;
ANOTHER() ; "Select Another" prompt
; returns 1, if response was "YES", returns 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A")="Select Another?" S DIR(0)="Y",DIR("B")="NO"
D ^DIR I $D(DIRUT) S STOP=1
Q Y
;
TYPE ;
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")="Excel"
D ^DIR I $D(DIRUT) S STOP=1 Q
S INCNESPJ("TYPE")=Y
Q
;
DEVICE ; Ask user to select device
N %ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ,POP
;
; IB*737/DTG changes to device sequence and correct queueing in this tag
N IBTYPE,IBCHK S IBTYPE=$E(INCNESPJ("TYPE"),1),IBCHK=$S(IBTYPE="R":132,1:256)
I IBTYPE="E" D
. W !!,"For CSV output, turn logging or capture on now."
. W !,"To avoid undesired wrapping of the data saved to the file,"
. W !,"please enter ""0;256;99999"" at the ""DEVICE:"" prompt.",!
;W !!,"*** You will need a 132 column printer for this report. ***",!
I IBTYPE="R" W !!,"*** You will need a 132 column printer for this report. ***",!
;
;S %ZIS="QM" D ^%ZIS G:POP ENQ
S INCNESPJ("WIDTH")=$S((+$G(IOM)>0&($G(IOM)<(IBCHK+1))):IOM,1:IBCHK)
;I $D(IO("Q")) D G ENQ
;.S ZTRTN="EN^IBCNGPF3",ZTDESC="IB - Interfacility Ins Update Activity Report"
;.F I="^TMP($J,""PR"",","IBABY","IBOUT" S ZTSAVE(I)=""
;.D ^%ZTLOAD K IO("Q") D HOME^%ZIS
;.W !!,$S($D(ZTSK):"This job has been queued as task #"_ZTSK_".",1:"Unable to queue this job.")
;.K ZTSK,IO("Q")
;
; Compile and print report
;
;U IO D EN^IBCNERPK(IBCNERTN,.INCNESPJ)
;
;D ^%ZISC
;
;I $D(ZTQUEUED) S ZTREQ="@"
S INCNESPJ("WIDTH")=IBCHK
S ZTRTN="EN^IBCNERPK(IBCNERTN,.INCNESPJ)",ZTDESC="IB - HL7 Response Report"
F I="IBCNERTN","INCNESPJ","INCNESPJ(" S ZTSAVE(I)=""
F I="IBTYPE","IBOUT","^TMP($J,IBCNERTN," S ZTSAVE(I)=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q")
;
ENQ ;
;K STOP,INCNESPJ,^TMP($J,IBCNERTN),IBCNERTN
I POP K STOP,^TMP($J,IBCNERTN),IBCNERTN,INCNESPJ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERPJ 5233 printed Dec 13, 2024@02:15:15 Page 2
IBCNERPJ ;IB/BAA/AWC - IBCNE EIV HL7 RESPONSE REPORT;25 Feb 2015
+1 ;;2.0;INTEGRATED BILLING;**528,668,737,763**;21-MAR-94;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Variables:
+5 ; IB*763/TAZ - Change IBCNERTN comment to reference proper routine.
+6 ; IBCNERTN = "IBCNERPJ" (current routine name for queueing the
+7 ; COMPILE process)
+8 ; INCNESPJ("BEGDT") = start date for date range
+9 ; INCNESPJ("ENDDT") = end date for date range
+10 ; INCNESPJ("PYR",ien) = payer iens for report, if INCNESPJ("PYR")="A", then include all
+11 ; IBCNESPJ("PAT",ien) = patient iens for report, if IBCNESPJ("PAT")="A", then include all
+12 ; INCNESPJ("TYPE") = report type: "R" - Report, "E" - Excel
+13 ;
+14 QUIT
EN ; entry point
+1 NEW STOP,IBCNERTN,INCNESPJ,I,IBCNESPJ
+2 ;
+3 ; IB*737/DTG make sure system date is there
IF $GET(DT)=""
SET DT=$$DT^XLFDT
+4 ;
+5 SET STOP=0
SET IBCNERTN="IBCNERPJ"
+6 KILL ^TMP($JOB,IBCNERTN)
+7 WRITE @IOF
+8 WRITE !,"eIV HL7 Response Report",!
+9 ; Prompts for HL7 Response Report
+10 ; Report Type - Report or Excel
P10 DO TYPE
IF STOP
GOTO EXIT
+1 ; Payer Selection parameter
P20 DO PAYER
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P10
+1 ; Date Range parameters
P30 DO DTRANGE
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P20
+1 ; Patient Selection parameter
P40 DO PATIENT
IF STOP
if $$STOP^IBCNERP1
GOTO EXIT
GOTO P30
+1 ; Select the output device
P100 DO DEVICE
+1 ;
EXIT ;
+1 QUIT
+2 ;
PAYER ;
+1 ;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
+2 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 WRITE !
+4 SET DIR("A")="Run for (A)ll Payers or (S)elected Payers: "
+5 SET DIR("A",1)="PAYER SELECTION:"
+6 SET DIR(0)="SA^A:All;S:Selected"
SET DIR("B")="A"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
SET STOP=1
QUIT
+9 ; "All Payers" selected
IF Y="A"
SET INCNESPJ("PYR")="A"
QUIT
+10 SET DIC(0)="ABEQ"
+11 SET DIC("A")="Select Payer(s): "
+12 ; Do not allow selection of non-eIV payers
+13 ;IB*668/TAZ - Changed Payer Application from IIV to EIV
+14 SET DIC("S")="I $$PYRAPP^IBCNEUT5(""EIV"",$G(Y))'="""""
+15 SET DIC="^IBE(365.12,"
PAYER1 ;
+1 DO ^DIC
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
SET STOP=1
KILL INCNESPJ("PYR")
QUIT
+3 SET INCNESPJ("PYR",$PIECE(Y,U,1))=""
+4 IF $$ANOTHER
GOTO PAYER1
+5 QUIT
+6 ;
PATIENT ;
+1 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 ; summary report is always run for all patients
+3 WRITE !
+4 SET DIR("A")="Run for (A)ll Patients or (S)elected Patients: "
+5 SET DIR("A",1)="PATIENT SELECTION:"
+6 SET DIR(0)="SA^A:All;S:Selected"
SET DIR("B")="A"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
SET STOP=1
QUIT
+9 ; "All Patients" selected
IF Y="A"
SET INCNESPJ("PAT")="A"
QUIT
+10 SET DIC(0)="ABEQ"
+11 SET DIC("A")="Select Patient: "
+12 SET DIC="^DPT("
PATIENT1 ;
+1 DO ^DIC
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
SET STOP=1
KILL IBCNESPC("PAT")
QUIT
+3 SET INCNESPJ("PAT",$PIECE(Y,U,1))=""
+4 IF $$ANOTHER
GOTO PATIENT1
+5 QUIT
+6 ;
DTRANGE ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 ;S DIR(0)="D^::EX",DIR("B")="Today"
+4 ; IB*737/DTG max is current Date
SET DIR(0)="D^:DT:EX"
SET DIR("B")="Today"
+5 SET DIR("A")="Earliest Date Received"
+6 SET DIR("A",1)="RESPONSE RECEIVED DATE RANGE SELECTION:"
+7 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
QUIT
+8 SET INCNESPJ("BEGDT")=Y
+9 ; End date
DTRANGE1 ;
+1 KILL DIR("A")
SET DIR("A")=" Latest Date Received"
+2 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
QUIT
+3 IF Y<INCNESPJ("BEGDT")
WRITE !," Latest Date must not precede the Earliest Date."
GOTO DTRANGE1
+4 SET INCNESPJ("ENDDT")=Y
+5 QUIT
+6 ;
ANOTHER() ; "Select Another" prompt
+1 ; returns 1, if response was "YES", returns 0 otherwise
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR("A")="Select Another?"
SET DIR(0)="Y"
SET DIR("B")="NO"
+4 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
+5 QUIT Y
+6 ;
TYPE ;
+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")="Excel"
+6 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
QUIT
+7 SET INCNESPJ("TYPE")=Y
+8 QUIT
+9 ;
DEVICE ; Ask user to select device
+1 NEW %ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ,POP
+2 ;
+3 ; IB*737/DTG changes to device sequence and correct queueing in this tag
+4 NEW IBTYPE,IBCHK
SET IBTYPE=$EXTRACT(INCNESPJ("TYPE"),1)
SET IBCHK=$SELECT(IBTYPE="R":132,1:256)
+5 IF IBTYPE="E"
Begin DoDot:1
+6 WRITE !!,"For CSV output, turn logging or capture on now."
+7 WRITE !,"To avoid undesired wrapping of the data saved to the file,"
+8 WRITE !,"please enter ""0;256;99999"" at the ""DEVICE:"" prompt.",!
End DoDot:1
+9 ;W !!,"*** You will need a 132 column printer for this report. ***",!
+10 IF IBTYPE="R"
WRITE !!,"*** You will need a 132 column printer for this report. ***",!
+11 ;
+12 ;S %ZIS="QM" D ^%ZIS G:POP ENQ
+13 SET INCNESPJ("WIDTH")=$SELECT((+$GET(IOM)>0&($GET(IOM)<(IBCHK+1))):IOM,1:IBCHK)
+14 ;I $D(IO("Q")) D G ENQ
+15 ;.S ZTRTN="EN^IBCNGPF3",ZTDESC="IB - Interfacility Ins Update Activity Report"
+16 ;.F I="^TMP($J,""PR"",","IBABY","IBOUT" S ZTSAVE(I)=""
+17 ;.D ^%ZTLOAD K IO("Q") D HOME^%ZIS
+18 ;.W !!,$S($D(ZTSK):"This job has been queued as task #"_ZTSK_".",1:"Unable to queue this job.")
+19 ;.K ZTSK,IO("Q")
+20 ;
+21 ; Compile and print report
+22 ;
+23 ;U IO D EN^IBCNERPK(IBCNERTN,.INCNESPJ)
+24 ;
+25 ;D ^%ZISC
+26 ;
+27 ;I $D(ZTQUEUED) S ZTREQ="@"
+28 SET INCNESPJ("WIDTH")=IBCHK
+29 SET ZTRTN="EN^IBCNERPK(IBCNERTN,.INCNESPJ)"
SET ZTDESC="IB - HL7 Response Report"
+30 FOR I="IBCNERTN","INCNESPJ","INCNESPJ("
SET ZTSAVE(I)=""
+31 FOR I="IBTYPE","IBOUT","^TMP($J,IBCNERTN,"
SET ZTSAVE(I)=""
+32 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q")
+33 ;
ENQ ;
+1 ;K STOP,INCNESPJ,^TMP($J,IBCNERTN),IBCNERTN
+2 IF POP
KILL STOP,^TMP($JOB,IBCNERTN),IBCNERTN,INCNESPJ
+3 QUIT
