IBCEDS ;ALB/ESG - EDI CLAIM STATUS REPORT - SELECTION ;13-DEC-2007
;;2.0;INTEGRATED BILLING;**377,641,727**;21-MAR-94;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
;
NEW STOP,IBMETHOD,IBSORT1,IBSORT2,IBSORT3,IBSORTOR
S STOP=0
K ^TMP($J,"IBCEDS")
W @IOF,!,"EDI Claim Status Report"
;
DS10 D CLAIM I STOP G:$$STOP EX G DS10
I IBMETHOD="C" G DS70 ; skip down to the Sort questions
DS20 D DIV I STOP G:$$STOP EX G DS10
DS30 D PAYER I STOP G:$$STOP EX G DS20
DS40 D TXDATE I STOP G:$$STOP EX G DS30
DS50 D EDISTAT I STOP G:$$STOP EX G DS40
DS60 D CANCEL I STOP G:$$STOP EX G DS50
;JWS;IB*2.0*727;EBILL-2680;in non-production accounts, ask if TEST claims should be included
DS62 I '$$PROD^XUPROD(1) D TEST I STOP G:$$STOP EX G DS60
;JWS;IB*2.0*641;add summary/detail option (summary - just totals, detail remains same)
DS65 D SD I STOP G:$$STOP EX G DS60
I $G(^TMP($J,"IBCEDS","SD"))="S" G DS80
DS70 D SORT I STOP G:$$STOP EX G:IBMETHOD="C" DS10 G DS65
DS80 D DEVICE I STOP G:$$STOP EX G:$G(^TMP($J,"IBCEDS","SD"))="S" DS65 G DS70
;
EX ; exit point
Q
;
STOP() ; Determine if user wants to exit out of the whole option
; 1=yes, get out entirely
; 0=no, just go back to the previous question
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) S (STOP,Y)=1 G STOPX
I 'Y S STOP=0
;
STOPX ; STOP exit pt
Q Y
;
CLAIM ; enter in multiple claim#'s or generate a report
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,Z
CLM1 ;
W !!,"CLAIM SELECTION METHOD"
K ^TMP($J,"IBCEDS","CLAIM") S IBMETHOD=""
S DIR(0)="SA^C:Select Specific Claims;R:Regular Selection Criteria"
S DIR("A")="Method to Select Claims: "
S DIR("B")="Regular Selection Criteria"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G CLAIMX
S IBMETHOD=Y
I IBMETHOD="R" K ^TMP($J,"IBCEDS","CLAIM") G CLAIMX ; regular selection method
;
; select specific claims
;
W !
S IBDONE=0
F D Q:IBDONE!STOP
. S DIR(0)="PAO^364:AEMQZ"
. S DIR("S")="I '$O(^IBA(364,""B"",+$G(^(0)),Y))" ; prevent multiple 364 entries from listing
. S DIR("A")=" Select a Claim: "
. I $O(^TMP($J,"IBCEDS","CLAIM","")) S DIR("A")=" Select Another Claim: "
. D ^DIR K DIR
. I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
. I +Y'>0 S IBDONE=1 Q ; null response
. S Z=$G(^IBA(364,+Y,0))
. I $P(Z,U,7) W *7,!!?3,"Test Claim Transmissions are not Allowed.",! Q
. I $P(Z,U,3)="X" W *7,!!?3,"This Claim is still in a READY FOR EXTRACT status.",! Q
. I '$P(Z,U,2) W *7,!!?3,"This Claim has no Batch#.",! Q
. I '$P(Z,U,1) W *7,!!?3,"This Claim is Corrupted.",! Q
. ;
. S ^TMP($J,"IBCEDS","CLAIM",+Z)=+Y
. Q
;
I STOP G CLAIMX
;
I '$O(^TMP($J,"IBCEDS","CLAIM","")) D G CLM1
. W *7,!!?3,"No claims have been selected. Please try again."
. Q
;
CLAIMX ;
Q
;
DIV ; division selection
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,DIC
DV1 ;
K ^TMP($J,"IBCEDS","DIV")
W !!,"DIVISION SELECTION"
S DIR(0)="SA^A:All Divisions;S:Selected Divisions"
S DIR("A")="Include All Divisions or Selected Divisions? "
S DIR("B")="All Divisions"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G DIVX
I Y="A" K ^TMP($J,"IBCEDS","DIV") G DIVX
;
W !
S IBDONE=0
F D Q:IBDONE!STOP
. S DIC=40.8,DIC(0)="AEMQ",DIC("A")=" Select Division: "
. I $O(^TMP($J,"IBCEDS","DIV","")) S DIC("A")=" Select Another Division: "
. D ^DIC K DIC ; lookup
. I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
. I +Y'>0 S IBDONE=1 Q ; user is done
. S ^TMP($J,"IBCEDS","DIV",+Y)=$P(Y,U,2)
. Q
;
I STOP G DIVX
;
I '$O(^TMP($J,"IBCEDS","DIV","")) D G DV1
. W *7,!!?3,"No divisions have been selected. Please try again."
. Q
;
DIVX ;
Q
;
PAYER ; payer selection
NEW IBPAYER,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,DIC,EDI,PROF,INST
PY1 ;
K ^TMP($J,"IBCEDS","INS")
W !!,"PAYER SELECTION"
S IBPAYER=""
S DIR(0)="SA^A:All Payers;S:Selected Payers"
S DIR("A")="Include All Payers or Selected Payers? "
S DIR("B")="All Payers"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G PAYERX
I Y="A" K ^TMP($J,"IBCEDS","INS") G PAYERX
W !
S DIR(0)="Y"
S DIR("A")=" Include all payers with the same electronic Payer ID"
S DIR("B")="Yes"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G PAYERX
S IBPAYER=Y
W !
;
S IBDONE=0
F D Q:IBDONE!STOP
. S DIC=36,DIC(0)="AEMQ",DIC("A")=" Select Insurance Company: "
. I $O(^TMP($J,"IBCEDS","INS",1,"")) S DIC("A")=" Select Another Insurance Company: "
. S DIC("W")="D INSLIST^IBCEMCA(Y)"
. D ^DIC K DIC ; lookup
. I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
. I +Y'>0 S IBDONE=1 Q ; user is done
. S ^TMP($J,"IBCEDS","INS",1,+Y)=$P(Y,U,2)
. I 'IBPAYER Q
. S EDI=$$UP^XLFSTR($G(^DIC(36,+Y,3)))
. S PROF=$P(EDI,U,2)
. S INST=$P(EDI,U,4)
. I PROF'="",PROF'["PRNT" S ^TMP($J,"IBCEDS","INS",2,PROF,+Y)=""
. I INST'="",INST'["PRNT" S ^TMP($J,"IBCEDS","INS",2,INST,+Y)=""
. Q
;
I STOP G PAYERX
;
I '$O(^TMP($J,"IBCEDS","INS",1,"")) D G PY1
. W *7,!!?3,"No payers have been selected. Please try again."
. Q
;
PAYERX ;
Q
;
TXDATE ; date range for the last transmission date
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TDEF
K ^TMP($J,"IBCEDS","ALTDT")
W !!,"LAST TRANSMIT DATE RANGE SELECTION"
S DIR(0)="DAO^:"_DT_":AEX"
S DIR("A")=" Start with Date Last Transmitted: "
S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-14),"5Z")
D ^DIR K DIR
I $D(DIRUT)!'Y S STOP=1 G TXDATEX
S $P(^TMP($J,"IBCEDS","ALTDT"),U,1)=Y
;
S DIR(0)="DAO^"_Y_":"_DT_":AEX"
S DIR("A")=" Go to Date Last Transmitted: "
S TDEF=$$FMADD^XLFDT(DT,-7) ; normal to date default
I TDEF'>Y S TDEF=DT ; if to date default is on or before from date, set default=today
S DIR("B")=$$FMTE^XLFDT(TDEF,"5Z")
D ^DIR K DIR
I $D(DIRUT)!'Y S STOP=1 G TXDATEX
S $P(^TMP($J,"IBCEDS","ALTDT"),U,2)=Y
TXDATEX ;
Q
;
EDISTAT ; selection of one or all of the EDI claim statuses
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,EDILST
EDI1 ;
W !!,"EDI CLAIM STATUS SELECTION"
K ^TMP($J,"IBCEDS","EDI")
S DIR(0)="SA^A:All EDI Statuses;S:Selected EDI Statuses"
S DIR("A")="Include All EDI Statuses or Selected EDI Statuses? "
S DIR("B")="Selected EDI Statuses"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G EDISTATX
I Y="A" K ^TMP($J,"IBCEDS","EDI") G EDISTATX
;
W !
K EDILST D FIELD^DID(364,.03,,"POINTER","EDILST")
S IBDONE=0
F D Q:IBDONE!STOP
. S DIR(0)="364,.03AO"
. I $G(EDILST("POINTER"))'="" S DIR(0)="SAO^"_EDILST("POINTER")
. S DIR("A")=" Select Status: "
. I $O(^TMP($J,"IBCEDS","EDI",""))'="" S DIR("A")=" Select Another Status: "
. I $O(^TMP($J,"IBCEDS","EDI",""))="" S DIR("B")="RECEIVED IN AUSTIN"
. D ^DIR K DIR
. I $D(DUOUT)!$D(DTOUT) S STOP=1 Q ; up arrow or timeout
. I Y="" S IBDONE=1 Q
. S ^TMP($J,"IBCEDS","EDI",Y)=$G(Y(0))
. Q
;
I STOP G EDISTATX
;
I $O(^TMP($J,"IBCEDS","EDI",""))="" D G EDI1
. W *7,!!?3,"No EDI statuses have been selected. Please try again."
. Q
;
EDISTATX ;
Q
;
CANCEL ; Include cancelled claims?
W !!,"CANCELLED CLAIM SELECTION"
K ^TMP($J,"IBCEDS","CANCEL")
S DIR(0)="Y"
S DIR("A")="Include Cancelled Claims"
S DIR("B")="YES"
S DIR("?",1)=" Enter No to omit claims that have been cancelled in IB and/or AR."
S DIR("?")=" Enter Yes to include claims that have been cancelled in IB and/or AR."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G CANCELX
S ^TMP($J,"IBCEDS","CANCEL")=Y
CANCELX ;
Q
;
SD ; Summary or Detail ; IB*2.0*641;JWS;
;
W !
K ^TMP($J,"IBCEDS","SD")
S DIR(0)="SA^S:Summary;D:Detail"
S DIR("A")="Summary or Detail? "
S DIR("B")="Summary"
S DIR("?",1)=" Enter 'S' for a summary total of claims submitted from VistA."
S DIR("?")=" Enter 'D' for a detail list of claims submitted from VistA."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G SDX
S ^TMP($J,"IBCEDS","SD")=Y
SDX ;
Q
;
SORT ; Gather the primary, secondary, and tert sorts
W @IOF
W !!,"SORT CRITERIA"
K IBSORTOR
D SORTSEL^IBCEDS1(1) I STOP G SORTX
D SORTSEL^IBCEDS1(2) I STOP G SORTX
I $G(IBSORT2)'="" D SORTSEL^IBCEDS1(3) I STOP G SORTX
SORTX ;
Q
;
DEVICE ; Device selection
NEW ZTRTN,ZTDESC,ZTSAVE,POP
;JWS;IB*2.0*641;display only if detail
I $G(^TMP($J,"IBCEDS","SD"))'="S" W !!!,"This report is 132 characters wide. Please choose an appropriate device.",!
S ZTRTN="EN^IBCEDC"
S ZTDESC="COMPILE/PRINT EDI CLAIM STATUS DETAIL REPORT"
S ZTSAVE("IBMETHOD")=""
S ZTSAVE("IBSORT1")=""
S ZTSAVE("IBSORT2")=""
S ZTSAVE("IBSORT3")=""
S ZTSAVE("IBSORTOR")=""
S ZTSAVE("^TMP($J,""IBCEDS"",")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
I POP S STOP=1
DEVICEX ;
Q
;
TEST ; Test claims include in lower environments ; IB*2.0*727;JWS;EBILL-2680
;
W !!,"INCLUDE TEST CLAIMS SELECTION"
K ^TMP($J,"IBCEDS","TEST")
S DIR(0)="YO"
S DIR("A")="Include Test Claims"
S DIR("B")="NO"
S DIR("?",1)=" Enter No to omit claims that were submitted as 'TEST' claims."
S DIR("?")=" Enter Yes to include claims that were submitted as 'TEST' claims."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G TESTX
S ^TMP($J,"IBCEDS","TEST")=Y
TESTX ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEDS 9530 printed Apr 09, 2024@21:17:46 Page 2
IBCEDS ;ALB/ESG - EDI CLAIM STATUS REPORT - SELECTION ;13-DEC-2007
+1 ;;2.0;INTEGRATED BILLING;**377,641,727**;21-MAR-94;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 ;
+2 NEW STOP,IBMETHOD,IBSORT1,IBSORT2,IBSORT3,IBSORTOR
+3 SET STOP=0
+4 KILL ^TMP($JOB,"IBCEDS")
+5 WRITE @IOF,!,"EDI Claim Status Report"
+6 ;
DS10 DO CLAIM
IF STOP
if $$STOP
GOTO EX
GOTO DS10
+1 ; skip down to the Sort questions
IF IBMETHOD="C"
GOTO DS70
DS20 DO DIV
IF STOP
if $$STOP
GOTO EX
GOTO DS10
DS30 DO PAYER
IF STOP
if $$STOP
GOTO EX
GOTO DS20
DS40 DO TXDATE
IF STOP
if $$STOP
GOTO EX
GOTO DS30
DS50 DO EDISTAT
IF STOP
if $$STOP
GOTO EX
GOTO DS40
DS60 DO CANCEL
IF STOP
if $$STOP
GOTO EX
GOTO DS50
+1 ;JWS;IB*2.0*727;EBILL-2680;in non-production accounts, ask if TEST claims should be included
DS62 IF '$$PROD^XUPROD(1)
DO TEST
IF STOP
if $$STOP
GOTO EX
GOTO DS60
+1 ;JWS;IB*2.0*641;add summary/detail option (summary - just totals, detail remains same)
DS65 DO SD
IF STOP
if $$STOP
GOTO EX
GOTO DS60
+1 IF $GET(^TMP($JOB,"IBCEDS","SD"))="S"
GOTO DS80
DS70 DO SORT
IF STOP
if $$STOP
GOTO EX
if IBMETHOD="C"
GOTO DS10
GOTO DS65
DS80 DO DEVICE
IF STOP
if $$STOP
GOTO EX
if $GET(^TMP($JOB,"IBCEDS","SD"))="S"
GOTO DS65
GOTO DS70
+1 ;
EX ; exit point
+1 QUIT
+2 ;
STOP() ; Determine if user wants to exit out of the whole option
+1 ; 1=yes, get out entirely
+2 ; 0=no, just go back to the previous question
+3 NEW DIR,X,Y,DIRUT
+4 ;
+5 WRITE !
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Do you want to exit out of this option entirely"
+8 SET DIR("B")="YES"
+9 SET DIR("?",1)=" Enter YES to immediately exit out of this option."
+10 SET DIR("?")=" Enter NO to return to the previous question."
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
SET (STOP,Y)=1
GOTO STOPX
+13 IF 'Y
SET STOP=0
+14 ;
STOPX ; STOP exit pt
+1 QUIT Y
+2 ;
CLAIM ; enter in multiple claim#'s or generate a report
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,Z
CLM1 ;
+1 WRITE !!,"CLAIM SELECTION METHOD"
+2 KILL ^TMP($JOB,"IBCEDS","CLAIM")
SET IBMETHOD=""
+3 SET DIR(0)="SA^C:Select Specific Claims;R:Regular Selection Criteria"
+4 SET DIR("A")="Method to Select Claims: "
+5 SET DIR("B")="Regular Selection Criteria"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
SET STOP=1
GOTO CLAIMX
+8 SET IBMETHOD=Y
+9 ; regular selection method
IF IBMETHOD="R"
KILL ^TMP($JOB,"IBCEDS","CLAIM")
GOTO CLAIMX
+10 ;
+11 ; select specific claims
+12 ;
+13 WRITE !
+14 SET IBDONE=0
+15 FOR
Begin DoDot:1
+16 SET DIR(0)="PAO^364:AEMQZ"
+17 ; prevent multiple 364 entries from listing
SET DIR("S")="I '$O(^IBA(364,""B"",+$G(^(0)),Y))"
+18 SET DIR("A")=" Select a Claim: "
+19 IF $ORDER(^TMP($JOB,"IBCEDS","CLAIM",""))
SET DIR("A")=" Select Another Claim: "
+20 DO ^DIR
KILL DIR
+21 ; up arrow or timeout
IF $DATA(DUOUT)!$DATA(DTOUT)
SET STOP=1
QUIT
+22 ; null response
IF +Y'>0
SET IBDONE=1
QUIT
+23 SET Z=$GET(^IBA(364,+Y,0))
+24 IF $PIECE(Z,U,7)
WRITE *7,!!?3,"Test Claim Transmissions are not Allowed.",!
QUIT
+25 IF $PIECE(Z,U,3)="X"
WRITE *7,!!?3,"This Claim is still in a READY FOR EXTRACT status.",!
QUIT
+26 IF '$PIECE(Z,U,2)
WRITE *7,!!?3,"This Claim has no Batch#.",!
QUIT
+27 IF '$PIECE(Z,U,1)
WRITE *7,!!?3,"This Claim is Corrupted.",!
QUIT
+28 ;
+29 SET ^TMP($JOB,"IBCEDS","CLAIM",+Z)=+Y
+30 QUIT
End DoDot:1
if IBDONE!STOP
QUIT
+31 ;
+32 IF STOP
GOTO CLAIMX
+33 ;
+34 IF '$ORDER(^TMP($JOB,"IBCEDS","CLAIM",""))
Begin DoDot:1
+35 WRITE *7,!!?3,"No claims have been selected. Please try again."
+36 QUIT
End DoDot:1
GOTO CLM1
+37 ;
CLAIMX ;
+1 QUIT
+2 ;
DIV ; division selection
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,DIC
DV1 ;
+1 KILL ^TMP($JOB,"IBCEDS","DIV")
+2 WRITE !!,"DIVISION SELECTION"
+3 SET DIR(0)="SA^A:All Divisions;S:Selected Divisions"
+4 SET DIR("A")="Include All Divisions or Selected Divisions? "
+5 SET DIR("B")="All Divisions"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
SET STOP=1
GOTO DIVX
+8 IF Y="A"
KILL ^TMP($JOB,"IBCEDS","DIV")
GOTO DIVX
+9 ;
+10 WRITE !
+11 SET IBDONE=0
+12 FOR
Begin DoDot:1
+13 SET DIC=40.8
SET DIC(0)="AEMQ"
SET DIC("A")=" Select Division: "
+14 IF $ORDER(^TMP($JOB,"IBCEDS","DIV",""))
SET DIC("A")=" Select Another Division: "
+15 ; lookup
DO ^DIC
KILL DIC
+16 ; up arrow or timeout
IF $DATA(DUOUT)!$DATA(DTOUT)
SET STOP=1
QUIT
+17 ; user is done
IF +Y'>0
SET IBDONE=1
QUIT
+18 SET ^TMP($JOB,"IBCEDS","DIV",+Y)=$PIECE(Y,U,2)
+19 QUIT
End DoDot:1
if IBDONE!STOP
QUIT
+20 ;
+21 IF STOP
GOTO DIVX
+22 ;
+23 IF '$ORDER(^TMP($JOB,"IBCEDS","DIV",""))
Begin DoDot:1
+24 WRITE *7,!!?3,"No divisions have been selected. Please try again."
+25 QUIT
End DoDot:1
GOTO DV1
+26 ;
DIVX ;
+1 QUIT
+2 ;
PAYER ; payer selection
+1 NEW IBPAYER,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,DIC,EDI,PROF,INST
PY1 ;
+1 KILL ^TMP($JOB,"IBCEDS","INS")
+2 WRITE !!,"PAYER SELECTION"
+3 SET IBPAYER=""
+4 SET DIR(0)="SA^A:All Payers;S:Selected Payers"
+5 SET DIR("A")="Include All Payers or Selected Payers? "
+6 SET DIR("B")="All Payers"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET STOP=1
GOTO PAYERX
+9 IF Y="A"
KILL ^TMP($JOB,"IBCEDS","INS")
GOTO PAYERX
+10 WRITE !
+11 SET DIR(0)="Y"
+12 SET DIR("A")=" Include all payers with the same electronic Payer ID"
+13 SET DIR("B")="Yes"
+14 DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)
SET STOP=1
GOTO PAYERX
+16 SET IBPAYER=Y
+17 WRITE !
+18 ;
+19 SET IBDONE=0
+20 FOR
Begin DoDot:1
+21 SET DIC=36
SET DIC(0)="AEMQ"
SET DIC("A")=" Select Insurance Company: "
+22 IF $ORDER(^TMP($JOB,"IBCEDS","INS",1,""))
SET DIC("A")=" Select Another Insurance Company: "
+23 SET DIC("W")="D INSLIST^IBCEMCA(Y)"
+24 ; lookup
DO ^DIC
KILL DIC
+25 ; up arrow or timeout
IF $DATA(DUOUT)!$DATA(DTOUT)
SET STOP=1
QUIT
+26 ; user is done
IF +Y'>0
SET IBDONE=1
QUIT
+27 SET ^TMP($JOB,"IBCEDS","INS",1,+Y)=$PIECE(Y,U,2)
+28 IF 'IBPAYER
QUIT
+29 SET EDI=$$UP^XLFSTR($GET(^DIC(36,+Y,3)))
+30 SET PROF=$PIECE(EDI,U,2)
+31 SET INST=$PIECE(EDI,U,4)
+32 IF PROF'=""
IF PROF'["PRNT"
SET ^TMP($JOB,"IBCEDS","INS",2,PROF,+Y)=""
+33 IF INST'=""
IF INST'["PRNT"
SET ^TMP($JOB,"IBCEDS","INS",2,INST,+Y)=""
+34 QUIT
End DoDot:1
if IBDONE!STOP
QUIT
+35 ;
+36 IF STOP
GOTO PAYERX
+37 ;
+38 IF '$ORDER(^TMP($JOB,"IBCEDS","INS",1,""))
Begin DoDot:1
+39 WRITE *7,!!?3,"No payers have been selected. Please try again."
+40 QUIT
End DoDot:1
GOTO PY1
+41 ;
PAYERX ;
+1 QUIT
+2 ;
TXDATE ; date range for the last transmission date
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TDEF
+2 KILL ^TMP($JOB,"IBCEDS","ALTDT")
+3 WRITE !!,"LAST TRANSMIT DATE RANGE SELECTION"
+4 SET DIR(0)="DAO^:"_DT_":AEX"
+5 SET DIR("A")=" Start with Date Last Transmitted: "
+6 SET DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-14),"5Z")
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)!'Y
SET STOP=1
GOTO TXDATEX
+9 SET $PIECE(^TMP($JOB,"IBCEDS","ALTDT"),U,1)=Y
+10 ;
+11 SET DIR(0)="DAO^"_Y_":"_DT_":AEX"
+12 SET DIR("A")=" Go to Date Last Transmitted: "
+13 ; normal to date default
SET TDEF=$$FMADD^XLFDT(DT,-7)
+14 ; if to date default is on or before from date, set default=today
IF TDEF'>Y
SET TDEF=DT
+15 SET DIR("B")=$$FMTE^XLFDT(TDEF,"5Z")
+16 DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)!'Y
SET STOP=1
GOTO TXDATEX
+18 SET $PIECE(^TMP($JOB,"IBCEDS","ALTDT"),U,2)=Y
TXDATEX ;
+1 QUIT
+2 ;
EDISTAT ; selection of one or all of the EDI claim statuses
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBDONE,EDILST
EDI1 ;
+1 WRITE !!,"EDI CLAIM STATUS SELECTION"
+2 KILL ^TMP($JOB,"IBCEDS","EDI")
+3 SET DIR(0)="SA^A:All EDI Statuses;S:Selected EDI Statuses"
+4 SET DIR("A")="Include All EDI Statuses or Selected EDI Statuses? "
+5 SET DIR("B")="Selected EDI Statuses"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
SET STOP=1
GOTO EDISTATX
+8 IF Y="A"
KILL ^TMP($JOB,"IBCEDS","EDI")
GOTO EDISTATX
+9 ;
+10 WRITE !
+11 KILL EDILST
DO FIELD^DID(364,.03,,"POINTER","EDILST")
+12 SET IBDONE=0
+13 FOR
Begin DoDot:1
+14 SET DIR(0)="364,.03AO"
+15 IF $GET(EDILST("POINTER"))'=""
SET DIR(0)="SAO^"_EDILST("POINTER")
+16 SET DIR("A")=" Select Status: "
+17 IF $ORDER(^TMP($JOB,"IBCEDS","EDI",""))'=""
SET DIR("A")=" Select Another Status: "
+18 IF $ORDER(^TMP($JOB,"IBCEDS","EDI",""))=""
SET DIR("B")="RECEIVED IN AUSTIN"
+19 DO ^DIR
KILL DIR
+20 ; up arrow or timeout
IF $DATA(DUOUT)!$DATA(DTOUT)
SET STOP=1
QUIT
+21 IF Y=""
SET IBDONE=1
QUIT
+22 SET ^TMP($JOB,"IBCEDS","EDI",Y)=$GET(Y(0))
+23 QUIT
End DoDot:1
if IBDONE!STOP
QUIT
+24 ;
+25 IF STOP
GOTO EDISTATX
+26 ;
+27 IF $ORDER(^TMP($JOB,"IBCEDS","EDI",""))=""
Begin DoDot:1
+28 WRITE *7,!!?3,"No EDI statuses have been selected. Please try again."
+29 QUIT
End DoDot:1
GOTO EDI1
+30 ;
EDISTATX ;
+1 QUIT
+2 ;
CANCEL ; Include cancelled claims?
+1 WRITE !!,"CANCELLED CLAIM SELECTION"
+2 KILL ^TMP($JOB,"IBCEDS","CANCEL")
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Include Cancelled Claims"
+5 SET DIR("B")="YES"
+6 SET DIR("?",1)=" Enter No to omit claims that have been cancelled in IB and/or AR."
+7 SET DIR("?")=" Enter Yes to include claims that have been cancelled in IB and/or AR."
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
SET STOP=1
GOTO CANCELX
+10 SET ^TMP($JOB,"IBCEDS","CANCEL")=Y
CANCELX ;
+1 QUIT
+2 ;
SD ; Summary or Detail ; IB*2.0*641;JWS;
+1 ;
+2 WRITE !
+3 KILL ^TMP($JOB,"IBCEDS","SD")
+4 SET DIR(0)="SA^S:Summary;D:Detail"
+5 SET DIR("A")="Summary or Detail? "
+6 SET DIR("B")="Summary"
+7 SET DIR("?",1)=" Enter 'S' for a summary total of claims submitted from VistA."
+8 SET DIR("?")=" Enter 'D' for a detail list of claims submitted from VistA."
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
SET STOP=1
GOTO SDX
+11 SET ^TMP($JOB,"IBCEDS","SD")=Y
SDX ;
+1 QUIT
+2 ;
SORT ; Gather the primary, secondary, and tert sorts
+1 WRITE @IOF
+2 WRITE !!,"SORT CRITERIA"
+3 KILL IBSORTOR
+4 DO SORTSEL^IBCEDS1(1)
IF STOP
GOTO SORTX
+5 DO SORTSEL^IBCEDS1(2)
IF STOP
GOTO SORTX
+6 IF $GET(IBSORT2)'=""
DO SORTSEL^IBCEDS1(3)
IF STOP
GOTO SORTX
SORTX ;
+1 QUIT
+2 ;
DEVICE ; Device selection
+1 NEW ZTRTN,ZTDESC,ZTSAVE,POP
+2 ;JWS;IB*2.0*641;display only if detail
+3 IF $GET(^TMP($JOB,"IBCEDS","SD"))'="S"
WRITE !!!,"This report is 132 characters wide. Please choose an appropriate device.",!
+4 SET ZTRTN="EN^IBCEDC"
+5 SET ZTDESC="COMPILE/PRINT EDI CLAIM STATUS DETAIL REPORT"
+6 SET ZTSAVE("IBMETHOD")=""
+7 SET ZTSAVE("IBSORT1")=""
+8 SET ZTSAVE("IBSORT2")=""
+9 SET ZTSAVE("IBSORT3")=""
+10 SET ZTSAVE("IBSORTOR")=""
+11 SET ZTSAVE("^TMP($J,""IBCEDS"",")=""
+12 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
+13 IF POP
SET STOP=1
DEVICEX ;
+1 QUIT
+2 ;
TEST ; Test claims include in lower environments ; IB*2.0*727;JWS;EBILL-2680
+1 ;
+2 WRITE !!,"INCLUDE TEST CLAIMS SELECTION"
+3 KILL ^TMP($JOB,"IBCEDS","TEST")
+4 SET DIR(0)="YO"
+5 SET DIR("A")="Include Test Claims"
+6 SET DIR("B")="NO"
+7 SET DIR("?",1)=" Enter No to omit claims that were submitted as 'TEST' claims."
+8 SET DIR("?")=" Enter Yes to include claims that were submitted as 'TEST' claims."
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
SET STOP=1
GOTO TESTX
+11 SET ^TMP($JOB,"IBCEDS","TEST")=Y
TESTX ;
+1 QUIT
