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