Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BAR50R01

BAR50R01.m

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