IBCNERPF ;BP/YMG - IBCNE eIV AUTO UPDATE REPORT ;09-MAY-2023
;;2.0;INTEGRATED BILLING;**416,528,549,595,668,737,763,794**;21-MAR-94;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
; NOTE:
; IB*2.0*763 is a major re-write of this report. The comments from the previous patches
; have either been removed or modified to remove the patch number if the comment is relevant.
;
; Variables:
; IBCNESPC("BEGDT") = start date for date range
; IBCNESPC("ENDDT") = end date for date range
; IBCNESPC("IBOUT") = "R" for Report format or "E" for Excel format
; IBCNESPC("ICODETL") = 1 for displaying Ins Co Detail
; IBCNESPC("INSCO") = "A" (All ins. cos.) OR "S" (Selected ins. cos.)
; IBCNESPC("PYR",ien) - payer iens for report, if IBCNESPC("PYR")="A", then include all
; = (1) ^ (2)
; (1) Display insurance company detail - 0 = No / 1 = Yes
; (2) Display all or some insurance companies - A = All companies/
; S = Specified companies
; IBCNESPC("PYR",ien,coien) - payer iens and company ien for report
; = Count for insurance company
; IBCNESPC("PAT",ien) = patient iens for report, if IBCNESPC("PAT")="A", then include all
; IBCNESPC("TYPE") = report type: "S" - summary, "D" - detailed
;
Q
EN ; entry point
N IBCNESPC,STOP,TYPE
;
S STOP=0
W @IOF
W !,"eIV Auto Update Report"
;
; Report Type - Summary or Detailed
TYPE ;Type of Report
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^S:Summary;D:Detailed"
S DIR("A")="Run a (S)ummary or (D)etailed Report: "
S DIR("B")="Summary"
D ^DIR
I $D(DIRUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) G EXIT
S (TYPE,IBCNESPC("TYPE"))=Y
I TYPE="S" G SUMMARY
;
DETAIL ; Prompts in specific order for Detail report.
S IBCNESPC("ICODETL")=1
;
D10 ; Payer Selection parameter
D PAYER I STOP G:$$STOP EXIT G TYPE
;
D20 ; Date Range parameters
D DTRANGE I STOP G:$$STOP EXIT G D10
;
D30 ; Patient Selection parameter
D PATIENT I STOP G:$$STOP EXIT G D20
;
G IBOUT
;
SUMMARY ;Prompts in specific order for Summary report
;
S IBCNESPC("INSCO")="A" ;All insurance companies
S IBCNESPC("PAT")="A" ;All Patients
S IBCNESPC("PYR")="A" ;All Payers
;
S10 ;Select Payer or Source of Information
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^P:Payer;S:Source of Information"
S DIR("A")="Run for (P)ayer or (S)ource of Information: "
S DIR("?",1)="When selecting '(P)ayer', the report displays the breakout of auto updated"
S DIR("?",2)="entries based on the Payer name."
S DIR("?",3)=""
S DIR("?",4)="When selecting '(S)ource of Information', the report displays the breakout of"
S DIR("?")="auto updated entries based on the Source of Information of the entry."
D ^DIR I $D(DIRUT) G:$$STOP EXIT G TYPE
S IBCNESPC("PS")=Y
I Y="S" D G S40 ;Source of Information does not prompt for Ins Co or Payer.
. S (IBCNESPC("PYR"),IBCNESPC("PAT"))="A"
. S IBCNESPC("ICODETL")=1
;
S20 ;Prompt for Insurance Company Detail
D ICODETL I STOP G:$$STOP EXIT G S10
;
S30 ;Prompt for Payer Selection
D PAYER I STOP G:$$STOP EXIT G S20
;
S40 ; Response Received Date
D DTRANGE I STOP G:$$STOP EXIT G S10:(IBCNESPC("PS")="S") G S30
;
IBOUT ;
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 G:$$STOP EXIT G S40:TYPE="S" G D30
S IBCNESPC("IBOUT")=Y
I Y="E" D
. W !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
. W !,"of the data saved to the file, please enter ""0;"_$S(TYPE="S":"132",1:"256")_";99999"" at the ""DEVICE:"""
. W !,"prompt.",!
I $G(IBCNESPC("TYPE"))="D" W:$G(IBCNESPC("IBOUT"))="R" !!!,"*** This report is 132 characters wide ***",!
;
; Select the output device
DEVICE ; Device Handler and possible TaskManager calls
;
; Output params:
; STOP = Flag to stop routine
;
; Init vars
N POP,ZTDESC,ZTRTN,ZTSAVE
;
S ZTRTN="COMPILE^IBCNERPF(.IBCNESPC)"
S ZTDESC="IBCNE eIV Auto Update Report"
S ZTSAVE("IBCNESPC(")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
;
EXIT ;
Q
;
COMPILE(IBCNESPC) ;
; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
; Input params:
; IBCNESPC = Array passed by ref of the report params
;
; Init scratch globals
N ALLPAT,ALLPYR
K ^TMP($J,"IBCNERPF")
N IBOUT
; Compile
S IBOUT=$G(IBCNESPC("IBOUT"))
D EN^IBCNERPG(.IBCNESPC)
; Print
I '$G(ZTSTOP) D PRINT^IBCNERPG(.IBCNESPC)
; Close device
D ^%ZISC
; Kill scratch globals
K ^TMP($J,"IBCNERPF")
; Purge task record
I $D(ZTQUEUED) S ZTREQ="@"
;
COMPILX ; COMPILE exit pt
Q
;
PAYER ;
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PIEN,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
S IBCNESPC("PYR")=Y I Y="A" Q ; "All Payers" selected
S DIC(0)="ABEQ"
W !
S DIC("A")="Select Payer: "
; Only include payers with eIV Auto Update flag = Yes
S DIC("S")="I $$AUTOUPDT^IBCNERPF($P($G(Y),U,1))"
S DIC="^IBE(365.12,"
;
PAYER1 ;
D ^DIC
I $D(DUOUT)!$D(DTOUT)!(Y=-1) S STOP=1 K IBCNESPC("PYR") Q
S PIEN=$P(Y,U,1) K IBCNESPC("PYR",PIEN) S IBCNESPC("PYR",PIEN)=""
I $G(IBCNESPC("ICODETL")) D GETCOMPS(PIEN,.IBCNESPC)
W !
I $$ANOTHER("Payer") W ! G PAYER1
Q
;
AUTOUPDT(PIEN) ; Lookup screen to determine if the Auto update flag for payer = Yes
; Input: PIEN - IEN of the Payer (file 365.12)
; Returns 1 - Auto update flag is set to 'Y', 0 otherwise
N AUTOUPDT,IENS,MULT
S AUTOUPDT=0
S MULT=$$PYRAPP^IBCNEUT5("EIV",PIEN)
I MULT D
. S IENS=MULT_","_PIEN_","
. S AUTOUPDT=$$GET1^DIQ(365.121,IENS,4.01,"I")
Q AUTOUPDT
;
GETCOMPS(PIEN,IBCNESPC) ; Get companies linked to payer
; Get associated insurance companies
; If user wants to display insurance companies, prompt only for those linked to payer
; Allow the user to select none, one, or multiple insurance companies associated with a given payer
;
; Input
; PIEN - Payer ID
; IBCNESPC - Array holding payer id and related insurance companies
; Output
; IBCNESPC - Array holding payer id and related insurance companies
; IBCNESPC("PYR",PIEN) = (1)
; (1) Display all or some insurance companies - A = All companies/ S = Specified companies
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
K DIR
S DIR("A")="Run for (A)ll Insurance Companies or (S)elected Insurance Companies: "
S DIR("B")="A"
S DIR(0)="SA^A:All;S:Selected" D ^DIR
Q:$D(DIRUT)
S $P(IBCNESPC("PYR",PIEN),U)=Y
I Y="A" Q ; Run for all companies
S IBCNESPC("INSCO")="S"
K ^TMP("IBCNILKA",$J)
D EN^IBCNILK(2,PIEN,5)
I $D(^TMP("IBCNILKA",$J)) D
. M IBCNESPC("PYR",PIEN)=^TMP("IBCNILKA",$J)
K ^TMP("IBCNILKA",$J)
Q
;
ICODETL ;Display Insurance Company Detail.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IBCNS,X,Y
W !
S DIR("A")="Do you want to display insurance company detail"
S DIR("B")="NO"
S DIR(0)="Y" D ^DIR
I $D(DIRUT) S STOP=1 G ICODETLX
S IBCNESPC("ICODETL")=Y=1
ICODETLX ;
Q
;
DTRANGE ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,IBDT180
; Default start date to T-180
T180 ;
W !
S IBDT180=$$FMADD^XLFDT($$DT^XLFDT(),-180)
S DIR(0)="D^::EX",DIR("B")=$$FMTE^XLFDT(IBDT180,"D")
S DIR("A")="Earliest Date Received"
S DIR("A",1)="RESPONSE RECEIVED DATE RANGE SELECTION:"
D ^DIR I $D(DIRUT) S STOP=1 Q
I Y>DT W !!,"Future dates not allowed." G T180
I Y<IBDT180 W !!,"Response must not be previous to "_$$FMTE^XLFDT(IBDT180,"D")_"." G T180
S IBCNESPC("BEGDT")=Y
; End date
DTRANGE1 ;
S DIR("B")="Today"
K DIR("A") S DIR("A")=" Latest Date Received"
D ^DIR I $D(DIRUT) S STOP=1 Q
I Y>DT W !!,"Future dates not allowed." G DTRANGE1
I Y<IBCNESPC("BEGDT") W !," Latest Date must not precede the Earliest Date." G DTRANGE1
S IBCNESPC("ENDDT")=Y
Q
;
PATIENT ;
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
; summary report is always run for all patients
I $G(IBCNESPC("TYPE"))="S" S IBCNESPC("PAT")="A" Q
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 IBCNESPC("PAT")="A" Q ; "All Patients" selected
S DIC(0)="AMEQ" ;IB*794/DTG change ABEQ to AMEQ to allow for ssn lookup (multi-indexes)
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 IBCNESPC("PAT",$P(Y,U,1))=""
I $$ANOTHER("Patient") G PATIENT1
Q
;
ANOTHER(TYPE) ; "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 "_TYPE S DIR(0)="Y",DIR("B")="NO"
D ^DIR I $D(DIRUT) S STOP=1
Q Y
;
STOP() ; Determine if user wants to exit out of the whole option
; Init vars
N DIR,X,Y,DIRUT
;
W !
S DIR(0)="Y"
S DIR("A")="Do you want to exit out of this option entirely"
S DIR("B")="YES"
S DIR("?",1)=" Enter YES to immediately exit out of this option."
S DIR("?")=" Enter NO to return to the previous question."
D ^DIR K DIR
I $D(DIRUT)!$D(DTOUT) S (STOP,Y)=1 G STOPX
I 'Y S STOP=0
;
STOPX ; STOP exit pt
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERPF 9519 printed Sep 23, 2025@19:51:25 Page 2
IBCNERPF ;BP/YMG - IBCNE eIV AUTO UPDATE REPORT ;09-MAY-2023
+1 ;;2.0;INTEGRATED BILLING;**416,528,549,595,668,737,763,794**;21-MAR-94;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; NOTE:
+5 ; IB*2.0*763 is a major re-write of this report. The comments from the previous patches
+6 ; have either been removed or modified to remove the patch number if the comment is relevant.
+7 ;
+8 ; Variables:
+9 ; IBCNESPC("BEGDT") = start date for date range
+10 ; IBCNESPC("ENDDT") = end date for date range
+11 ; IBCNESPC("IBOUT") = "R" for Report format or "E" for Excel format
+12 ; IBCNESPC("ICODETL") = 1 for displaying Ins Co Detail
+13 ; IBCNESPC("INSCO") = "A" (All ins. cos.) OR "S" (Selected ins. cos.)
+14 ; IBCNESPC("PYR",ien) - payer iens for report, if IBCNESPC("PYR")="A", then include all
+15 ; = (1) ^ (2)
+16 ; (1) Display insurance company detail - 0 = No / 1 = Yes
+17 ; (2) Display all or some insurance companies - A = All companies/
+18 ; S = Specified companies
+19 ; IBCNESPC("PYR",ien,coien) - payer iens and company ien for report
+20 ; = Count for insurance company
+21 ; IBCNESPC("PAT",ien) = patient iens for report, if IBCNESPC("PAT")="A", then include all
+22 ; IBCNESPC("TYPE") = report type: "S" - summary, "D" - detailed
+23 ;
+24 QUIT
EN ; entry point
+1 NEW IBCNESPC,STOP,TYPE
+2 ;
+3 SET STOP=0
+4 WRITE @IOF
+5 WRITE !,"eIV Auto Update Report"
+6 ;
+7 ; Report Type - Summary or Detailed
TYPE ;Type of Report
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^S:Summary;D:Detailed"
+4 SET DIR("A")="Run a (S)ummary or (D)etailed Report: "
+5 SET DIR("B")="Summary"
+6 DO ^DIR
+7 IF $DATA(DIRUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+8 SET (TYPE,IBCNESPC("TYPE"))=Y
+9 IF TYPE="S"
GOTO SUMMARY
+10 ;
DETAIL ; Prompts in specific order for Detail report.
+1 SET IBCNESPC("ICODETL")=1
+2 ;
D10 ; Payer Selection parameter
+1 DO PAYER
IF STOP
if $$STOP
GOTO EXIT
GOTO TYPE
+2 ;
D20 ; Date Range parameters
+1 DO DTRANGE
IF STOP
if $$STOP
GOTO EXIT
GOTO D10
+2 ;
D30 ; Patient Selection parameter
+1 DO PATIENT
IF STOP
if $$STOP
GOTO EXIT
GOTO D20
+2 ;
+3 GOTO IBOUT
+4 ;
SUMMARY ;Prompts in specific order for Summary report
+1 ;
+2 ;All insurance companies
SET IBCNESPC("INSCO")="A"
+3 ;All Patients
SET IBCNESPC("PAT")="A"
+4 ;All Payers
SET IBCNESPC("PYR")="A"
+5 ;
S10 ;Select Payer or Source of Information
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^P:Payer;S:Source of Information"
+4 SET DIR("A")="Run for (P)ayer or (S)ource of Information: "
+5 SET DIR("?",1)="When selecting '(P)ayer', the report displays the breakout of auto updated"
+6 SET DIR("?",2)="entries based on the Payer name."
+7 SET DIR("?",3)=""
+8 SET DIR("?",4)="When selecting '(S)ource of Information', the report displays the breakout of"
+9 SET DIR("?")="auto updated entries based on the Source of Information of the entry."
+10 DO ^DIR
IF $DATA(DIRUT)
if $$STOP
GOTO EXIT
GOTO TYPE
+11 SET IBCNESPC("PS")=Y
+12 ;Source of Information does not prompt for Ins Co or Payer.
IF Y="S"
Begin DoDot:1
+13 SET (IBCNESPC("PYR"),IBCNESPC("PAT"))="A"
+14 SET IBCNESPC("ICODETL")=1
End DoDot:1
GOTO S40
+15 ;
S20 ;Prompt for Insurance Company Detail
+1 DO ICODETL
IF STOP
if $$STOP
GOTO EXIT
GOTO S10
+2 ;
S30 ;Prompt for Payer Selection
+1 DO PAYER
IF STOP
if $$STOP
GOTO EXIT
GOTO S20
+2 ;
S40 ; Response Received Date
+1 DO DTRANGE
IF STOP
if $$STOP
GOTO EXIT
if (IBCNESPC("PS")="S")
GOTO S10
GOTO S30
+2 ;
IBOUT ;
+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
if $$STOP
GOTO EXIT
if TYPE="S"
GOTO S40
GOTO D30
+7 SET IBCNESPC("IBOUT")=Y
+8 IF Y="E"
Begin DoDot:1
+9 WRITE !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
+10 WRITE !,"of the data saved to the file, please enter ""0;"_$SELECT(TYPE="S":"132",1:"256")_";99999"" at the ""DEVICE:"""
+11 WRITE !,"prompt.",!
End DoDot:1
+12 IF $GET(IBCNESPC("TYPE"))="D"
if $GET(IBCNESPC("IBOUT"))="R"
WRITE !!!,"*** This report is 132 characters wide ***",!
+13 ;
+14 ; Select the output device
DEVICE ; Device Handler and possible TaskManager calls
+1 ;
+2 ; Output params:
+3 ; STOP = Flag to stop routine
+4 ;
+5 ; Init vars
+6 NEW POP,ZTDESC,ZTRTN,ZTSAVE
+7 ;
+8 SET ZTRTN="COMPILE^IBCNERPF(.IBCNESPC)"
+9 SET ZTDESC="IBCNE eIV Auto Update Report"
+10 SET ZTSAVE("IBCNESPC(")=""
+11 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+12 ;
EXIT ;
+1 QUIT
+2 ;
COMPILE(IBCNESPC) ;
+1 ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
+2 ; Input params:
+3 ; IBCNESPC = Array passed by ref of the report params
+4 ;
+5 ; Init scratch globals
+6 NEW ALLPAT,ALLPYR
+7 KILL ^TMP($JOB,"IBCNERPF")
+8 NEW IBOUT
+9 ; Compile
+10 SET IBOUT=$GET(IBCNESPC("IBOUT"))
+11 DO EN^IBCNERPG(.IBCNESPC)
+12 ; Print
+13 IF '$GET(ZTSTOP)
DO PRINT^IBCNERPG(.IBCNESPC)
+14 ; Close device
+15 DO ^%ZISC
+16 ; Kill scratch globals
+17 KILL ^TMP($JOB,"IBCNERPF")
+18 ; Purge task record
+19 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+20 ;
COMPILX ; COMPILE exit pt
+1 QUIT
+2 ;
PAYER ;
+1 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PIEN,X,Y
+2 WRITE !
+3 SET DIR("A")="Run for (A)ll Payers or (S)elected Payers: "
+4 SET DIR("A",1)="PAYER SELECTION:"
+5 SET DIR(0)="SA^A:All;S:Selected"
SET DIR("B")="A"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET STOP=1
QUIT
+8 ; "All Payers" selected
SET IBCNESPC("PYR")=Y
IF Y="A"
QUIT
+9 SET DIC(0)="ABEQ"
+10 WRITE !
+11 SET DIC("A")="Select Payer: "
+12 ; Only include payers with eIV Auto Update flag = Yes
+13 SET DIC("S")="I $$AUTOUPDT^IBCNERPF($P($G(Y),U,1))"
+14 SET DIC="^IBE(365.12,"
+15 ;
PAYER1 ;
+1 DO ^DIC
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
SET STOP=1
KILL IBCNESPC("PYR")
QUIT
+3 SET PIEN=$PIECE(Y,U,1)
KILL IBCNESPC("PYR",PIEN)
SET IBCNESPC("PYR",PIEN)=""
+4 IF $GET(IBCNESPC("ICODETL"))
DO GETCOMPS(PIEN,.IBCNESPC)
+5 WRITE !
+6 IF $$ANOTHER("Payer")
WRITE !
GOTO PAYER1
+7 QUIT
+8 ;
AUTOUPDT(PIEN) ; Lookup screen to determine if the Auto update flag for payer = Yes
+1 ; Input: PIEN - IEN of the Payer (file 365.12)
+2 ; Returns 1 - Auto update flag is set to 'Y', 0 otherwise
+3 NEW AUTOUPDT,IENS,MULT
+4 SET AUTOUPDT=0
+5 SET MULT=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+6 IF MULT
Begin DoDot:1
+7 SET IENS=MULT_","_PIEN_","
+8 SET AUTOUPDT=$$GET1^DIQ(365.121,IENS,4.01,"I")
End DoDot:1
+9 QUIT AUTOUPDT
+10 ;
GETCOMPS(PIEN,IBCNESPC) ; Get companies linked to payer
+1 ; Get associated insurance companies
+2 ; If user wants to display insurance companies, prompt only for those linked to payer
+3 ; Allow the user to select none, one, or multiple insurance companies associated with a given payer
+4 ;
+5 ; Input
+6 ; PIEN - Payer ID
+7 ; IBCNESPC - Array holding payer id and related insurance companies
+8 ; Output
+9 ; IBCNESPC - Array holding payer id and related insurance companies
+10 ; IBCNESPC("PYR",PIEN) = (1)
+11 ; (1) Display all or some insurance companies - A = All companies/ S = Specified companies
+12 ;
+13 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+14 WRITE !
+15 KILL DIR
+16 SET DIR("A")="Run for (A)ll Insurance Companies or (S)elected Insurance Companies: "
+17 SET DIR("B")="A"
+18 SET DIR(0)="SA^A:All;S:Selected"
DO ^DIR
+19 if $DATA(DIRUT)
QUIT
+20 SET $PIECE(IBCNESPC("PYR",PIEN),U)=Y
+21 ; Run for all companies
IF Y="A"
QUIT
+22 SET IBCNESPC("INSCO")="S"
+23 KILL ^TMP("IBCNILKA",$JOB)
+24 DO EN^IBCNILK(2,PIEN,5)
+25 IF $DATA(^TMP("IBCNILKA",$JOB))
Begin DoDot:1
+26 MERGE IBCNESPC("PYR",PIEN)=^TMP("IBCNILKA",$JOB)
End DoDot:1
+27 KILL ^TMP("IBCNILKA",$JOB)
+28 QUIT
+29 ;
ICODETL ;Display Insurance Company Detail.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,IBCNS,X,Y
+2 WRITE !
+3 SET DIR("A")="Do you want to display insurance company detail"
+4 SET DIR("B")="NO"
+5 SET DIR(0)="Y"
DO ^DIR
+6 IF $DATA(DIRUT)
SET STOP=1
GOTO ICODETLX
+7 SET IBCNESPC("ICODETL")=Y=1
ICODETLX ;
+1 QUIT
+2 ;
DTRANGE ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,IBDT180
+2 ; Default start date to T-180
T180 ;
+1 WRITE !
+2 SET IBDT180=$$FMADD^XLFDT($$DT^XLFDT(),-180)
+3 SET DIR(0)="D^::EX"
SET DIR("B")=$$FMTE^XLFDT(IBDT180,"D")
+4 SET DIR("A")="Earliest Date Received"
+5 SET DIR("A",1)="RESPONSE RECEIVED DATE RANGE SELECTION:"
+6 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
QUIT
+7 IF Y>DT
WRITE !!,"Future dates not allowed."
GOTO T180
+8 IF Y<IBDT180
WRITE !!,"Response must not be previous to "_$$FMTE^XLFDT(IBDT180,"D")_"."
GOTO T180
+9 SET IBCNESPC("BEGDT")=Y
+10 ; End date
DTRANGE1 ;
+1 SET DIR("B")="Today"
+2 KILL DIR("A")
SET DIR("A")=" Latest Date Received"
+3 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
QUIT
+4 IF Y>DT
WRITE !!,"Future dates not allowed."
GOTO DTRANGE1
+5 IF Y<IBCNESPC("BEGDT")
WRITE !," Latest Date must not precede the Earliest Date."
GOTO DTRANGE1
+6 SET IBCNESPC("ENDDT")=Y
+7 QUIT
+8 ;
PATIENT ;
+1 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 ; summary report is always run for all patients
+3 IF $GET(IBCNESPC("TYPE"))="S"
SET IBCNESPC("PAT")="A"
QUIT
+4 WRITE !
+5 SET DIR("A")="Run for (A)ll Patients or (S)elected Patients: "
+6 SET DIR("A",1)="PATIENT SELECTION:"
+7 SET DIR(0)="SA^A:All;S:Selected"
SET DIR("B")="A"
+8 DO ^DIR
+9 IF $DATA(DIRUT)
SET STOP=1
QUIT
+10 ; "All Patients" selected
IF Y="A"
SET IBCNESPC("PAT")="A"
QUIT
+11 ;IB*794/DTG change ABEQ to AMEQ to allow for ssn lookup (multi-indexes)
SET DIC(0)="AMEQ"
+12 SET DIC("A")="Select Patient: "
+13 SET DIC="^DPT("
PATIENT1 ;
+1 DO ^DIC
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
SET STOP=1
KILL IBCNESPC("PAT")
QUIT
+3 SET IBCNESPC("PAT",$PIECE(Y,U,1))=""
+4 IF $$ANOTHER("Patient")
GOTO PATIENT1
+5 QUIT
+6 ;
ANOTHER(TYPE) ; "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 "_TYPE
SET DIR(0)="Y"
SET DIR("B")="NO"
+4 DO ^DIR
IF $DATA(DIRUT)
SET STOP=1
+5 QUIT Y
+6 ;
STOP() ; Determine if user wants to exit out of the whole option
+1 ; Init vars
+2 NEW DIR,X,Y,DIRUT
+3 ;
+4 WRITE !
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Do you want to exit out of this option entirely"
+7 SET DIR("B")="YES"
+8 SET DIR("?",1)=" Enter YES to immediately exit out of this option."
+9 SET DIR("?")=" Enter NO to return to the previous question."
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)!$DATA(DTOUT)
SET (STOP,Y)=1
GOTO STOPX
+12 IF 'Y
SET STOP=0
+13 ;
STOPX ; STOP exit pt
+1 QUIT Y
+2 ;
