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

BAREDP05.m

Go to the documentation of this file. 
  1. BAREDP05 ; IHS/SD/LSL - REVIEW CLAIM STATUS ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20,23,24,26,28**;OCT 26,2005;Build 92
  1.  ;
  1.  ; IHS/SD/LSL - V1.7 Patch 4 - HIPAA
  1.  ; IHS/SD/LSL - 02/26/04 - V1.7 Patch 5 - Changed check to chk/eft
  1.  ;
  1.  ;IHS/SD/POT - 1.8*23
  1.  ;IHS/SD/POT - 1.8*24 - HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS 1/15/2014 & 2/5/2014 ;
  1.  ;IHS/SD/SDR - 1.8*26 - HEAT195751 - Made format of RPMS date and ERA date the same.
  1.  ;IHS/DIT/CPC CR9572 REMOVE OVER-RIDE REASON NOT TO POST WHEN MANUALLY MATCH - BAR*1.8*28
  1.  ;
  1.  D CLEAR^VALM1
  1.  ;
  1. EN ; EP
  1.  ;N ERRORS  ;BAR*1.8*5 SRS-80 IHS/SD/TPF 4/15/2008   ;IHS/DIT/CPC CR9572 - BAR*1.8*28
  1.  ; for the file type
  1.  K ^TMP($J,"LVL1")
  1.  D EN^VALM("BAR ERA Claim Review")
  1.  Q
  1.  ;
  1. HDR ; EP
  1.  ;  header code
  1.  S FHDR="File name : "_$P($G(^BAREDI("I",DUZ(2),IMPDA,0)),"^")
  1.  S THDR="Transport : "_$P($G(^BAREDI("1T",TRDA,0)),"^")
  1.  S VALMHDR(1)=$$PAD(THDR,45)_FHDR
  1.  I TRNAME["HIPAA" D
  1.  .S THDR=TRNAME
  1.  .S FHDR="File: "_$P($G(^BAREDI("I",DUZ(2),IMPDA,0)),U)
  1.  .S CHDR="Chk/EFT#: "_$S($G(BARCHK)'="":BARCHK,1:$P($G(^BARECHK(BARCKIEN,0)),U))
  1.  .S VALMHDR(1)=$$PAD(THDR,18)_"  "_$$PAD(FHDR,28)_"  "_CHDR
  1.  Q
  1.  ;
  1. INIT ; EP
  1.  ; init variables and list array
  1.  D GATHER(IMPDA)
  1.  S VALMCNT=LN
  1.  Q
  1.  ;
  1. HELP ; EP
  1.  ; help code
  1.  S X="?"
  1.  D DISP^XQORM1
  1.  D MSG^BARDUTL("",2,0,0)
  1.  Q
  1.  ;
  1. EXIT ; EP
  1.  ; exit code
  1.  D CLEAR^VALM1
  1.  K ^TMP($J,"LVL1")
  1.  Q
  1.  ;
  1. EXPND ; EP
  1.  ; expand code
  1.  Q
  1.  ;
  1. RESET ; EP
  1.  ; rebuilds array after action
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D INIT,HDR
  1.  Q
  1.  ;
  1. GATHER(IMPDA) ;
  1.  ; SUBRTN to set data into array
  1.  K ^TMP($J,"LVL1"),^TMP($J,"FD")
  1.  K ^TMP($J,"E"),^TMP($J,"A")
  1.  K ECLM,RRECORD   ;bar*1.8*28 IHS/DIT/CPC CR9572
  1.  S RECNM=0
  1.  S (LN,LINE,COUNT)=1
  1.  ;Get file details
  1.  S ELIST=".01;.02;.06;.08"
  1.  S ALIST="1.01;1.03;1.05;1.08"
  1.  S WHOLELST=ELIST_";"_ALIST
  1.  ; Build ^TMP($J,"E" and ^TMP($J,"A" globals for electronic and A/R 
  1.  ; claim details.
  1.  S CLMDA=0
  1.  I TRNAME["HIPAA" F  S CLMDA=$O(^BAREDI("I",DUZ(2),"F",BARCHK,IMPDA,CLMDA)) Q:'+CLMDA  D CLAIM
  1.  I TRNAME'["HIPAA" F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:CLMDA'>0  D CLAIM
  1.  ; Build records for output via Listman.
  1.  S RN=""
  1.  F  S RN=$O(^TMP($J,"E",RN)) Q:RN=""  D
  1.  .K EFLD
  1.  .S (ERECORD,EFN)=""
  1.  .F  S EFN=$O(^TMP($J,"E",RN,EFN)) Q:EFN=""  D
  1.  ..S EFLD(EFN)=$G(^TMP($J,"E",RN,EFN))
  1.  .;start new bar*1.8*26 IHS/SD/SDR HEAT195751
  1.  .S EFLD(.08)=($E(EFLD(.08),1,4)-1700)_$E(EFLD(.08),5,8)
  1.  .S EFLD(.08)=$$MDT^BARDUTL(EFLD(.08))
  1.  .S EFLD(.08)=$P(EFLD(.08),"-",2)_" "_$P(EFLD(.08),"-")_", "_$P(EFLD(.08),"-",3)
  1.  .;end new bar*1.8*26 IHS/SDR HEAT195751
  1.  .S ERECORD=$$PAD(EFLD(.01),18)_$$PAD(EFLD(.08),13)_$$PAD(EFLD(.06),30)
  1.  .S ERECORD=ERECORD_$$PAD(EFLD(.02),19)
  1.  .K AFLD
  1.  .S (ARECORD,AFN)=""
  1.  .F  S AFN=$O(^TMP($J,"A",RN,AFN)) Q:AFN=""  D
  1.  ..S AFLD(AFN)=$G(^TMP($J,"A",RN,AFN))
  1.  .S ARECORD=$$PAD(AFLD(1.01),18)_$$PAD(AFLD(1.05),13)
  1.  .S ARECORD=ARECORD_$$PAD(AFLD(1.03),18)_$$PAD(AFLD(1.08),15)
  1.  .;Set up eclaim details
  1.  .S ERECORD=$$PAD(COUNT,4)_ERECORD
  1.  .D SET^VALM10(LN,ERECORD,COUNT)
  1.  .S LN=LN+1
  1.  .;BEGIN BAR*1.8*5 SRS-80 IHS/SD/TPF 4/15/2008
  1.  .;SET UP REASON DETAILS
  1.  .I $D(^TMP($J,"E",RN,401)) D
  1.  ..S RHEADER=$$CJ^XLFSTR("**********REASONS NOT TO POST********",IOM)
  1.  ..D SET^VALM10(LN,RHEADER,COUNT)
  1.  ..S LN=LN+1
  1.  ..S REASDA=""
  1.  ..F  S REASDA=$O(^TMP($J,"E",RN,401,REASDA)) Q:'REASDA  D
  1.  ...S RRECORD=$$CJ^XLFSTR($P(^TMP($J,"E",RN,401,REASDA),U,3),IOM)
  1.  ...D SET^VALM10(LN,RRECORD,COUNT)
  1.  ...S LN=LN+1
  1.  .;Set up AR details
  1.  .I $TR(ARECORD," ")'="" D
  1.  ..S ARECORD=$$PAD("",4)_ARECORD
  1.  ..D SET^VALM10(LN,ARECORD,COUNT)
  1.  ..S LN=LN+1
  1.  .;Line spacing
  1.  .S BLANKLNE="    "
  1.  .D SET^VALM10(LN,BLANKLNE,COUNT)
  1.  .S LN=LN+1
  1.  .S COUNT=COUNT+1
  1.  .S LINE=LINE+1
  1.  I '$D(^TMP($J,"LVL1")) D
  1.  .S VALMQUIT=1
  1.  .W !!,"There are no Claims to Review."
  1.  .D PAZ^BARRUTL
  1.  Q
  1.  ;
  1. CLAIM ;
  1.  K RPT
  1.  D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",ELIST,"^TMP($J,""E"",LINE,")
  1.  S STATUS=$G(^TMP($J,"E",LINE,.02))
  1.  I (STATUS="MATCHED")!(STATUS="NOT TO POST") S RPT=1
  1.  S RPT=1  ;BAR*1.8*5 SRS-80 TESTING ONLY TPF
  1.  I '$D(RPT) K ^TMP($J,"E",LINE) Q
  1.  D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",ALIST,"^TMP($J,""A"",LINE,")
  1.  S IENS=CLMDA_","_IMPDA_","  ;bar*1.8*20 REQ5
  1.  S ^TMP($J,"E",LINE,"CLMDA")=CLMDA
  1.  ;put a "*" in front of the claim number if there is a comment on the claim
  1.  I $$GET1^DIQ(90056.0205,IENS,71)'="",($G(^TMP($J,"E",LINE,.01))'="") S ^TMP($J,"E",LINE,.01)=$S(^TMP($J,"E",LINE,.01)'["*":"*"_^TMP($J,"E",LINE,.01),1:^TMP($J,"E",LINE,.01))  ;bar*1.8*20 REQ5
  1.  ;GET REASON NOT TO POST MULTIPLE AND PLACE IN ^TMP GLOBAL
  1.  N REASDA,REASIENS,REASCODE
  1.  S REASDA=0
  1.  F  S REASDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,REASDA)) Q:'REASDA  D
  1.  .S REASIENS=REASDA_","_CLMDA_","_IMPDA_","
  1.  .S REASCODE=$$GET1^DIQ(90056.0205401,REASIENS,.01,"I")
  1.  .S ^TMP($J,"E",LINE,401,REASDA)=REASCODE_U_$$GET1^DIQ(90056.0205401,REASIENS,.01,"E")_U_$$GET1^DIQ(90056.21,REASCODE,.02,"E")
  1.  S LINE=LINE+1
  1.  Q
  1.  ;
  1. PAD(D,L) ;
  1.  ; -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)
  1.  ;
  1. GETITEM ; -- select item from list
  1.  S VALMLST=""
  1.  S VALMLST=$O(^TMP($J,"LVL1","IDX",VALMLST),-1)
  1.  D EN^VALM2(XQORNOD(0),"O")
  1.  I '$D(VALMY) Q
  1.  N XCLMDA
  1.  S XCLMDA=0
  1.  F  S XCLMDA=$O(VALMY(XCLMDA)) Q:XCLMDA=""  D
  1.  .S XCLM=$G(^TMP($J,"E",XCLMDA,"CLMDA"))
  1.  .D GETRECRD(XCLM)
  1.  D GATHER(IMPDA)
  1.  Q
  1.  ;
  1. BROWSE ; Called from Listman screen BAR ERA Claim Review
  1.  K CLAIM
  1.  D GETITEM
  1.  Q
  1.  ;
  1. GETRECRD(XCLM) ;
  1.  ;start new code bar*1.8*20 REQ5
  1.  ;They want to be able to change the statuses; user can change
  1.  ;  Matched -> Exception
  1.  ;  Unmatched -> Exception
  1.  ;  Exception -> Matched
  1.  ;  Unmatched -> Matched
  1.  ;The last two still have to go through the matching criteria and may have Not To Post reasons
  1.  ;All status changes will now require a comment to be entered.
  1.  D ENP^XBDIQ1(90056.0205,"IMPDA,XCLM",ELIST,"CLAIM($J,")
  1.  I $G(CLAIM($J,.02))="POSTED" W !!,"Cannot change the status of a POSTED claim" H 2 Q
  1.  I $G(CLAIM($J,.02))="BUILT" W !!,"Please run the BLMT option or Run Auto-Review first to do auto-matching" H 2 Q
  1.  W !,"Do you wish to change the status of claim ",$G(CLAIM($J,.01))
  1.  W " (# "_XCLMDA_" )"
  1.  I "^MATCHED^EXCEPTION^"[("^"_$G(CLAIM($J,.02))_"^") D
  1.  .I $G(CLAIM($J,.02))="MATCHED" S NEWSTAT="E"
  1.  .I $G(CLAIM($J,.02))="EXCEPTION" S NEWSTAT="M"
  1.  .W !,"from status '"_$G(CLAIM($J,.02))_"' to '"_$S(NEWSTAT="M":"MATCHED",NEWSTAT="E":"EXCEPTION",NEWSTAT="U":"CLAIM UNMATCHED",1:"EXCEPTION")_"' <N>? :"
  1.  .K DIR
  1.  .S DIR(0)="Y"
  1.  .D ^DIR
  1.  .K DIR
  1.  I $G(CLAIM($J,.02))="CLAIM UNMATCHED" D
  1.  .K DIR
  1.  .S DIR(0)="SA^M:MATCHED;E:EXCEPTION"
  1.  .S DIR("A")="from status '"_$G(CLAIM($J,.02))_"' to 'MATCHED' or 'EXCEPTION' <M/E>? "
  1.  .D ^DIR
  1.  .K DIR
  1.  .Q:Y=""
  1.  .Q:$D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)
  1.  .S NEWSTAT=Y
  1.  .K DIR
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Are you sure?"
  1.  .S DIR("B")="N"
  1.  .D ^DIR
  1.  .K DIR
  1.  Q:Y'>0
  1.  S DIE=$$DIC^XBDIQ1(90056.0205)
  1.  S DA(1)=IMPDA
  1.  S DA=XCLM
  1.  S DR=".02///^S X=NEWSTAT"
  1.  D ^DIE
  1.  I NEWSTAT="M" D
  1.  .D ^BARBLLK
  1.  .;start new bar*1.8*20
  1.  .I BARBLDA=0 D  Q
  1.  ..S NEWSTAT=$G(CLAIM($J,.02))
  1.  ..S DIE=$$DIC^XBDIQ1(90056.0205)
  1.  ..S DA(1)=IMPDA
  1.  ..S DA=XCLM
  1.  ..S DR=".02///^S X=NEWSTAT"
  1.  ..D ^DIE
  1.  ..;end new
  1.  .S DIE=$$DIC^XBDIQ1(90056.0205)
  1.  .S DA(1)=IMPDA
  1.  .S DA=XCLM
  1.  .S DR="1.01////^S X=BARBLDA"
  1.  .D ^DIE
  1.  .D DELREAS^BAREDP04(IMPDA,XCLM) ; REMOVE OVER-RIDES UPON MATCHING IHS/DIT/CPC BAR*1.8*28
  1.  .D REPROCES(IMPDA)  ;RE-PROCESS ERA FILE
  1.  Q:(NEWSTAT=$G(CLAIM($J,.02)))  ;no match was entered/found  bar*1.8*20 
  1.  S DIE=$$DIC^XBDIQ1(90056.0205)
  1.  S DA(1)=IMPDA
  1.  S DA=XCLM
  1.  S DR="W !;71//"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. REPROCES(IMPDA) ;EP - RE-PROCESS ERA FILE
  1. AUTOREV ;EP - AUTO REVIEW ;BAR*1.8*6 SCR120 ADD LIST MANAGER PROMPT FOR AUTO-REVIEW
  1.  N CLMDA
  1.  D CLEAR^VALM1
  1.  S CLMDA=0
  1.  K ^XTMP("BAR-LIST",$J,DUZ(2))
  1.  F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA  S ^XTMP("BAR-LIST",$J,DUZ(2),$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U),CLMDA)=""
  1.  S CLMCNT=0,BARBL=""
  1.  F  S BARBL=$O(^XTMP("BAR-LIST",$J,DUZ(2),BARBL)) Q:BARBL=""  D
  1.  .S CLMDA=0
  1.  .F  S CLMDA=$O(^XTMP("BAR-LIST",$J,DUZ(2),BARBL,CLMDA)) Q:'CLMDA  K ERRS D CLMFLG^BAREDP04(CLMDA,.ERRORS)
  1.  S BARFLG=$$EN^BAREDP0Z(IMPDA)  ;PLB/Pymt Rev/Neg pymt amt chks  ;bar*1.8*20 REQ4
  1.  ;;;old code D:$$IHS^BARUFUT(DUZ(2)) NEGBAL^BAREDEB(IMPDA,"ERA")  ;CHECK FOR NEGATIVE BALANCE IN RPMS BILLS
  1.  D NEGBAL^BAR50EB(IMPDA,"ERA")  ;note: IHS/TRIBAL CHK INSIDE BAR50EB CHK FOR NEG BAL IN RPMS BILLS HEAT147572 MOD: 2/5/2014 
  1.  ;;old code D:$$IHS^BARUFUT(DUZ(2)) NONPAYCH^BAR50EP1(IMPDA)  ;CHECK FOR PAYMENTS NOT MATCHED TO A REVERSAL TO SEE IF THEY ARE BEING POSTED TO A 'NONPAYMENT' BATCH ;BAR*1.8*6 SAC RTN TOO BIG
  1.  D:$$IHSNEGB^BARUFUT(DUZ(2)) NONPAYCH^BAR50EP1(IMPDA)  ;CHECK FOR PAYMENTS NOT MATCHED TO A REVERSAL TO SEE IF THEY ARE BEING POSTED TO A 'NONPAYMENT' BATCH ;HEAT147572
  1.  D GATHER(IMPDA)
  1.  Q
  1.  ;start new code bar*1.8*20 REQ5
  1. VIEW ;EP
  1.  S VALMLST=""
  1.  S VALMLST=$O(^TMP($J,"LVL1","IDX",VALMLST),-1)
  1.  D EN^VALM2(XQORNOD(0),"O")
  1.  I '$D(VALMY) Q
  1.  D CLEAR^VALM1
  1.  N XCLMDA
  1.  S XCLMDA=0
  1.  F  S XCLMDA=$O(VALMY(XCLMDA)) Q:XCLMDA=""  D
  1.  .S XCLM=$G(^TMP($J,"E",XCLMDA,"CLMDA"))
  1.  .S IENS=XCLM_","_IMPDA_","
  1.  .W !,$$GET1^DIQ(90056.0205,IENS,71)
  1.  .D PAZ^BARRUTL
  1.  Q
  1.  ;end new code REQ5