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

BAR50P4A.m

Go to the documentation of this file. 
  1. BAR50P4A ; IHS/SD/SDR - MATCH REASONS AND CLAIMS - 2 ; 01/09/2009
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**20,21,23,24,26**;OCT 26, 2005;Build 17
  1.  ;CLM/CLM2 split BARFROM BAREDP04 due to size
  1.  ;IHS/SD/POT - 1.8*23 HEAT82698  NOV 2012,JAN 2013 LEADING/MISSING ZEROES IN BILL #
  1.  ;IHS/SD/POT - 1.8*23 BETA TEST SEP 2013 YAK: SWAPPED CHK001 AND CHK002 (FIXED POS CLAIMS)
  1.  ;IHS/SD/POT - 1.8*23 12/2/2012 RECORD ONLY UNMATCHED ITEMS (deactivated ->p24)
  1.  ;IHS/SD/POT - 1.8*24 - 2/12/2014 MATCHING MANUAL BILLS (NO ALPHA)
  1.  ;IHS/SD/SDR - 1.8*26 - Updated p23, p24 documentation
  1.  ;IHS/SD/SDR - 1.8*26 - HEAT166023 - Made change to treat a negative bill amount as a positive number and use it to
  1.  ;  try matching the bill amount to the RPMS bill amount.
  1.  ;
  1. PAYER ;EP
  1.  S IENS=BARCKIEN_","_IMPDA_","
  1.  S EPAYER=$$GET1^DIQ(90056.02011,IENS,".06")
  1.  D ^XBFMK
  1.  S DIC=$$DIC^XBDIQ1(90056.24)
  1.  S DIC(0)="SMQ"
  1.  S X=EPAYER
  1.  D ^DIC
  1.  Q:+Y<0  ;stop here if no match in A/R EDI BILL LOGIC file
  1.  W !!,"A matching ""override"" has been set up for this A/R Account",!
  1.  S BARIEN=+Y
  1.  D DISPLAY^BAR50MCH
  1.  D ^XBFMK
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you wish to continue with the A/R Bill Matching using this criteria?"
  1.  S DIR("B")="N"
  1.  D ^DIR
  1.  I Y=0 S QFLG=1 Q
  1.  Q
  1.  ;start old bar*1.8*23 IHS/SD/POT
  1.  ;CLM ;EP
  1.  ;S BARX="B"
  1.  ;K BILMATCH S BILMATCH=0  ;bar*1.8*20
  1.  ;I $$GET1^DIQ(90056.0205,IENS,1.01)'="" D  Q
  1.  ;.S BARBIEN=$$GET1^DIQ(90056.0205,IENS,1.01,"I")
  1.  ;.D CLM3
  1.  ;.;S (BARCNT,BILMATCH)=1,BILMATCH(BARBIEN)="",BARTMP(BARBIEN)="" I $G(DEBUG) W "  MATCHED"  ;bar*1.8*20
  1.  ;;I '$D(^BARBL(DUZ(2),"B",BARBILL)) S BARX="G"  ;Pharmacy POS  ;bar*1.8*20 REQ4
  1.  ;I $O(^BARBL(DUZ(2),"B",$S(($L(+BARBILL)=$L(BARBILL)):BARBILL_"-",1:BARBILL)))'[BARBILL S BARX="G"  ;Pharmacy POS  ;bar*1.8*20 REQ4
  1.  ;;K BILMATCH S BILMATCH=0  ;bar*1.8*20
  1.  ;S (BARBIEN,BARCNT)=0
  1.  ;;start new code bar*1.8*20 REQ4
  1.  ;I BARX="G" D CLM2 Q
  1.  ;S BARSAVE=BARBILL
  1.  ;F  S BARBILL=$O(^BARBL(DUZ(2),"B",$S(($L(+BARBILL)=$L(BARBILL)):BARBILL_"-",1:BARBILL))) Q:(BARBILL'[BARSAVE)  D CLM2
  1.  ;S BARBILL=BARSAVE
  1.  ;;
  1.  ;Q
  1.  ;;end new code REQ4
  1.  ;CLM2 ;
  1.  ;F  S BARBIEN=$O(^BARBL(DUZ(2),BARX,BARBILL,BARBIEN)) Q:'+BARBIEN  D
  1.  ;.D CLM3
  1.  ;.I (ERABILL'=BARAMT)!(ERADOS'=BARDOS) Q
  1.  ;.S BARCNT=BARCNT+1
  1.  ;.S BARTMP(BARBIEN)=""
  1.  ;Q
  1.  ;CLM3 ;
  1.  ;S ERABILL=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,5)  ;E-BILLED
  1.  ;S ERADOS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,8)  ;E-DOS BEGIN
  1.  ;S BARDOS=$$GET1^DIQ(90050.01,BARBIEN,102,"I")  ;DOS BEGIN
  1.  ;S ERATYPE=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)  ;E-CLM STATUS CD
  1.  ;;S X=ERADOS D ^%DT S ERADOS=Y  ;bar*1.8*21 SDR
  1.  ;S BARDOS=$$Y2KD2^BARDUTL(BARDOS)  ;bar*1.8*21 SDR
  1.  ;S BARAMT=$$GET1^DIQ(90050.01,BARBIEN,13,"I")  ;AMT BILLED
  1.  ;I $G(DEBUG) W !,"ERA BILL : ",BARBILL  ;bar*1.8*20 REQ4
  1.  ;I $G(DEBUG) W !,"ERA BILL : ",$$GET1^DIQ(90056.0205,BAREIENS,.01)  ;bar*1.8*20 REQ4
  1.  ;I $G(DEBUG) W ?35,"ERA BILL TYPE: ",ERATYPE
  1.  ;I $G(DEBUG) W !,"ERA BILLED: ",ERABILL,?25,"ERA DOS: ",ERADOS
  1.  ;I $G(DEBUG) W !,"A/R BILLED: ",BARAMT,?25,"A/R DOS: ",BARDOS
  1.  ;I ERABILL<0 S ERABILL=-ERABILL I $G(DEBUG) W ?50,"ERA BILL IS A NEGATIVE AMOUNT"
  1.  ;I (ERABILL=BARAMT),(ERADOS=BARDOS) S BILMATCH=BILMATCH+1,BILMATCH(BARBIEN)="" I $G(DEBUG) W "  MATCHED"
  1.  ;Q
  1.  ;end old start new bar*1.8*23 IHS/SD/POT
  1. CLM(BAREIENS,BARBILL,BARX,BARMMFLG) ;EP
  1.  NEW BARMMTOT,BARMCNT,BARMMTYP ;P.OTT
  1.  S BARMMVAL="" ;RETURN VALUE OF MATCHED ITEM
  1.  S BARCNT=0
  1.  K BILMATCH S BILMATCH=0
  1.  ;
  1.  S BARMMFLG=0 ;NEGATIVE IF MATCH, 0 IF NO MATCH 1 FOR BILLED AMOUNT MATCH, 2 FOR DOS MATCH
  1.  S BARMMTOT=0 ;COUNT OF MISMATCHES
  1.  F I=0:1:3 S BARMMCNT(I)=0
  1.  S BARFND=0
  1.  I $$GET1^DIQ(90056.0205,IENS,1.01)'="" D  Q
  1.  .S BARBIEN=$$GET1^DIQ(90056.0205,IENS,1.01,"I")
  1.  .S BARFND=10
  1.  .S BARX="B"
  1.  .I $D(^BARBL(DUZ(2),"G",BARBILL))!$D(^BARBL(DUZ(2),"G",+BARBILL)) S BARX="G"
  1.  .S BARTMP=$$FINDING(BARBILL) I +BARTMP S BARX="G",(BARBILL)=$P(BARTMP,"^",2)
  1.  .I $$CLM3(1,BARBIEN,IMPDA,CLMDA,.BARMMTYP) ;JUST DISPLAY (1ST PARAM=1)
  1.  .Q
  1.  S BARX="G"
  1.  I $D(^BARBL(DUZ(2),BARX,BARTEST)) D  Q  ;CHK001
  1.  .S BARFND=1050
  1.  .D CLM2(BARX,BARTEST,.BARMMFLG)
  1.  .Q
  1.  ;
  1.  S BARX="G"  ;6/10/13
  1.  I $D(^BARBL(DUZ(2),BARX,+BARTEST)) D  Q  ;CHK002
  1.  .S BARFND=1051
  1.  .D CLM2(BARX,+BARTEST,.BARMMFLG)
  1.  .Q
  1.  ;-------------------------------------------------2/27/2013>
  1.  S BARX="B"
  1.  I $D(^BARBL(DUZ(2),BARX,BARTEST)) D  Q
  1.  .S BARFND=1052
  1.  .D CLM2(BARX,BARTEST,.BARMMFLG)
  1.  .Q
  1.  ;-------------------------------------------------2/27/2013<
  1.  ;TRY TO MATCH MANUAL BILL (form: nnnnn-IHS-WHATEVER) 2/13/2014
  1.  ;
  1.  S BARX="G"
  1.  ;
  1.  ;S BARSAVE=+BARBILL,BARBILL=+BARBILL_"@"  ;bar*1.8*24 IHS/SD/POT
  1.  S BARSAVE=+BARBILL  ;bar*1.8*24 IHS/SD/POT
  1.  S BARBILL=+BARBILL_"-"  ;bar*1.8*24 IHS/SD/POT
  1.  F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D
  1.  .S BARFND=104
  1.  .D CLM2(BARX,BARBILL,.BARMMFLG)
  1.  I BARFND Q  ;Found in POS
  1.  S BARBILL=BARSAVE
  1.  ;
  1.  S BARX="B"
  1.  ; 
  1.  S BARSAVE=+BARBILL
  1.  S BARBILL=+BARBILL_"-" ;2/12/2014
  1.  F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D
  1.  .S BARFND=105
  1.  .D CLM2(BARX,BARBILL,.BARMMFLG)
  1.  I BARFND Q  ;found in A/R
  1.  S BARBILL=BARSAVE
  1.  ;---------------------------------------------------------------------------------- END 2/13/2014
  1.  S BARX="G"
  1.  ;
  1.  ;S BARSAVE=+BARBILL,BARBILL=+BARBILL_"@"  ;bar*1.8*24 IHS/SD/POT
  1.  S BARSAVE=+BARBILL  ;bar*1.8*24 IHS/SD/POT
  1.  S BARBILL=+BARBILL_"-"  ;bar*1.8*24 IHS/SD/POT
  1.  ;start new bar*1.8*24 IHS/SD/POT
  1.  F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D
  1.  .S BARFND=104
  1.  .D CLM2(BARX,BARBILL,.BARMMFLG)
  1.  I BARFND Q  ;If found in POS do not search in A/R -->
  1.  ;
  1.  S BARBILL=BARSAVE
  1.  ;
  1.  S BARX="B"
  1.  ; 
  1.  S BARSAVE=+BARBILL,BARBILL=+BARBILL_"@"
  1.  F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D
  1.  .S BARFND=105
  1.  .D CLM2(BARX,BARBILL,.BARMMFLG)
  1.  I BARFND Q  ;If found in POS do not search in A/R -->
  1.  ;
  1.  S BARBILL=BARSAVE
  1.  ;end new bar*1.8*24 IHS/SD/POT
  1.  ;
  1.  ;CHK POS (OPTION WITH MISSING LEADING ZEROES) -------------------------
  1.  ;
  1.  S BARTMP=$$FINDING(BARBILL)
  1.  I +BARTMP S BARX="G",(BARBILL)=$P(BARTMP,"^",2) D
  1.  .S BARX="G",BARFND=100
  1.  .D CLM2("G",BARBILL,.BARMMFLG)
  1.  .Q
  1.  I BARFND Q  ;if found in POS do not search in A/R -->
  1.  ;
  1.  ;CHK POS (OPTION WITH LEADING ZEROES)
  1.  ;
  1.  I $D(^BARBL(DUZ(2),"G",BARBILL)) D
  1.  .S BARX="G",BARFND=1
  1.  .D CLM2("G",BARBILL,.BARMMFLG)
  1.  .Q
  1.  I BARFND Q  ;If found in POS do not search in A/R -->
  1.  ;
  1.  ;CHK POS (OPTION WITH NO LEADING ZEROES)
  1.  ;
  1.  I +BARBILL'=BARBILL I $D(^BARBL(DUZ(2),"G",+BARBILL)) D
  1.  .S BARX="G",BARFND=2
  1.  .D CLM2("G",+BARBILL,.BARMMFLG) ;CHK POS
  1.  I BARFND Q  ;If found in POS do not search in A/R -->
  1.  ;
  1.  S BARX="B" ;
  1.  ;CHK POS (OPTION WITH LEADING ZEROES) -------------------------
  1.  I $D(^BARBL(DUZ(2),BARX,BARBILL)) D
  1.  .S BARFND=3
  1.  .D CLM2(BARX,BARBILL,.BARMMFLG)
  1.  .Q
  1.  I BARFND Q  ;If found in POS do not search in A/R -->
  1.  ; 
  1.  S BARSAVE=+BARBILL,BARBILL=+BARBILL_"@"
  1.  ;
  1.  F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D
  1.  .S BARFND=4
  1.  .D CLM2(BARX,BARBILL,.BARMMFLG)
  1.  I BARFND Q  ;If found in POS do not search in A/R -->
  1.  ;
  1.  S BARBILL=BARSAVE
  1.  ;
  1.  ;CHK POS (OPTION WITH NO LEADING ZEROES) -------------------------
  1.  ;
  1.  I +BARBILL'=BARBILL I $D(^BARBL(DUZ(2),BARX,+BARBILL)) D  ;
  1.  .S BARFND=5
  1.  .D CLM2(BARX,+BARBILL,.BARMMFLG)
  1.  I BARFND Q  ;If found in POS do not search in A/R -->
  1.  ; 
  1.  ; 
  1.  S BARSAVE=+BARBILL,BARBILL=+BARBILL_"@"
  1.  ;
  1.  F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D
  1.  .S BARFND=6
  1.  .D CLM2(BARX,BARBILL,.BARMMFLG)
  1.  S BARBILL=BARSAVE
  1.  Q
  1.  ;
  1.  ;
  1. CLM2(BARX,BARBILL,BARMMFLG) ;
  1.  S BARMMFLG=0
  1.  S BARBIEN=0 F  S BARBIEN=$O(^BARBL(DUZ(2),BARX,BARBILL,BARBIEN)) Q:'+BARBIEN  D
  1.  .I $$CLM3(2,BARBIEN,IMPDA,CLMDA,.BARMMTYP) D  Q  ;BLOCK FOR MATCHED
  1.  ..S BARCNT=BARCNT+1
  1.  ..S BARTMP(BARBIEN)="" ;ARRAY OF MATCHED BILLS
  1.  ..S BARMMFLG=-1
  1.  ..Q  ;
  1.  .;COUNTING TYPES OF UNMATCHED
  1.  .S BARMMTOT=BARMMTOT+1 ;COUNT OF MISMATCHES (MM)
  1.  .S BARMMCNT(BARMMTYP)=BARMMCNT(BARMMTYP)+1 ;COUNT TYPES OF MM
  1.  .QUIT
  1.  I $G(BARDBG) I BARMMCNT(1)+BARMMCNT(2)=1 D  ;ONE OR THE OTHER; NOT BOTH!
  1.  .I BARMMCNT(1) S BARMMFLG=1
  1.  .I BARMMCNT(2) S BARMMFLG=2
  1.  .Q
  1.  Q
  1. CLM3(BARFROM,BARBIEN,IMPDA,CLMDA,BARMMTYP) ;
  1.  NEW ERABILL,ERADOS,BARDOS,BARAMT,ERATYPE
  1.  S ERABILL=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,5)  ;E-BILLED
  1.  S ERADOS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,8)  ;E-DOS BEGIN
  1.  S BARDOS=$$GET1^DIQ(90050.01,BARBIEN,102,"I")  ;DOS BEGIN
  1.  S ERATYPE=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)  ;E-CLM STATUS CD
  1.  S BARDOS=$$Y2KD2^BARDUTL(BARDOS)  ;
  1.  S BARAMT=$$GET1^DIQ(90050.01,BARBIEN,13,"I")  ;AMT BILLED
  1.  S BARMMTYP=0 ;MATCH
  1.  ;
  1.  ;I ERABILL<0 S ERABILL=-ERABILL D  Q 0  ;bar*1.8*26 IHS/SD/SDR HEAT166023
  1.  I ERABILL<0 S ERABILL=-ERABILL D  ;bar*1.8*26 IHS/SD/SDR HEAT166023
  1.  .D BLHDR ;P.OTT 12/2/2013
  1.  .I $G(BARDBG) D INS^BAR50DET($C(9,9)_"ERA BILL IS A NEGATIVE AMOUNT",1)
  1.  ;
  1.  I (+ERABILL=+BARAMT),(ERADOS=BARDOS) D  Q 1 ;P.OTT 12/2/2013
  1.  .D BLHDR ;P.OTT 12/2/2013
  1.  .S BILMATCH=BILMATCH+1,BILMATCH(BARBIEN)=""
  1.  .Q  ;OK
  1.  ; ---- NOT MATCHED - OTHER REASON FALL THRU
  1.  I BARFROM=1 QUIT 0
  1.  ;BARMMTYP=0 - MATCH
  1.  ;BARMMTYP=1 ONLY AMOUNT NOT MATCHED
  1.  ;BARMMTYP=2 ONLY DOS NOT MATCHED
  1.  ;BARMMTYP=3 AMOUNT & DOS NOT MATCHED
  1.  ;
  1.  D BLHDR ;P.OTT 12/2/2013
  1.  I (+ERABILL'=+BARAMT),(ERADOS'=BARDOS) S BARMMTYP=3 D  Q 0
  1.  .I $G(BARDBG) D INS^BAR50DET(" NOT MATCHED",1) Q  ;
  1.  I (+ERABILL'=+BARAMT),(ERADOS=BARDOS) S BARMMTYP=1 D  Q 0
  1.  .I $G(BARDBG) D INS^BAR50DET(" PARTIAL MATCH: DOS OK. AMT DIFF: "_$J(ERABILL-BARAMT,5,2)_"$",1) S BARMMVAL=BARDOS
  1.  I (ERADOS'=BARDOS),(+ERABILL=+BARAMT) S BARMMTYP=2 D  Q 0
  1.  .I $G(BARDBG) D INS^BAR50DET(" PARTIAL MATCH: AMOUNT OK",1) S BARMMVAL=BARAMT
  1.  ; ---- NOT MATCHED - OTHER REASON FALL THRU 
  1.  Q 0
  1. BLHDR ;
  1.  I $G(BARDBG) D  ;P.OTT 12/2/2013
  1.  .D NOMATCH^BAR50DET
  1.  .D INS^BAR50DET("ERA BILL : "_$$GET1^DIQ(90056.0205,BAREIENS,.01),0)
  1.  .D INS^BAR50DET($C(9,9)_"ERA BILL TYPE: "_ERATYPE,1)
  1.  .D INS^BAR50DET("ERA BILLED: "_ERABILL_$C(9,9)_"ERA DOS: "_ERADOS,0)
  1.  .D INS^BAR50DET("A/R BILLED: "_BARAMT_$C(9,9)_"A/R DOS: "_BARDOS,0)
  1.  .D INS^BAR50DET("BAR BILL : "_BARBILL,0)
  1.  Q
  1.  ;end new bar*1.8*23 IHS/SD/POT
  1. TRANSCK ;EP
  1.  Q:$G(BARBIEN)=""  ;no bill number matched
  1.  S BARTFLG=0
  1.  S BARBTCH=$$GET1^DIQ(90056.02011,BARCKIEN,.07)
  1.  S BARITEM=$$GET1^DIQ(90056.02011,BARCKIEN,.08)
  1.  S BARTR=0,BARTFLG=0
  1.  F  S BARTR=$O(^BARTR(DUZ(2),"AC",BARBIEN,BARTR)) Q:'BARTR  D  Q:(BARTFLG=1)
  1.  .S BARTBTCH=$$GET1^DIQ(90050.03,BARTR,14)
  1.  .S BARTITEM=$$GET1^DIQ(90050.03,BARTR,15)
  1.  .I BARTBTCH'="",BARITEM'="",BARBTCH=BARTBTCH,BARITEM=BARTITEM S BARTFLG=1
  1.  I BARTFLG S ERRORS("HTRN")=""
  1.  Q
  1.  ;start new bar*1.8*23 IHS/SD/POT
  1. FINDING(BARBILL) ;RETURNS 1^BARXBILL (WITH MISSED OR ADDED LEADING ZERORS); OR 0
  1.  N BARXBILL,BARRET,IXX ;REWRITE JAN 2013
  1.  I $E(BARBILL)'="0" D  Q BARRET
  1.  .S BARRET=0
  1.  .S BARXBILL=BARBILL
  1.  .F IXX=1:1 Q:($L(BARXBILL)=20)  D  Q:BARRET
  1.  ..S BARXBILL="0"_BARXBILL
  1.  ..I $D(^BARBL(DUZ(2),"G",BARXBILL)) S BARRET="1^"_BARXBILL
  1.  ..Q
  1.  .Q
  1.  I $E(BARBILL)="0" D  Q BARRET
  1.  .S BARRET=0
  1.  .S BARXBILL=BARBILL
  1.  .F IXX=1:1 Q:$E(BARXBILL,1)'="0"  D  Q:BARRET
  1.  ..S BARXBILL=$E(BARXBILL,2,999) I BARXBILL=""  Q
  1.  ..I $D(^BARBL(DUZ(2),"G",BARXBILL)) S BARRET="1^"_BARXBILL
  1.  ..Q
  1.  .Q
  1.  I BARBILL=+BARBILL D  Q BARRET
  1.  .S BARXBILL=+BARBILL
  1.  .I $D(^BARBL(DUZ(2),"G",BARXBILL)) S BARRET="1^"_BARXBILL
  1.  .Q
  1.  Q ""  ;NEVER FALLS THROUGH
  1.  ;end new bar*1.8*23 IHS/SD/POT