BAR50R01 ;IHS/DIT/CPC - 20171031 A/R ERA CORRECTED INFORMATION NOTICE
;;1.8;IHS ACCOUNTS RECEIVABLE;**27**;NOV 30, 2017;Build 12
;
;ASKS FOR A A/R EDI FILE RECORD, SCANS FOR NM1*74 ENTRIES FOR CORRECTED
;PERSON INFORMATION AND PRINTS REPORT WITH SUBMITTED AND CORRECTED DATA
;
;IHS/DIT/CPC New Medicare Card Initiative CR09273 11/3/2017 - BAR*1.8*27
;
;
;
RUNRPT ; EP
I $G(DUZ(2))="" D Q
.W !!,"Check your DUZ setup."
.D EOP^BARUTL(1)
N RPTLOOK S RPTLOOK=1 ;Allow rpts to view ERA batches older than 3rd qtr past
D SELFL^BAREDP00
I Y'>0 Q
I TRNAME'[("5010") W !!,"The file selected is not a 5010 ERA, please select another" G RUNRPT
D BLD
I COUNT>0 D
.D DEVICE
.Q:$G(BARTERM)
.U IO(0)
.W:'$D(IO("S")) !!,"Printing..."
.U IO
.S BAR("PG")=0
.D HDR
.D REPORT
.I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
.;F I=$Y:1:(IOSL-5) W !
.W !
.D CENTER^BAR50R02("END OF REPORT",80,"*","*",.ENDBNR)
.S I=0 F S I=$O(ENDBNR(I)) Q:I="" W !,$G(ENDBNR(I))
.K ENDBNR
.D FOOTER
D ^%ZISC
D HOME^%ZIS
D CLNUP
Q
;
BLD ;
K ^TMP($J,"BAR50R01") ; CLEAR TMP NODE
S NODE=0,COUNT=0
F S NODE=$O(^BAREDI("I",DUZ(2),IMPDA,15,NODE)) Q:+NODE=0 D
.I $E(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,6)="N1*PR*" D ;PAYER
..S (PAYERNAME,PAYERADD,PAYERCSZ,PAYERTEL,PAYEROTH)=""
..S PAYERNAME=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",3)
..S:PAYERNAME']"" PAYERNAME="NOTLISTED"
..S:$E(^BAREDI("I",DUZ(2),IMPDA,15,NODE+1,0),1,3)="N3*" PAYERADD=^BAREDI("I",DUZ(2),IMPDA,15,NODE+1,0)
..S:$E(^BAREDI("I",DUZ(2),IMPDA,15,NODE+2,0),1,3)="N4*" PAYERCSZ=^BAREDI("I",DUZ(2),IMPDA,15,NODE+2,0)
..S:$E(^BAREDI("I",DUZ(2),IMPDA,15,NODE+3,0),1,11)="PER*CX**TE*" PAYERTEL=^BAREDI("I",DUZ(2),IMPDA,15,NODE+3,0)
..S:$E(^BAREDI("I",DUZ(2),IMPDA,15,NODE+4,0),1,7)="PER*BL*" PAYEROTH=^BAREDI("I",DUZ(2),IMPDA,15,NODE+4,0)
..;END PAYER NODES
.;
.;GET CLAIM PAYMENT NODES
.I $E(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,4)="CLP*" S CLMPMNT=^BAREDI("I",DUZ(2),IMPDA,15,NODE,0)
.I $E(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,4)="CAS*" S CLMADJ(NODE)=^BAREDI("I",DUZ(2),IMPDA,15,NODE,0)
.;
.;GET CORRECTED INSURED, SET TMP GLOBAL FOR REPORTING
.I $E(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,9)="NM1*74*1*" D ;CORRECTED
..S COUNT=COUNT+1
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",1)=PAYERNAME ;PAYER
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",2)=$P(PAYERADD,"*",2) ;PAYER ADDRESS 1
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",3)=$P(PAYERADD,"*",3) ;PAYER ADDRESS 2
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",4)=$P(PAYERCSZ,"*",2) ;PAYER CITY
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",5)=$P(PAYERCSZ,"*",3) ;PAYER STATE
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",6)=$P(PAYERCSZ,"*",4) ;PAYER ZIP
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",7)=$P(PAYERTEL,"*",5) ;PAYER TELEPHONE
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",8)=$P(PAYEROTH,"*",3) ;PAYER OTHER NAME
..S:$P(PAYEROTH,"*",4)="EM" $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",9)=$P(PAYEROTH,"*",5) ;PAYER EM
..S:$P(PAYEROTH,"*",6)="TE" $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",3)=$P(PAYEROTH,"*",7) ;PAYER OTHER TELEPHONE
..;END PAYER NODES
..;START CLAIM NODES
..I $P(CLMPMNT,"*",2)]"" D ;CLAIM NUMBER
...S ^TMP($J,"BAR50R01",PAYERNAME,COUNT,"CLAIM")=$P(CLMPMNT,"*",2) ;CLAIM NUMBER
...S NODE30=0,NODE30=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",$P(CLMPMNT,"*",2),NODE30))
...S BARSTATC=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,NODE30,0)),U,2)
...I BARSTATC'="P",BARSTATC'="M" S ^TMP($J,"BAR50R01",PAYERNAME,COUNT,"CLAIM")=^TMP($J,"BAR50R01",PAYERNAME,COUNT,"CLAIM")_"-BILL NOT FOUND IN RPMS"
..E S ^TMP($J,"BAR50R01",PAYERNAME,COUNT,"CLAIM")="NO CLAIM NUMBER-BILL NOT FOUND IN RPMS"
..;END CLAIM NODES
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",1)="C" ;CORRECTED NODE
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",2)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",4) ;LASTNAME
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",3)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",5) ;FIRSTNAME
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",4)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",6) ;MID NAME
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",5)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",8) ;SUFFIX NAME
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",6)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",9) ;ID TYPE
..S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",7)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",10) ;ID CODE
..I $E(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),1,9)="NM1*QC*1*" D
...S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",1)="P" ;PATIENT NODE
...D PNODE
...;
..I $E(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),1,9)="NM1*IL*1*" D
...S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",1)="I" ;INSURED NODE
...D PNODE
I COUNT=0 W !,"No correction information in this ERA",! Q
S SORT="",STEST=""
F SORT=$O(^TMP($J,"BAR50R01","SORT",PAYERNAME,SORT)) Q:SORT="" D
.I STEST'=SORT D
..S STEST=SORT
.E
Q
;
PNODE ;
S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",2)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",4) ;LASTNAME
S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",3)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",5) ;FIRSTNAME
S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",4)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",6) ;MID NAME
S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",5)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",8) ;SUFFIX NAME
S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",6)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",9) ;ID TYPE
S $P(^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",7)=$P(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",10) ;ID CODE
;
S SORT=^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT")
S CLAIM=^TMP($J,"BAR50R01",PAYERNAME,COUNT,"CLAIM")
;
S ^TMP($J,"BAR50R01","SORT",PAYERNAME,SORT,"PAYER")=^TMP($J,"BAR50R01",PAYERNAME,COUNT,"PAYER")
S ^TMP($J,"BAR50R01","SORT",PAYERNAME,SORT,"SUBMIT")=^TMP($J,"BAR50R01",PAYERNAME,COUNT,"SUBMIT")
S ^TMP($J,"BAR50R01","SORT",PAYERNAME,SORT,"XCORRECT")=^TMP($J,"BAR50R01",PAYERNAME,COUNT,"XCORRECT")
S ^TMP($J,"BAR50R01","SORT",PAYERNAME,SORT,"CLAIM",CLAIM)=^TMP($J,"BAR50R01",PAYERNAME,COUNT,"CLAIM")
Q
;
HDR ;
S BAR("PRIVACY")=1,BAR("BARTEXT")=0,BAR("HD",0)=""
S BAR("PG")=BAR("PG")+1
S $P(BARDASH,"=",80)=""
S $P(BARLINE,"-",80)=""
D NOW^%DTC
S Y=%
X ^DD("DD")
S BARDTM=$P(Y,":",1,2)
W !,BARDASH,!
W "List Corrections Sent in ERA",?51,BARDTM," Page ",BAR("PG"),!
W "Location: ",$P($G(^DIC(4,DUZ(2),0)),U,1),!
W "For File Name: ",HSTFILE,!
W "For RPMS File: ",$P(^BAREDI("I",DUZ(2),IMPDA,0),U,1),!
W BARDASH,!
Q
SUBHDR ;
W ?1,"DATA",?10,"LAST NAME",?33,"FIRST NAME",?51,"MI",?57,"SUFFIX",?65,"POLICY NUMBER",!
W ?1,"SOURCE",?14,"BILL(s)",!
W BARLINE,!
Q
I BARTYP="S" D
. X BAR("COL")
. W !,BARDASH,!
Q
;
REPORT ;
S PAYER="",PLEAFTST="",PLEAF="",ILEAFTST="",ILEAFCLM=""
F S PAYER=$O(^TMP($J,"BAR50R01","SORT",PAYER)) Q:PAYER="" D
.I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
.S SORT=""
.F S SORT=$O(^TMP($J,"BAR50R01","SORT",PAYER,SORT)) Q:SORT="" D
..I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
..S PLEAF=^TMP($J,"BAR50R01","SORT",PAYER,SORT,"PAYER")
..I PLEAF'=PLEAFTST D
...I PLEAFTST]"" D
....D CENTER^BAR50R02("END OF "_$P(PLEAFTST,U),80,"*","*",.ENDBNR)
....S I=0 F S I=$O(ENDBNR(I)) Q:I="" W !,$G(ENDBNR(I))
....K ENDBNR
....W !!,BARDASH,!
...S PNAME1=$P(PLEAF,U,1),PNAME2="",I=0
...I $L(PNAME1)>35 D
....F I=$L(PNAME1):-1:0 D
.....I $E(PNAME1,I)=" ",(I<=40) D
......S PNAME1=$E(PNAME1,1,I),PNAME2=$E(PNAME1,I+1,$L(PNAME1)-I)
...W PNAME1,?45,$P(PLEAF,U,2),!
...W PNAME2,?45,$P(PLEAF,U,4),", ",$P(PLEAF,U,5)," ",$P(PLEAF,U,6),!!
...D SUBHDR
...S PLEAFTST=PLEAF
..S ILEAF=^TMP($J,"BAR50R01","SORT",PAYER,SORT,"SUBMIT")
..I ILEAF'=ILEAFTST D
...W ?1,"RPMS"
...W ?10,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,2)
...W ?33,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,3)
...W ?51,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,4)
...W ?57,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,5)
...W ?65,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,7)
...W !
...W ?1,"ERA"
...W ?10,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,2)
...W ?33,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,3)
...W ?51,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,4)
...W ?57,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,5)
...W ?65,$P(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,7)
...S I=0 F S I=$O(^TMP($J,"BAR50R01","SORT",PAYER,SORT,"CLAIM",I)) Q:I="" W !,?14,^TMP($J,"BAR50R01","SORT",PAYER,SORT,"CLAIM",I)
...W !!
...I $Y>(IOSL-6) D
....W !
....D FOOTER
....I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
....D HDR
...S ILEAFTST=ILEAF
...I $Y>(IOSL-6) D FOOTER
...I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
Q
;
K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR
W @IOF
Q
;
DEVICE ;SET UP DEVICE
S %ZIS("A")="Output Device: "
S %ZIS="MQ"
D ^%ZIS
S:POP BARTERM=1
Q
;
CLNUP ;
K BAR("PG"),BARDASH,BARLINE,BARTERM,CLAIM,CLMADJ,CLMPMNT,CLMTST1,CLMTST2,COUNT
K DIROUT,DTOUT,DUOUT,ENDBNR,HSTFILE,HSTIME
K I,ILEAF,ILEAFCLM,ILEAFTST,IMP,IMPDA,IND,J,L
K NOBTCH,NODE,NODE30,PAYER,PAYERADD,PAYERADD1,PAYERCSZ
K PAYERNAME,PAYEROTH,PAYERTEL,PLEAF,PLEAFTST,PNAME1,PNAME2,POP
K RPTLOOK,STEST,TRDA,TRNAME,X
K ^TMP($J,"BAR50R01")
Q
BAR50R01 ;IHS/DIT/CPC - 20171031 A/R ERA CORRECTED INFORMATION NOTICE
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**27**;NOV 30, 2017;Build 12
+2 ;
+3 ;ASKS FOR A A/R EDI FILE RECORD, SCANS FOR NM1*74 ENTRIES FOR CORRECTED
+4 ;PERSON INFORMATION AND PRINTS REPORT WITH SUBMITTED AND CORRECTED DATA
+5 ;
+6 ;IHS/DIT/CPC New Medicare Card Initiative CR09273 11/3/2017 - BAR*1.8*27
+7 ;
+8 ;
+9 ;
RUNRPT ; EP
+1 IF $GET(DUZ(2))=""
Begin DoDot:1
+2 WRITE !!,"Check your DUZ setup."
+3 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+4 ;Allow rpts to view ERA batches older than 3rd qtr past
NEW RPTLOOK
SET RPTLOOK=1
+5 DO SELFL^BAREDP00
+6 IF Y'>0
QUIT
+7 IF TRNAME'[("5010")
WRITE !!,"The file selected is not a 5010 ERA, please select another"
GOTO RUNRPT
+8 DO BLD
+9 IF COUNT>0
Begin DoDot:1
+10 DO DEVICE
+11 IF $GET(BARTERM)
QUIT
+12 USE IO(0)
+13 IF '$DATA(IO("S"))
WRITE !!,"Printing..."
+14 USE IO
+15 SET BAR("PG")=0
+16 DO HDR
+17 DO REPORT
+18 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+19 ;F I=$Y:1:(IOSL-5) W !
+20 WRITE !
+21 DO CENTER^BAR50R02("END OF REPORT",80,"*","*",.ENDBNR)
+22 SET I=0
FOR
SET I=$ORDER(ENDBNR(I))
IF I=""
QUIT
WRITE !,$GET(ENDBNR(I))
+23 KILL ENDBNR
+24 DO FOOTER
End DoDot:1
+25 DO ^%ZISC
+26 DO HOME^%ZIS
+27 DO CLNUP
+28 QUIT
+29 ;
BLD ;
+1 ; CLEAR TMP NODE
KILL ^TMP($JOB,"BAR50R01")
+2 SET NODE=0
SET COUNT=0
+3 FOR
SET NODE=$ORDER(^BAREDI("I",DUZ(2),IMPDA,15,NODE))
IF +NODE=0
QUIT
Begin DoDot:1
+4 ;PAYER
IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,6)="N1*PR*"
Begin DoDot:2
+5 SET (PAYERNAME,PAYERADD,PAYERCSZ,PAYERTEL,PAYEROTH)=""
+6 SET PAYERNAME=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",3)
+7 IF PAYERNAME']""
SET PAYERNAME="NOTLISTED"
+8 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE+1,0),1,3)="N3*"
SET PAYERADD=^BAREDI("I",DUZ(2),IMPDA,15,NODE+1,0)
+9 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE+2,0),1,3)="N4*"
SET PAYERCSZ=^BAREDI("I",DUZ(2),IMPDA,15,NODE+2,0)
+10 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE+3,0),1,11)="PER*CX**TE*"
SET PAYERTEL=^BAREDI("I",DUZ(2),IMPDA,15,NODE+3,0)
+11 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE+4,0),1,7)="PER*BL*"
SET PAYEROTH=^BAREDI("I",DUZ(2),IMPDA,15,NODE+4,0)
+12 ;END PAYER NODES
End DoDot:2
+13 ;
+14 ;GET CLAIM PAYMENT NODES
+15 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,4)="CLP*"
SET CLMPMNT=^BAREDI("I",DUZ(2),IMPDA,15,NODE,0)
+16 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,4)="CAS*"
SET CLMADJ(NODE)=^BAREDI("I",DUZ(2),IMPDA,15,NODE,0)
+17 ;
+18 ;GET CORRECTED INSURED, SET TMP GLOBAL FOR REPORTING
+19 ;CORRECTED
IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),1,9)="NM1*74*1*"
Begin DoDot:2
+20 SET COUNT=COUNT+1
+21 ;PAYER
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",1)=PAYERNAME
+22 ;PAYER ADDRESS 1
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",2)=$PIECE(PAYERADD,"*",2)
+23 ;PAYER ADDRESS 2
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",3)=$PIECE(PAYERADD,"*",3)
+24 ;PAYER CITY
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",4)=$PIECE(PAYERCSZ,"*",2)
+25 ;PAYER STATE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",5)=$PIECE(PAYERCSZ,"*",3)
+26 ;PAYER ZIP
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",6)=$PIECE(PAYERCSZ,"*",4)
+27 ;PAYER TELEPHONE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",7)=$PIECE(PAYERTEL,"*",5)
+28 ;PAYER OTHER NAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",8)=$PIECE(PAYEROTH,"*",3)
+29 ;PAYER EM
IF $PIECE(PAYEROTH,"*",4)="EM"
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",9)=$PIECE(PAYEROTH,"*",5)
+30 ;PAYER OTHER TELEPHONE
IF $PIECE(PAYEROTH,"*",6)="TE"
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER"),"^",3)=$PIECE(PAYEROTH,"*",7)
+31 ;END PAYER NODES
+32 ;START CLAIM NODES
+33 ;CLAIM NUMBER
IF $PIECE(CLMPMNT,"*",2)]""
Begin DoDot:3
+34 ;CLAIM NUMBER
SET ^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"CLAIM")=$PIECE(CLMPMNT,"*",2)
+35 SET NODE30=0
SET NODE30=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"B",$PIECE(CLMPMNT,"*",2),NODE30))
+36 SET BARSTATC=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,NODE30,0)),U,2)
+37 IF BARSTATC'="P"
IF BARSTATC'="M"
SET ^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"CLAIM")=^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"CLAIM")_"-BILL NOT FOUND IN RPMS"
End DoDot:3
+38 IF '$TEST
SET ^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"CLAIM")="NO CLAIM NUMBER-BILL NOT FOUND IN RPMS"
+39 ;END CLAIM NODES
+40 ;CORRECTED NODE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",1)="C"
+41 ;LASTNAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",2)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",4)
+42 ;FIRSTNAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",3)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",5)
+43 ;MID NAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",4)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",6)
+44 ;SUFFIX NAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",5)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",8)
+45 ;ID TYPE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",6)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",9)
+46 ;ID CODE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT"),"^",7)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE,0),"*",10)
+47 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),1,9)="NM1*QC*1*"
Begin DoDot:3
+48 ;PATIENT NODE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",1)="P"
+49 DO PNODE
+50 ;
End DoDot:3
+51 IF $EXTRACT(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),1,9)="NM1*IL*1*"
Begin DoDot:3
+52 ;INSURED NODE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",1)="I"
+53 DO PNODE
End DoDot:3
End DoDot:2
End DoDot:1
+54 IF COUNT=0
WRITE !,"No correction information in this ERA",!
QUIT
+55 SET SORT=""
SET STEST=""
+56 FOR SORT=$ORDER(^TMP($JOB,"BAR50R01","SORT",PAYERNAME,SORT))
IF SORT=""
QUIT
Begin DoDot:1
+57 IF STEST'=SORT
Begin DoDot:2
+58 SET STEST=SORT
End DoDot:2
+59 IF '$TEST
End DoDot:1
+60 QUIT
+61 ;
PNODE ;
+1 ;LASTNAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",2)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",4)
+2 ;FIRSTNAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",3)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",5)
+3 ;MID NAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",4)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",6)
+4 ;SUFFIX NAME
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",5)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",8)
+5 ;ID TYPE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",6)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",9)
+6 ;ID CODE
SET $PIECE(^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT"),"^",7)=$PIECE(^BAREDI("I",DUZ(2),IMPDA,15,NODE-1,0),"*",10)
+7 ;
+8 SET SORT=^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT")
+9 SET CLAIM=^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"CLAIM")
+10 ;
+11 SET ^TMP($JOB,"BAR50R01","SORT",PAYERNAME,SORT,"PAYER")=^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"PAYER")
+12 SET ^TMP($JOB,"BAR50R01","SORT",PAYERNAME,SORT,"SUBMIT")=^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"SUBMIT")
+13 SET ^TMP($JOB,"BAR50R01","SORT",PAYERNAME,SORT,"XCORRECT")=^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"XCORRECT")
+14 SET ^TMP($JOB,"BAR50R01","SORT",PAYERNAME,SORT,"CLAIM",CLAIM)=^TMP($JOB,"BAR50R01",PAYERNAME,COUNT,"CLAIM")
+15 QUIT
+16 ;
HDR ;
+1 SET BAR("PRIVACY")=1
SET BAR("BARTEXT")=0
SET BAR("HD",0)=""
+2 SET BAR("PG")=BAR("PG")+1
+3 SET $PIECE(BARDASH,"=",80)=""
+4 SET $PIECE(BARLINE,"-",80)=""
+5 DO NOW^%DTC
+6 SET Y=%
+7 XECUTE ^DD("DD")
+8 SET BARDTM=$PIECE(Y,":",1,2)
+9 WRITE !,BARDASH,!
+10 WRITE "List Corrections Sent in ERA",?51,BARDTM," Page ",BAR("PG"),!
+11 WRITE "Location: ",$PIECE($GET(^DIC(4,DUZ(2),0)),U,1),!
+12 WRITE "For File Name: ",HSTFILE,!
+13 WRITE "For RPMS File: ",$PIECE(^BAREDI("I",DUZ(2),IMPDA,0),U,1),!
+14 WRITE BARDASH,!
+15 QUIT
SUBHDR ;
+1 WRITE ?1,"DATA",?10,"LAST NAME",?33,"FIRST NAME",?51,"MI",?57,"SUFFIX",?65,"POLICY NUMBER",!
+2 WRITE ?1,"SOURCE",?14,"BILL(s)",!
+3 WRITE BARLINE,!
+4 QUIT
+5 IF BARTYP="S"
Begin DoDot:1
+6 XECUTE BAR("COL")
+7 WRITE !,BARDASH,!
End DoDot:1
+8 QUIT
+9 ;
REPORT ;
+1 SET PAYER=""
SET PLEAFTST=""
SET PLEAF=""
SET ILEAFTST=""
SET ILEAFCLM=""
+2 FOR
SET PAYER=$ORDER(^TMP($JOB,"BAR50R01","SORT",PAYER))
IF PAYER=""
QUIT
Begin DoDot:1
+3 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+4 SET SORT=""
+5 FOR
SET SORT=$ORDER(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT))
IF SORT=""
QUIT
Begin DoDot:2
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+7 SET PLEAF=^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"PAYER")
+8 IF PLEAF'=PLEAFTST
Begin DoDot:3
+9 IF PLEAFTST]""
Begin DoDot:4
+10 DO CENTER^BAR50R02("END OF "_$PIECE(PLEAFTST,U),80,"*","*",.ENDBNR)
+11 SET I=0
FOR
SET I=$ORDER(ENDBNR(I))
IF I=""
QUIT
WRITE !,$GET(ENDBNR(I))
+12 KILL ENDBNR
+13 WRITE !!,BARDASH,!
End DoDot:4
+14 SET PNAME1=$PIECE(PLEAF,U,1)
SET PNAME2=""
SET I=0
+15 IF $LENGTH(PNAME1)>35
Begin DoDot:4
+16 FOR I=$LENGTH(PNAME1):-1:0
Begin DoDot:5
+17 IF $EXTRACT(PNAME1,I)=" "
IF (I<=40)
Begin DoDot:6
+18 SET PNAME1=$EXTRACT(PNAME1,1,I)
SET PNAME2=$EXTRACT(PNAME1,I+1,$LENGTH(PNAME1)-I)
End DoDot:6
End DoDot:5
End DoDot:4
+19 WRITE PNAME1,?45,$PIECE(PLEAF,U,2),!
+20 WRITE PNAME2,?45,$PIECE(PLEAF,U,4),", ",$PIECE(PLEAF,U,5)," ",$PIECE(PLEAF,U,6),!!
+21 DO SUBHDR
+22 SET PLEAFTST=PLEAF
End DoDot:3
+23 SET ILEAF=^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"SUBMIT")
+24 IF ILEAF'=ILEAFTST
Begin DoDot:3
+25 WRITE ?1,"RPMS"
+26 WRITE ?10,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,2)
+27 WRITE ?33,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,3)
+28 WRITE ?51,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,4)
+29 WRITE ?57,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,5)
+30 WRITE ?65,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"SUBMIT"),U,7)
+31 WRITE !
+32 WRITE ?1,"ERA"
+33 WRITE ?10,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,2)
+34 WRITE ?33,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,3)
+35 WRITE ?51,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,4)
+36 WRITE ?57,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,5)
+37 WRITE ?65,$PIECE(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"XCORRECT"),U,7)
+38 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"CLAIM",I))
IF I=""
QUIT
WRITE !,?14,^TMP($JOB,"BAR50R01","SORT",PAYER,SORT,"CLAIM",I)
+39 WRITE !!
+40 IF $Y>(IOSL-6)
Begin DoDot:4
+41 WRITE !
+42 DO FOOTER
+43 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+44 DO HDR
End DoDot:4
+45 SET ILEAFTST=ILEAF
+46 IF $Y>(IOSL-6)
DO FOOTER
+47 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
+1 KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)&(IO=IO(0)&'$DATA(IO("S")))
DO ^DIR
+2 WRITE @IOF
+3 QUIT
+4 ;
DEVICE ;SET UP DEVICE
+1 SET %ZIS("A")="Output Device: "
+2 SET %ZIS="MQ"
+3 DO ^%ZIS
+4 IF POP
SET BARTERM=1
+5 QUIT
+6 ;
CLNUP ;
+1 KILL BAR("PG"),BARDASH,BARLINE,BARTERM,CLAIM,CLMADJ,CLMPMNT,CLMTST1,CLMTST2,COUNT
+2 KILL DIROUT,DTOUT,DUOUT,ENDBNR,HSTFILE,HSTIME
+3 KILL I,ILEAF,ILEAFCLM,ILEAFTST,IMP,IMPDA,IND,J,L
+4 KILL NOBTCH,NODE,NODE30,PAYER,PAYERADD,PAYERADD1,PAYERCSZ
+5 KILL PAYERNAME,PAYEROTH,PAYERTEL,PLEAF,PLEAFTST,PNAME1,PNAME2,POP
+6 KILL RPTLOOK,STEST,TRDA,TRNAME,X
+7 KILL ^TMP($JOB,"BAR50R01")
+8 QUIT
