IBCEPTC ;ALB/TMK - EDI PREVIOUSLY TRANSMITTED CLAIMS ; 4/12/05 11:15am
;;2.0;INTEGRATED BILLING;**296,320,348,349,547,592,623,659,641,665**;21-MAR-94;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; Main entrypoint
; IBDT1,IBDT2 = last transmit date range to use
; IBSORT = primary sort criteria to use B=BATCH #,I=INS CO NAME
; IBFORM = form type to limit selection to U=UB-04,C=CMS-1500,J=J430D, OR A=ALL
; IBCRIT = the additional sort criteria needed
; IBPTCCAN = whether or not to include cancelled claims
; IBRCBFPC = whether or not to include force print @ clearinghouse
; ^TMP("IB_PREV_CLAIM_INS",$J) = 1 for specific ins co/null for all
; ^($J,1,ien)="" for ien of each ins co selected
; ^($J,2,payer ID,ien)="" if selected
; IBREP = format output should be put in R=report,S=Listman
;
N DIR,DIC,X,Y,Z,Z0,Z1,IBHOW,IBACT,IBCT,IBREP,IBCRIT,IBDT1,IBDT2,IBLOC
N IBFORM,IBOK,IBQUIT,IBSORT,IBY,DTOUT,DUOUT,%ZIS,ZTSAVE,ZTRTN,ZTDESC
N POP,IBPAYER,EDI,INST,PROF,IBPTCCAN,DIROUT,DIRUT,DTOUT,DUOUT,IBRCBFPC
;
W !!,"*** Please Note ***"
W ?20,"2 '^' are needed to abort this option (^^)"
W !?20,"1 '^' brings you back to the previous prompt (^)"
W !
; IB*2.0*547 add new prompt for locally printed vs. transmitted claims
S DIR(0)="SA^P:Printed;T:Transmitted",DIR("A")="Run report for (P)rinted or (T)ransmitted claims?: ",DIR("B")="Transmitted"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G ENQ
; Set a flag here to indicate user wants locally printed claims and use that to control how the rest of the prompts act.
S IBLOC=$S(Y="T":"",1:1)
;
Q1 ;
W !
;S DIR(0)="SA^C:Claim;B:Batch;L:List",DIR("A")="Select By: (C)laim, (B)atch or see a (L)ist to pick from?: ",DIR("B")="List"
;WCJ;IB665;start;no longer selecting batches since each claim is now a batch
;S DIR(0)="SA^C:Claim;"_$S(IBLOC:"",1:"B:Batch;")_"L:List",DIR("A")="Select By: (C)laim"_$S(IBLOC:"",1:", (B)atch")_" or see a (L)ist to pick from?: ",DIR("B")="List"
S DIR(0)="SA^C:Claim;L:List",DIR("A")="Select By: (C)laim or see a (L)ist to pick from?: ",DIR("B")="List"
;WCJ;IB665;end
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) G ENQ
S IBHOW=Y
I IBLOC=1 W !,"Previously printed claims to a payer that does not accept EDI are omitted."
I IBHOW="L" G Q1A
;
S IBQUIT=0,IBCT=0
K ^TMP($J,IBHOW)
F D Q:IBQUIT
.;I IBHOW="C" S DIR("A")="Select a"_$S(IBCT:"nother",1:"")_" Claim: ",DIR(0)="PA^364:AEMQZ",DIR("S")="I '$P(^(0),U,7),'$O(^IBA(364,""B"",+^(0),Y))"
. ;JWS;IB*2.0*623;allow previously trans claims in test to be resubmitted if non-production environment "!'$$PROD^XUPROD(1)"
. ;JWS;IB*2.0*641v9;screen change in IB*623 failed - created SCRN label in this routine to perform check
. I IBHOW="C",IBLOC="" S DIR("A")="Select a"_$S(IBCT:"nother",1:"")_" Claim: ",DIR(0)="PA^364:AEMQZ",DIR("S")="I $$SCRN^IBCEPTC(Y)"
. I IBHOW="C",IBLOC=1 S DIR("A")="Select a"_$S(IBCT:"nother",1:"")_" Locally Printed Claim: ",DIR(0)="PA^399:AEMQZ",DIR("S")="I '$D(^IBA(364,""B"",Y)),$$INSOK^IBCEF4(+$$CURR^IBCEF2(Y))"
. I IBHOW="B" S DIR("A")="Select a"_$S(IBCT:"nother",1:"")_" Batch: ",DIR(0)="PA^IBA(364.1,:AEMQ^W "" "",$P(^(0),U,3),"" Claims""",DIR("S")="I '$P(^(0),U,14)"
. S DIR("?")="^D SELDSP^IBCEPTC(IBHOW)"
. S:IBCT $P(DIR(0),U)=$P(DIR(0),U)_"O" ; Optional prompt after one is selected
. D ^DIR K DIR
. I Y'>0 S IBQUIT=$S(X="^":2,X="^^":3,1:1) Q
. S IBY=$S(IBHOW="C":+Y,1:""),Y=$S(IBHOW="C":+Y(0),1:Y) S:IBLOC=1 Y=IBY
. I '$D(^TMP($J,IBHOW,+Y)) S IBCT=IBCT+1,^TMP($J,IBHOW,+Y)=IBY
;
G:IBQUIT=3 ENQ
G:IBQUIT=2!'$O(^TMP($J,IBHOW,0)) Q1
S Z=0
I IBHOW="C" F S Z=$O(^TMP($J,"C",Z)) Q:'Z S ^TMP("IB_PREV_CLAIM_SELECT",$J,Z,0)=^TMP($J,"C",Z)
I IBHOW="B" S (Z,IBCT)=0 F S Z=$O(^TMP($J,"B",Z)) Q:'Z D
. S Z0=0 F S Z0=$O(^IBA(364,"C",Z,Z0)) Q:'Z0 S Z1=+$G(^IBA(364,Z0,0)) I Z1,'$D(^TMP("IB_PREV_CLAIM_SELECT",$J,Z1,0)) S ^(0)=Z0,IBCT=IBCT+1
S ^TMP("IB_PREV_CLAIM_SELECT",$J)=IBCT
D RESUB^IBCEPTC3
G ENQ
;
Q1A K ^TMP("IB_PREV_CLAIM_INS",$J)
S DIR(0)="SA^A:All Payers;S:Selected Payers"
S DIR("A")="Run for (A)ll Payers or (S)elected Payers?: " S DIR("B")="Selected Payers"
W !!,"PAYER SELECTION:" D ^DIR K DIR
I X="^^" G ENQ
I $D(DTOUT)!$D(DUOUT) G Q1
;
I Y="A" S ^TMP("IB_PREV_CLAIM_INS",$J)="" G Q2
;
; esg - 11/21/05 - patch 320 question
W !
S DIR(0)="Y",DIR("A")=" Include all payers with the same electronic Payer ID",DIR("B")="Yes" D ^DIR K DIR
I $D(DIROUT) G ENQ
I $D(DIRUT) G Q1A
S IBPAYER=Y
W !
;
S ^TMP("IB_PREV_CLAIM_INS",$J)=1
S IBQUIT=0
F D Q:IBQUIT
. ; IB*2.0*547 allow lookup by EDI#'s using new cross-ref
. ;S DIC(0)="AEMQ",DIC=36,DIC("A")=" Select Insurance Company: "
. S DIC(0)="AEMQn",DIC=36,DIC("A")=" Select Insurance Company: "
. I $O(^TMP("IB_PREV_CLAIM_INS",$J,1,"")) S DIC("A")=" Select Another Insurance Company: "
. S DIC("W")="D INSLIST^IBCEMCA(Y)"
. ;D ^DIC K DIC ; lookup
. N D S D="B^AEI^AEP" D MIX^DIC1 K DIC,D
. I X="^^" S IBQUIT=2 Q ; user entered "^^"
. I +Y'>0 S IBQUIT=1 Q ; user is done
. W !
. S ^TMP("IB_PREV_CLAIM_INS",$J,1,+Y)=""
. I 'IBPAYER Q
. S EDI=$$UP^XLFSTR($G(^DIC(36,+Y,3)))
. S PROF=$P(EDI,U,2),INST=$P(EDI,U,4)
. I PROF'="",PROF'["PRNT" S ^TMP("IB_PREV_CLAIM_INS",$J,2,PROF,+Y)=""
. I INST'="",INST'["PRNT" S ^TMP("IB_PREV_CLAIM_INS",$J,2,INST,+Y)=""
. Q
;
I IBQUIT=2 G ENQ
;
I '$O(^TMP("IB_PREV_CLAIM_INS",$J,1,0)) D G Q1A
. W *7,!!?3,"No payers have been selected. Please try again."
. Q
;
Q2 ;; JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
;IA# 10026
S DIR(0)="SA^C:CMS-1500;U:UB-04;J:J430D;A:All",DIR("B")="All"
S DIR("A")="Run for (U)B-04, (C)MS-1500, (J)430D or (A)ll: "
W !!,"BILL FORM TYPE SELECTION:" D ^DIR K DIR
I X="^^" G ENQ
I $D(DTOUT)!$D(DUOUT) G Q1A
S IBFORM=Y
;
Q3 ;WCJ;IB665;start;allow times
S IBDTSAME=0
S DIR(0)="DA^0:9999999:EPTX"
S DIR("A")="Start with Date "_$S(IBLOC:"First Printed: ",1:"Last Transmitted: ")
S DIR("?",1)="This is the earliest date on which a claim that you want to include on this"
S DIR("?",2)="report was "_$S(IBLOC=1:"first printed",1:"last transmitted")_". You may choose a maximum date range of 90 days."
S DIR("?",3)="*Times are optional."
S DIR("?")=" "
W !!,$S(IBLOC:"FIRST PRINT",1:"LAST BATCH TRANSMIT")_" DATE RANGE SELECTION:" D ^DIR K DIR
I X="^^" G ENQ
I $D(DTOUT)!$D(DUOUT) G Q2
S IBDT1=Y
;
Q3ED ; go to date
S IBDT2=$$FMADD^XLFDT(IBDT1,90)
S IBDT2=$P(IBDT2,".")
I IBDT2>DT S IBDT2=DT
S DIR("?",1)="This is the latest date on which a claim that you want to include on this"
S DIR("?",2)="report was "_$S(IBLOC:"first printed",1:"last transmitted")_". You may choose a maximum date range of 90 days."
S DIR("?",3)="*Times are optional."
S DIR("?")=" "
S DIR("B")=$$FMTE^XLFDT(IBDT2,2)
S DIR(0)="DA^"_(IBDT1\1)_":"_(IBDT2+.24)_":EPTX"
S DIR("A")="Go to Date "_$S(IBLOC:"First Printed",1:"Last Transmitted")_":("_$$FMTE^XLFDT(IBDT1,2)_"-"_$$FMTE^XLFDT(IBDT2,2)_"): "
D ^DIR K DIR
I X="^^" G ENQ
I $D(DTOUT)!$D(DUOUT) G Q3
I $P(Y,".",2),Y<IBDT1 W !!,"'Go to Date' must be after 'Start with Date'",! G Q3ED ; if you have an end time, it has to be after start time
;WCJ;IB665;end
S IBDT2=Y
;
Q4 ; Additional selection criteria
;WCJ;IB665;start;added A0 selection
;S DIR(0)="SAO^1:MRA Secondary Only;2:Primary Claims Only;3:Secondary Claims Only;4:Claims Previously Printed at Clearinghouse;5:A0 Received in Austin Only"
S DIR(0)="SAO^1:MRA Secondary Only;2:Primary Claims Only;3:Secondary Claims Only"
I 'IBLOC S DIR(0)=DIR(0)_"4:Claims Previously Printed at Clearinghouse;5:A0 Received in Austin Only"
S DIR("A",1)="ADDITIONAL SELECTION CRITERIA:",DIR("A",2)=" ",DIR("A",3)="1 - MRA Secondary Only",DIR("A",4)="2 - Primary Claims Only",DIR("A",5)="3 - Secondary Claims Only"
;S DIR("A",6)=$S(IBLOC:"",1:"4 - Claims Sent to Print at Clearinghouse Only"),DIR("A",7)=" ",DIR("A")="Select Additional Limiting Criteria (optional): "
I 'IBLOC D
. S DIR("A",6)="4 - Claims Sent to Print at Clearinghouse Only"
. S DIR("A",7)="5 - A0 Received in Austin Only"
;S DIR("A",7)=" ",DIR("A")="Select Additional Limiting Criteria (optional): "
S DIR("A",$S(IBLOC:6,1:8))=" ",DIR("A")="Select Additional Limiting Criteria (optional): "
;WCJ;IB665;end
S DIR("?")="Select one of the listed criteria to further limit the claims to include"
W ! D ^DIR K DIR
I X="^^" G ENQ
I $D(DTOUT)!$D(DUOUT) G Q3
S IBCRIT=Y
;
Q41 ; Ask user if they want to include cancelled claims
S DIR(0)="Y",DIR("B")="No",DIR("A")="Would you like to include cancelled claims"
W ! D ^DIR K DIR
I X="^^" G ENQ
I $D(DIRUT) G Q4
S IBPTCCAN=Y
; IB*2.0*547 skip next 2 questions if looking for locally printed claims
I IBLOC S IBSORT=2,IBRCBFPC=0 G Q6
;
Q42 ; Include claims that are forced to print at clearinghouse?
S DIR(0)="Y",DIR("B")="No",DIR("A")="Would you like to include claims Forced to Print at the Clearinghouse"
W ! D ^DIR K DIR
I X="^^" G ENQ
I $D(DIRUT) G Q41
S IBRCBFPC=Y
;
Q5 S DIR("L",1)="Select one of the following: ",DIR("L",2)=" ",DIR("L",3)=$J("",10)_"1 Batch By Last Transmitted Date (Claims within a Batch)",DIR("L",4)=$J("",10)_"2 Current Payer (Insurance Company)"
S DIR("L",5)=" "
S DIR(0)="SA^1:Batch By Last Transmitted Date (Claims within a Batch);2:Current Payer (Insurance Company)",DIR("B")="Current Payer"
S DIR("A")="Sort By: "
W ! D ^DIR K DIR
I X="^^" G ENQ
I $D(DTOUT)!$D(DUOUT) G Q42
S IBSORT=Y
;
Q6 S DIR(0)="SA^R:Report;S:Screen List"
S DIR("A")="Do you want a (R)eport or a (S)creen List format?: "
S DIR("B")="Screen List"
W ! D ^DIR K DIR
I X="^^" G ENQ
I $D(DTOUT)!$D(DUOUT) G Q5
S IBREP=Y
; IB *2.0*547 call new SUB-routine for locally printed claims (not in file 364)
I IBREP="S",IBLOC D LOC^IBCEPTC0 G ENQ
;
I IBREP="S",'IBLOC D LIST^IBCEPTC0 G ENQ
;
Q7 ; Select device
F S IBACT=0 D DEVSEL(.IBACT) Q:IBACT
I IBACT=99 G ENQ
U IO
; IB *2.0*547 call new SUB-routine for locally printed claims (not in file 364)
D:'IBLOC LIST^IBCEPTC0
D:IBLOC LOC^IBCEPTC0
;
ENQ K ^TMP("IB_PREV_CLAIM_INS",$J),^TMP("IB_PREV_CLAIM_SELECT",$J)
Q
;
DEVSEL(IBACT) ;
N DIR,POP,X,Y,ZTRTN,ZTSAVE
W !!,"You will need a 132 column printer for this report!"
S %ZIS="QM" D ^%ZIS I POP S IBACT=99 G DEVSELQ
I $G(IOM),IOM<132 S IBOK=1 D I 'IBOK S IBACT=0 G DEVSELQ
. S DIR(0)="YA",DIR("A",1)="This report requires output to a 132 column device.",DIR("A",2)="The device you have chosen is only set for "_IOM_".",DIR("A")="Are you sure you want to continue?: ",DIR("B")="No"
. W ! D ^DIR K DIR
. I Y'=1 S IBOK=0 W !
I $D(IO("Q")) D S IBACT=99 G DEVSELQ
. K IO("Q")
. S ZTRTN="LIST^IBCEPTC0",ZTSAVE("IBCRIT(")="",ZTSAVE("IB*")="",ZTSAVE("^TMP(""IB_PREV_CLAIM_INS"",$J)")="",ZTSAVE("^TMP(""IB_PREV_CLAIM_INS"",$J,")="",ZTDESC="IB - Previously Transmitted Claims Report"
. D ^%ZTLOAD K ZTSK D HOME^%ZIS
S IBACT=1
DEVSELQ Q
;
SELDSP(IBHOW) ; Display list of selected claims/batches
; IBHOW = "C" for claims "B" for batches
N Z,DIR,CT,QUIT
I '$O(^TMP($J,IBHOW,0)) Q
S (CT,QUIT)=0
W !!,$S(IBHOW="C":"Claims",1:"Batches")," Already Selected:"
S Z=0 F S Z=$O(^TMP($J,IBHOW,Z)) Q:'Z!QUIT S Z0=$G(^(Z)) D Q:QUIT
. I IBHOW="C" W !,?3,$P($G(^DGCR(399,Z,0)),U) Q
. W !,?3,$P($G(^IBA(364.1,Z,0)),U)," ",$P(^(0),U,3)," Claims"
. S CT=CT+1
. I '(CT#10),$O(^TMP($J,IBHOW,Z)) S DIR("A")="Press return for more or '^' to exit ",DIR(0)="EA" W ! D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S QUIT=1
W !
Q
;
SCRN(Y) ; JWS;IB*2.0*641; added SCRN label to screen $$PROD^XUPROD(1) to allow more claim selections in non-prod environments
I '$$PROD^XUPROD(1),+^IBA(364,Y,0),'$O(^IBA(364,"B",+^(0),Y)) Q 1
I '$P(^IBA(364,Y,0),U,7),'$O(^IBA(364,"B",+^(0),Y)) Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEPTC 11980 printed Dec 13, 2024@02:12:01 Page 2
IBCEPTC ;ALB/TMK - EDI PREVIOUSLY TRANSMITTED CLAIMS ; 4/12/05 11:15am
+1 ;;2.0;INTEGRATED BILLING;**296,320,348,349,547,592,623,659,641,665**;21-MAR-94;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Main entrypoint
+1 ; IBDT1,IBDT2 = last transmit date range to use
+2 ; IBSORT = primary sort criteria to use B=BATCH #,I=INS CO NAME
+3 ; IBFORM = form type to limit selection to U=UB-04,C=CMS-1500,J=J430D, OR A=ALL
+4 ; IBCRIT = the additional sort criteria needed
+5 ; IBPTCCAN = whether or not to include cancelled claims
+6 ; IBRCBFPC = whether or not to include force print @ clearinghouse
+7 ; ^TMP("IB_PREV_CLAIM_INS",$J) = 1 for specific ins co/null for all
+8 ; ^($J,1,ien)="" for ien of each ins co selected
+9 ; ^($J,2,payer ID,ien)="" if selected
+10 ; IBREP = format output should be put in R=report,S=Listman
+11 ;
+12 NEW DIR,DIC,X,Y,Z,Z0,Z1,IBHOW,IBACT,IBCT,IBREP,IBCRIT,IBDT1,IBDT2,IBLOC
+13 NEW IBFORM,IBOK,IBQUIT,IBSORT,IBY,DTOUT,DUOUT,%ZIS,ZTSAVE,ZTRTN,ZTDESC
+14 NEW POP,IBPAYER,EDI,INST,PROF,IBPTCCAN,DIROUT,DIRUT,DTOUT,DUOUT,IBRCBFPC
+15 ;
+16 WRITE !!,"*** Please Note ***"
+17 WRITE ?20,"2 '^' are needed to abort this option (^^)"
+18 WRITE !?20,"1 '^' brings you back to the previous prompt (^)"
+19 WRITE !
+20 ; IB*2.0*547 add new prompt for locally printed vs. transmitted claims
+21 SET DIR(0)="SA^P:Printed;T:Transmitted"
SET DIR("A")="Run report for (P)rinted or (T)ransmitted claims?: "
SET DIR("B")="Transmitted"
+22 DO ^DIR
KILL DIR
+23 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO ENQ
+24 ; Set a flag here to indicate user wants locally printed claims and use that to control how the rest of the prompts act.
+25 SET IBLOC=$SELECT(Y="T":"",1:1)
+26 ;
Q1 ;
+1 WRITE !
+2 ;S DIR(0)="SA^C:Claim;B:Batch;L:List",DIR("A")="Select By: (C)laim, (B)atch or see a (L)ist to pick from?: ",DIR("B")="List"
+3 ;WCJ;IB665;start;no longer selecting batches since each claim is now a batch
+4 ;S DIR(0)="SA^C:Claim;"_$S(IBLOC:"",1:"B:Batch;")_"L:List",DIR("A")="Select By: (C)laim"_$S(IBLOC:"",1:", (B)atch")_" or see a (L)ist to pick from?: ",DIR("B")="List"
+5 SET DIR(0)="SA^C:Claim;L:List"
SET DIR("A")="Select By: (C)laim or see a (L)ist to pick from?: "
SET DIR("B")="List"
+6 ;WCJ;IB665;end
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO ENQ
+9 SET IBHOW=Y
+10 IF IBLOC=1
WRITE !,"Previously printed claims to a payer that does not accept EDI are omitted."
+11 IF IBHOW="L"
GOTO Q1A
+12 ;
+13 SET IBQUIT=0
SET IBCT=0
+14 KILL ^TMP($JOB,IBHOW)
+15 FOR
Begin DoDot:1
+16 ;I IBHOW="C" S DIR("A")="Select a"_$S(IBCT:"nother",1:"")_" Claim: ",DIR(0)="PA^364:AEMQZ",DIR("S")="I '$P(^(0),U,7),'$O(^IBA(364,""B"",+^(0),Y))"
+17 ;JWS;IB*2.0*623;allow previously trans claims in test to be resubmitted if non-production environment "!'$$PROD^XUPROD(1)"
+18 ;JWS;IB*2.0*641v9;screen change in IB*623 failed - created SCRN label in this routine to perform check
+19 IF IBHOW="C"
IF IBLOC=""
SET DIR("A")="Select a"_$SELECT(IBCT:"nother",1:"")_" Claim: "
SET DIR(0)="PA^364:AEMQZ"
SET DIR("S")="I $$SCRN^IBCEPTC(Y)"
+20 IF IBHOW="C"
IF IBLOC=1
SET DIR("A")="Select a"_$SELECT(IBCT:"nother",1:"")_" Locally Printed Claim: "
SET DIR(0)="PA^399:AEMQZ"
SET DIR("S")="I '$D(^IBA(364,""B"",Y)),$$INSOK^IBCEF4(+$$CURR^IBCEF2(Y))"
+21 IF IBHOW="B"
SET DIR("A")="Select a"_$SELECT(IBCT:"nother",1:"")_" Batch: "
SET DIR(0)="PA^IBA(364.1,:AEMQ^W "" "",$P(^(0),U,3),"" Claims"""
SET DIR("S")="I '$P(^(0),U,14)"
+22 SET DIR("?")="^D SELDSP^IBCEPTC(IBHOW)"
+23 ; Optional prompt after one is selected
if IBCT
SET $PIECE(DIR(0),U)=$PIECE(DIR(0),U)_"O"
+24 DO ^DIR
KILL DIR
+25 IF Y'>0
SET IBQUIT=$SELECT(X="^":2,X="^^":3,1:1)
QUIT
+26 SET IBY=$SELECT(IBHOW="C":+Y,1:"")
SET Y=$SELECT(IBHOW="C":+Y(0),1:Y)
if IBLOC=1
SET Y=IBY
+27 IF '$DATA(^TMP($JOB,IBHOW,+Y))
SET IBCT=IBCT+1
SET ^TMP($JOB,IBHOW,+Y)=IBY
End DoDot:1
if IBQUIT
QUIT
+28 ;
+29 if IBQUIT=3
GOTO ENQ
+30 if IBQUIT=2!'$ORDER(^TMP($JOB,IBHOW,0))
GOTO Q1
+31 SET Z=0
+32 IF IBHOW="C"
FOR
SET Z=$ORDER(^TMP($JOB,"C",Z))
if 'Z
QUIT
SET ^TMP("IB_PREV_CLAIM_SELECT",$JOB,Z,0)=^TMP($JOB,"C",Z)
+33 IF IBHOW="B"
SET (Z,IBCT)=0
FOR
SET Z=$ORDER(^TMP($JOB,"B",Z))
if 'Z
QUIT
Begin DoDot:1
+34 SET Z0=0
FOR
SET Z0=$ORDER(^IBA(364,"C",Z,Z0))
if 'Z0
QUIT
SET Z1=+$GET(^IBA(364,Z0,0))
IF Z1
IF '$DATA(^TMP("IB_PREV_CLAIM_SELECT",$JOB,Z1,0))
SET ^(0)=Z0
SET IBCT=IBCT+1
End DoDot:1
+35 SET ^TMP("IB_PREV_CLAIM_SELECT",$JOB)=IBCT
+36 DO RESUB^IBCEPTC3
+37 GOTO ENQ
+38 ;
Q1A KILL ^TMP("IB_PREV_CLAIM_INS",$JOB)
+1 SET DIR(0)="SA^A:All Payers;S:Selected Payers"
+2 SET DIR("A")="Run for (A)ll Payers or (S)elected Payers?: "
SET DIR("B")="Selected Payers"
+3 WRITE !!,"PAYER SELECTION:"
DO ^DIR
KILL DIR
+4 IF X="^^"
GOTO ENQ
+5 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q1
+6 ;
+7 IF Y="A"
SET ^TMP("IB_PREV_CLAIM_INS",$JOB)=""
GOTO Q2
+8 ;
+9 ; esg - 11/21/05 - patch 320 question
+10 WRITE !
+11 SET DIR(0)="Y"
SET DIR("A")=" Include all payers with the same electronic Payer ID"
SET DIR("B")="Yes"
DO ^DIR
KILL DIR
+12 IF $DATA(DIROUT)
GOTO ENQ
+13 IF $DATA(DIRUT)
GOTO Q1A
+14 SET IBPAYER=Y
+15 WRITE !
+16 ;
+17 SET ^TMP("IB_PREV_CLAIM_INS",$JOB)=1
+18 SET IBQUIT=0
+19 FOR
Begin DoDot:1
+20 ; IB*2.0*547 allow lookup by EDI#'s using new cross-ref
+21 ;S DIC(0)="AEMQ",DIC=36,DIC("A")=" Select Insurance Company: "
+22 SET DIC(0)="AEMQn"
SET DIC=36
SET DIC("A")=" Select Insurance Company: "
+23 IF $ORDER(^TMP("IB_PREV_CLAIM_INS",$JOB,1,""))
SET DIC("A")=" Select Another Insurance Company: "
+24 SET DIC("W")="D INSLIST^IBCEMCA(Y)"
+25 ;D ^DIC K DIC ; lookup
+26 NEW D
SET D="B^AEI^AEP"
DO MIX^DIC1
KILL DIC,D
+27 ; user entered "^^"
IF X="^^"
SET IBQUIT=2
QUIT
+28 ; user is done
IF +Y'>0
SET IBQUIT=1
QUIT
+29 WRITE !
+30 SET ^TMP("IB_PREV_CLAIM_INS",$JOB,1,+Y)=""
+31 IF 'IBPAYER
QUIT
+32 SET EDI=$$UP^XLFSTR($GET(^DIC(36,+Y,3)))
+33 SET PROF=$PIECE(EDI,U,2)
SET INST=$PIECE(EDI,U,4)
+34 IF PROF'=""
IF PROF'["PRNT"
SET ^TMP("IB_PREV_CLAIM_INS",$JOB,2,PROF,+Y)=""
+35 IF INST'=""
IF INST'["PRNT"
SET ^TMP("IB_PREV_CLAIM_INS",$JOB,2,INST,+Y)=""
+36 QUIT
End DoDot:1
if IBQUIT
QUIT
+37 ;
+38 IF IBQUIT=2
GOTO ENQ
+39 ;
+40 IF '$ORDER(^TMP("IB_PREV_CLAIM_INS",$JOB,1,0))
Begin DoDot:1
+41 WRITE *7,!!?3,"No payers have been selected. Please try again."
+42 QUIT
End DoDot:1
GOTO Q1A
+43 ;
Q2 ;; JWS;IB*2.0*592 US1108 - Dental EDI 837D / form J430D
+1 ;IA# 10026
+2 SET DIR(0)="SA^C:CMS-1500;U:UB-04;J:J430D;A:All"
SET DIR("B")="All"
+3 SET DIR("A")="Run for (U)B-04, (C)MS-1500, (J)430D or (A)ll: "
+4 WRITE !!,"BILL FORM TYPE SELECTION:"
DO ^DIR
KILL DIR
+5 IF X="^^"
GOTO ENQ
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q1A
+7 SET IBFORM=Y
+8 ;
Q3 ;WCJ;IB665;start;allow times
+1 SET IBDTSAME=0
+2 SET DIR(0)="DA^0:9999999:EPTX"
+3 SET DIR("A")="Start with Date "_$SELECT(IBLOC:"First Printed: ",1:"Last Transmitted: ")
+4 SET DIR("?",1)="This is the earliest date on which a claim that you want to include on this"
+5 SET DIR("?",2)="report was "_$SELECT(IBLOC=1:"first printed",1:"last transmitted")_". You may choose a maximum date range of 90 days."
+6 SET DIR("?",3)="*Times are optional."
+7 SET DIR("?")=" "
+8 WRITE !!,$SELECT(IBLOC:"FIRST PRINT",1:"LAST BATCH TRANSMIT")_" DATE RANGE SELECTION:"
DO ^DIR
KILL DIR
+9 IF X="^^"
GOTO ENQ
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q2
+11 SET IBDT1=Y
+12 ;
Q3ED ; go to date
+1 SET IBDT2=$$FMADD^XLFDT(IBDT1,90)
+2 SET IBDT2=$PIECE(IBDT2,".")
+3 IF IBDT2>DT
SET IBDT2=DT
+4 SET DIR("?",1)="This is the latest date on which a claim that you want to include on this"
+5 SET DIR("?",2)="report was "_$SELECT(IBLOC:"first printed",1:"last transmitted")_". You may choose a maximum date range of 90 days."
+6 SET DIR("?",3)="*Times are optional."
+7 SET DIR("?")=" "
+8 SET DIR("B")=$$FMTE^XLFDT(IBDT2,2)
+9 SET DIR(0)="DA^"_(IBDT1\1)_":"_(IBDT2+.24)_":EPTX"
+10 SET DIR("A")="Go to Date "_$SELECT(IBLOC:"First Printed",1:"Last Transmitted")_":("_$$FMTE^XLFDT(IBDT1,2)_"-"_$$FMTE^XLFDT(IBDT2,2)_"): "
+11 DO ^DIR
KILL DIR
+12 IF X="^^"
GOTO ENQ
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q3
+14 ; if you have an end time, it has to be after start time
IF $PIECE(Y,".",2)
IF Y<IBDT1
WRITE !!,"'Go to Date' must be after 'Start with Date'",!
GOTO Q3ED
+15 ;WCJ;IB665;end
+16 SET IBDT2=Y
+17 ;
Q4 ; Additional selection criteria
+1 ;WCJ;IB665;start;added A0 selection
+2 ;S DIR(0)="SAO^1:MRA Secondary Only;2:Primary Claims Only;3:Secondary Claims Only;4:Claims Previously Printed at Clearinghouse;5:A0 Received in Austin Only"
+3 SET DIR(0)="SAO^1:MRA Secondary Only;2:Primary Claims Only;3:Secondary Claims Only"
+4 IF 'IBLOC
SET DIR(0)=DIR(0)_"4:Claims Previously Printed at Clearinghouse;5:A0 Received in Austin Only"
+5 SET DIR("A",1)="ADDITIONAL SELECTION CRITERIA:"
SET DIR("A",2)=" "
SET DIR("A",3)="1 - MRA Secondary Only"
SET DIR("A",4)="2 - Primary Claims Only"
SET DIR("A",5)="3 - Secondary Claims Only"
+6 ;S DIR("A",6)=$S(IBLOC:"",1:"4 - Claims Sent to Print at Clearinghouse Only"),DIR("A",7)=" ",DIR("A")="Select Additional Limiting Criteria (optional): "
+7 IF 'IBLOC
Begin DoDot:1
+8 SET DIR("A",6)="4 - Claims Sent to Print at Clearinghouse Only"
+9 SET DIR("A",7)="5 - A0 Received in Austin Only"
End DoDot:1
+10 ;S DIR("A",7)=" ",DIR("A")="Select Additional Limiting Criteria (optional): "
+11 SET DIR("A",$SELECT(IBLOC:6,1:8))=" "
SET DIR("A")="Select Additional Limiting Criteria (optional): "
+12 ;WCJ;IB665;end
+13 SET DIR("?")="Select one of the listed criteria to further limit the claims to include"
+14 WRITE !
DO ^DIR
KILL DIR
+15 IF X="^^"
GOTO ENQ
+16 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q3
+17 SET IBCRIT=Y
+18 ;
Q41 ; Ask user if they want to include cancelled claims
+1 SET DIR(0)="Y"
SET DIR("B")="No"
SET DIR("A")="Would you like to include cancelled claims"
+2 WRITE !
DO ^DIR
KILL DIR
+3 IF X="^^"
GOTO ENQ
+4 IF $DATA(DIRUT)
GOTO Q4
+5 SET IBPTCCAN=Y
+6 ; IB*2.0*547 skip next 2 questions if looking for locally printed claims
+7 IF IBLOC
SET IBSORT=2
SET IBRCBFPC=0
GOTO Q6
+8 ;
Q42 ; Include claims that are forced to print at clearinghouse?
+1 SET DIR(0)="Y"
SET DIR("B")="No"
SET DIR("A")="Would you like to include claims Forced to Print at the Clearinghouse"
+2 WRITE !
DO ^DIR
KILL DIR
+3 IF X="^^"
GOTO ENQ
+4 IF $DATA(DIRUT)
GOTO Q41
+5 SET IBRCBFPC=Y
+6 ;
Q5 SET DIR("L",1)="Select one of the following: "
SET DIR("L",2)=" "
SET DIR("L",3)=$JUSTIFY("",10)_"1 Batch By Last Transmitted Date (Claims within a Batch)"
SET DIR("L",4)=$JUSTIFY("",10)_"2 Current Payer (Insurance Company)"
+1 SET DIR("L",5)=" "
+2 SET DIR(0)="SA^1:Batch By Last Transmitted Date (Claims within a Batch);2:Current Payer (Insurance Company)"
SET DIR("B")="Current Payer"
+3 SET DIR("A")="Sort By: "
+4 WRITE !
DO ^DIR
KILL DIR
+5 IF X="^^"
GOTO ENQ
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q42
+7 SET IBSORT=Y
+8 ;
Q6 SET DIR(0)="SA^R:Report;S:Screen List"
+1 SET DIR("A")="Do you want a (R)eport or a (S)creen List format?: "
+2 SET DIR("B")="Screen List"
+3 WRITE !
DO ^DIR
KILL DIR
+4 IF X="^^"
GOTO ENQ
+5 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q5
+6 SET IBREP=Y
+7 ; IB *2.0*547 call new SUB-routine for locally printed claims (not in file 364)
+8 IF IBREP="S"
IF IBLOC
DO LOC^IBCEPTC0
GOTO ENQ
+9 ;
+10 IF IBREP="S"
IF 'IBLOC
DO LIST^IBCEPTC0
GOTO ENQ
+11 ;
Q7 ; Select device
+1 FOR
SET IBACT=0
DO DEVSEL(.IBACT)
if IBACT
QUIT
+2 IF IBACT=99
GOTO ENQ
+3 USE IO
+4 ; IB *2.0*547 call new SUB-routine for locally printed claims (not in file 364)
+5 if 'IBLOC
DO LIST^IBCEPTC0
+6 if IBLOC
DO LOC^IBCEPTC0
+7 ;
ENQ KILL ^TMP("IB_PREV_CLAIM_INS",$JOB),^TMP("IB_PREV_CLAIM_SELECT",$JOB)
+1 QUIT
+2 ;
DEVSEL(IBACT) ;
+1 NEW DIR,POP,X,Y,ZTRTN,ZTSAVE
+2 WRITE !!,"You will need a 132 column printer for this report!"
+3 SET %ZIS="QM"
DO ^%ZIS
IF POP
SET IBACT=99
GOTO DEVSELQ
+4 IF $GET(IOM)
IF IOM<132
SET IBOK=1
Begin DoDot:1
+5 SET DIR(0)="YA"
SET DIR("A",1)="This report requires output to a 132 column device."
SET DIR("A",2)="The device you have chosen is only set for "_IOM_"."
SET DIR("A")="Are you sure you want to continue?: "
SET DIR("B")="No"
+6 WRITE !
DO ^DIR
KILL DIR
+7 IF Y'=1
SET IBOK=0
WRITE !
End DoDot:1
IF 'IBOK
SET IBACT=0
GOTO DEVSELQ
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 KILL IO("Q")
+10 SET ZTRTN="LIST^IBCEPTC0"
SET ZTSAVE("IBCRIT(")=""
SET ZTSAVE("IB*")=""
SET ZTSAVE("^TMP(""IB_PREV_CLAIM_INS"",$J)")=""
SET ZTSAVE("^TMP(""IB_PREV_CLAIM_INS"",$J,")=""
SET ZTDESC="IB - Previously Transmitted Claims Report"
+11 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
SET IBACT=99
GOTO DEVSELQ
+12 SET IBACT=1
DEVSELQ QUIT
+1 ;
SELDSP(IBHOW) ; Display list of selected claims/batches
+1 ; IBHOW = "C" for claims "B" for batches
+2 NEW Z,DIR,CT,QUIT
+3 IF '$ORDER(^TMP($JOB,IBHOW,0))
QUIT
+4 SET (CT,QUIT)=0
+5 WRITE !!,$SELECT(IBHOW="C":"Claims",1:"Batches")," Already Selected:"
+6 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,IBHOW,Z))
if 'Z!QUIT
QUIT
SET Z0=$GET(^(Z))
Begin DoDot:1
+7 IF IBHOW="C"
WRITE !,?3,$PIECE($GET(^DGCR(399,Z,0)),U)
QUIT
+8 WRITE !,?3,$PIECE($GET(^IBA(364.1,Z,0)),U)," ",$PIECE(^(0),U,3)," Claims"
+9 SET CT=CT+1
+10 IF '(CT#10)
IF $ORDER(^TMP($JOB,IBHOW,Z))
SET DIR("A")="Press return for more or '^' to exit "
SET DIR(0)="EA"
WRITE !
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+11 WRITE !
+12 QUIT
+13 ;
SCRN(Y) ; JWS;IB*2.0*641; added SCRN label to screen $$PROD^XUPROD(1) to allow more claim selections in non-prod environments
+1 IF '$$PROD^XUPROD(1)
IF +^IBA(364,Y,0)
IF '$ORDER(^IBA(364,"B",+^(0),Y))
QUIT 1
+2 IF '$PIECE(^IBA(364,Y,0),U,7)
IF '$ORDER(^IBA(364,"B",+^(0),Y))
QUIT 1
+3 QUIT 0
+4 ;
