BARRERL ; IHS/SD/LSL - Bill File Error Checker ; 07/2/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;*23*;OCT 26, 2005
;
; IHS/ASDS/LSL - 09/11/01 - Version 1.5 Patch 2 - NOIS CGA-0701-110093
; Modified to set 0 node of A/R Bill Error File if it doesn't
; already exist. This allows the BES to work for all facilities on
; one machine.
;
; IHS/SD/LSL - 12/06/02 - Version 1.7 - NOIS NHA-0601-180049
; Modified to look for 3P bill properly.
;
; JUNE 2013 P.OTT MODIFIED TO ACCOMODATE NEW INSURER TYPE FILE (^AUTTINTY)
;
; ***********************************************************************
;
W !!,"This option will scan the A/R Bill file for problems and must be"
W !,"run before printing any of the synchronization reports",!
I $G(^BARBLER(DUZ(2),"LASTRUN")) D Q:Y'=1
.W !,"A/R Bill File error check was last run on "
.W $$MDT^BARDUTL(^BARBLER(DUZ(2),"LASTRUN")),".",!
.K DIR
.S DIR(0)="Y"
.S DIR("A")="Re-run"
.S DIR("B")="NO"
.D ^DIR
.K DIR
I '$P($G(^BAR(90052.06,DUZ(2),DUZ(2),0)),"^",14) D
.W !!,"Enter Small Balance Amount."
.S DIE="^BAR(90052.06,DUZ(2),"
.S DA=DUZ(2)
.S DR="14//5.00"
.D ^DIE
; -------------------------------
;
ADT ;ask for date range
W !!,"Select A/R Bills by DOS Date Range."
F D Q:$G(BARDTOK)
.K BARSDT,BAREDT,BARDTOK
.S BARSDT=$$DATE^BARDUTL(1)
.I BARSDT'>0 S BARDTOK=-1 Q
.S BAREDT=$$DATE^BARDUTL(2)+.9
.I BAREDT'>0 S BARDTOK=-1 Q
.I BAREDT>BARSDT S BARDTOK=1 Q
.W " ??",*7
I BARDTOK'>0 K BARSDT,BAREDT,BARDTOK Q
; -------------------------------
;
QUE ;que to taskman
S ZTRTN="EN^BARRERL"
S ZTSAVE("BARSDT")=""
S ZTSAVE("BAREDT")=""
S ZTDESC="A/R Re-Roll"
S ZTIO=""
D ^%ZTLOAD
W:$G(ZTSK) !,"Task# ",ZTSK," queued.",!
D EOP^BARUTL(1)
K BAREDT,BARSDT,BARDTOK
Q
; *********************************************************************
;
EN ;EP - looking for A/R Bills that have problems
D KILL
D LOOP
S ^BARBLER(DUZ(2),"LASTRUN")=DT
K ^BARBLER(DUZ(2),"RUNNING")
K BARSDT,BAREDT,BARIDT
Q
; *********************************************************************
;
KILL ;delete existing entries
S DIK="^BARBLER(DUZ(2),"
S DA=0
F S DA=$O(^BARBLER(DUZ(2),DA)) Q:'DA D ^DIK
K ^BARBLER(DUZ(2),"LASTRUN")
I '$D(^BARBLER(DUZ(2),0)) S ^BARBLER(DUZ(2),0)="A/R BILL ERROR^90050.04P"
S ^BARBLER(DUZ(2),"RUNNING")=1
Q
; *********************************************************************
;
LOOP ; go thru A/R Bill file
S BARIDT=BARSDT-.1
F S BARIDT=$O(^BARBL(DUZ(2),"E",BARIDT)) Q:'BARIDT!(BARIDT>BAREDT) D
.S BARBLDA=0
.F S BARBLDA=$O(^BARBL(DUZ(2),"E",BARIDT,BARBLDA)) Q:'BARBLDA D ONE
Q
; *********************************************************************
;
ONE ;examine one a/r bill for errors
K BARNO3P
S DIE="^BARBLER(DUZ(2),"
N I
F I=0,1,2 S BAR(I)=$G(^BARBL(DUZ(2),BARBLDA,I))
S BAR3PNM=$P(BAR(0),"^",1)
S BAR3PNM=$P(BAR3PNM,"-")
S BARBAL=$P(BAR(0),"^",15)
D SBL
D NEG
S BARDOS=$P(BAR(1),U,2)
S BARPAT=$P(BAR(1),U)
S BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),BARBLDA)
I BAR("3P LOC")="" D Q
. S DA=BARBLDA
. S DR=".05///1"
. D ^DIE
S BAR3PDUZ=$P(BAR("3P LOC"),",")
S BAR3PDA=$P(BAR("3P LOC"),",",2)
S BARDUZ2=BAR3PDUZ
S DA=BARBLDA
S DIC="^BARBL(DUZ(2),"
S DIQ="BAR("
S DIQ(0)="IE"
S DR="3;101"
D EN^DIQ1
D MM
D RR
K BAR,BAR3P,BARDUZ2,BAR3PNM,BAR3PNMB,BARMM,BARNO3P,BAR3PDA
Q
; *********************************************************************
;
FIXIEN ;attempt to find missing 3p bill
Q
; *********************************************************************
;
MM ;check for 3p/ar mis-matches
N I
F I=0,2,7 S BAR3P(I)=$G(^ABMDBILL(BARDUZ2,BAR3PDA,I))
S BAR3PNMB=$P(BAR3P(0),"^",1)
K BARMM
S:BAR3PNM'=BAR3PNMB BARMM=1 ;bill names
S:$P(BAR3P(0),"^",5)'=$P(BAR(1),"^",1) BARMM=1 ;patient
S:(($P(BAR3P(2),"^",1)+.005)\.01/100)'=(($P(BAR(0),"^",13)+.005)\.01/100) BARMM=1 ;amt billed
S:$P(BAR3P(7),"^",1)'=$P(BAR(1),"^",2) BARMM=1 ;dos from
;insurer
;;;S BARITYP=$P($G(^AUTNINS(+$P(BAR3P(0),"^",8),2)),"^",1)
S BARINAME=$P($G(^AUTNINS(+$P(BAR3P(0),U,8),0)),"^",1)
S BARITYPX=$P($G(^AUTNINS(+$P(BAR3P(0),U,8),3)),"^",1) ;PTR TO ^AUTTINTY (.211)
S BARITYP=$P($G(^AUTTINTY(BARITYPX,0)),U,2) ;P.OTT
;I DUZ=838 W !,"BARITYP= ",BARITYP," ",$ZR R ASD QUIT ;------------------>
I BARITYP'="N" D
.Q:BARINAME=$G(BAR(90050.01,BARBLDA,3,"E"))
.S BARMM=1
I BARITYP="N" D
.Q:$P(^BARAC(DUZ(2),BAR(90050.01,BARBLDA,3,"I"),0),U)'["DPT("
.Q:BAR(90050.01,BARBLDA,3,"E")=BAR(90050.01,BARBLDA,101,"E")
.S BARMM=1
Q:'$G(BARMM)
D ADD
S DR=".04///1"
D ^DIE
Q
; *********************************************************************
;
SBL ;check for small balance
Q:BARBAL'>0
S BARSBL=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),0)),"^",14)
S:'BARSBL BARSBL=5
Q:BARBAL>BARSBL
D ADD
S DR=".03///1"
D ^DIE
Q
; *********************************************************************
;
NEG ;check for negative balance
Q:BARBAL'<0
D ADD
S DR=".02///1"
D ^DIE
Q
; *********************************************************************
;
RR ;check if re-roll is needed
Q:BARBAL'=0
Q:$P(BAR3P(0),"^",4)="C"
Q:$P(BAR3P(0),"^",4)="X"
Q:$P(BAR(2),"^",8)'="R"
Q:'+$P(BAR(0),"^",13)
Q:$G(BARMM)
D ADD
S DR=".06///1"
D ^DIE
Q
; *********************************************************************
;
ADD ;add to a/r bill error file
S DA=BARBLDA
Q:+$G(^BARBLER(DUZ(2),DA,0))
S DIC="^BARBLER(DUZ(2),"
S DIC(0)="LX"
S X="`"_DA
K DD,DO
D ^DIC
Q
; *********************************************************************
;
DEV ;select device
S %ZIS="NQ"
D ^%ZIS
Q:POP
I IO'=IO(0) D QUE,HOME^%ZIS Q
I $D(IO("S")) D
.S IOP=ION
.D ^%ZIS
Q
BARRERL ; IHS/SD/LSL - Bill File Error Checker ; 07/2/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;*23*;OCT 26, 2005
+2 ;
+3 ; IHS/ASDS/LSL - 09/11/01 - Version 1.5 Patch 2 - NOIS CGA-0701-110093
+4 ; Modified to set 0 node of A/R Bill Error File if it doesn't
+5 ; already exist. This allows the BES to work for all facilities on
+6 ; one machine.
+7 ;
+8 ; IHS/SD/LSL - 12/06/02 - Version 1.7 - NOIS NHA-0601-180049
+9 ; Modified to look for 3P bill properly.
+10 ;
+11 ; JUNE 2013 P.OTT MODIFIED TO ACCOMODATE NEW INSURER TYPE FILE (^AUTTINTY)
+12 ;
+13 ; ***********************************************************************
+14 ;
+15 WRITE !!,"This option will scan the A/R Bill file for problems and must be"
+16 WRITE !,"run before printing any of the synchronization reports",!
+17 IF $GET(^BARBLER(DUZ(2),"LASTRUN"))
Begin DoDot:1
+18 WRITE !,"A/R Bill File error check was last run on "
+19 WRITE $$MDT^BARDUTL(^BARBLER(DUZ(2),"LASTRUN")),".",!
+20 KILL DIR
+21 SET DIR(0)="Y"
+22 SET DIR("A")="Re-run"
+23 SET DIR("B")="NO"
+24 DO ^DIR
+25 KILL DIR
End DoDot:1
IF Y'=1
QUIT
+26 IF '$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),0)),"^",14)
Begin DoDot:1
+27 WRITE !!,"Enter Small Balance Amount."
+28 SET DIE="^BAR(90052.06,DUZ(2),"
+29 SET DA=DUZ(2)
+30 SET DR="14//5.00"
+31 DO ^DIE
End DoDot:1
+32 ; -------------------------------
+33 ;
ADT ;ask for date range
+1 WRITE !!,"Select A/R Bills by DOS Date Range."
+2 FOR
Begin DoDot:1
+3 KILL BARSDT,BAREDT,BARDTOK
+4 SET BARSDT=$$DATE^BARDUTL(1)
+5 IF BARSDT'>0
SET BARDTOK=-1
QUIT
+6 SET BAREDT=$$DATE^BARDUTL(2)+.9
+7 IF BAREDT'>0
SET BARDTOK=-1
QUIT
+8 IF BAREDT>BARSDT
SET BARDTOK=1
QUIT
+9 WRITE " ??",*7
End DoDot:1
IF $GET(BARDTOK)
QUIT
+10 IF BARDTOK'>0
KILL BARSDT,BAREDT,BARDTOK
QUIT
+11 ; -------------------------------
+12 ;
QUE ;que to taskman
+1 SET ZTRTN="EN^BARRERL"
+2 SET ZTSAVE("BARSDT")=""
+3 SET ZTSAVE("BAREDT")=""
+4 SET ZTDESC="A/R Re-Roll"
+5 SET ZTIO=""
+6 DO ^%ZTLOAD
+7 IF $GET(ZTSK)
WRITE !,"Task# ",ZTSK," queued.",!
+8 DO EOP^BARUTL(1)
+9 KILL BAREDT,BARSDT,BARDTOK
+10 QUIT
+11 ; *********************************************************************
+12 ;
EN ;EP - looking for A/R Bills that have problems
+1 DO KILL
+2 DO LOOP
+3 SET ^BARBLER(DUZ(2),"LASTRUN")=DT
+4 KILL ^BARBLER(DUZ(2),"RUNNING")
+5 KILL BARSDT,BAREDT,BARIDT
+6 QUIT
+7 ; *********************************************************************
+8 ;
KILL ;delete existing entries
+1 SET DIK="^BARBLER(DUZ(2),"
+2 SET DA=0
+3 FOR
SET DA=$ORDER(^BARBLER(DUZ(2),DA))
IF 'DA
QUIT
DO ^DIK
+4 KILL ^BARBLER(DUZ(2),"LASTRUN")
+5 IF '$DATA(^BARBLER(DUZ(2),0))
SET ^BARBLER(DUZ(2),0)="A/R BILL ERROR^90050.04P"
+6 SET ^BARBLER(DUZ(2),"RUNNING")=1
+7 QUIT
+8 ; *********************************************************************
+9 ;
LOOP ; go thru A/R Bill file
+1 SET BARIDT=BARSDT-.1
+2 FOR
SET BARIDT=$ORDER(^BARBL(DUZ(2),"E",BARIDT))
IF 'BARIDT!(BARIDT>BAREDT)
QUIT
Begin DoDot:1
+3 SET BARBLDA=0
+4 FOR
SET BARBLDA=$ORDER(^BARBL(DUZ(2),"E",BARIDT,BARBLDA))
IF 'BARBLDA
QUIT
DO ONE
End DoDot:1
+5 QUIT
+6 ; *********************************************************************
+7 ;
ONE ;examine one a/r bill for errors
+1 KILL BARNO3P
+2 SET DIE="^BARBLER(DUZ(2),"
+3 NEW I
+4 FOR I=0,1,2
SET BAR(I)=$GET(^BARBL(DUZ(2),BARBLDA,I))
+5 SET BAR3PNM=$PIECE(BAR(0),"^",1)
+6 SET BAR3PNM=$PIECE(BAR3PNM,"-")
+7 SET BARBAL=$PIECE(BAR(0),"^",15)
+8 DO SBL
+9 DO NEG
+10 SET BARDOS=$PIECE(BAR(1),U,2)
+11 SET BARPAT=$PIECE(BAR(1),U)
+12 SET BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),BARBLDA)
+13 IF BAR("3P LOC")=""
Begin DoDot:1
+14 SET DA=BARBLDA
+15 SET DR=".05///1"
+16 DO ^DIE
End DoDot:1
QUIT
+17 SET BAR3PDUZ=$PIECE(BAR("3P LOC"),",")
+18 SET BAR3PDA=$PIECE(BAR("3P LOC"),",",2)
+19 SET BARDUZ2=BAR3PDUZ
+20 SET DA=BARBLDA
+21 SET DIC="^BARBL(DUZ(2),"
+22 SET DIQ="BAR("
+23 SET DIQ(0)="IE"
+24 SET DR="3;101"
+25 DO EN^DIQ1
+26 DO MM
+27 DO RR
+28 KILL BAR,BAR3P,BARDUZ2,BAR3PNM,BAR3PNMB,BARMM,BARNO3P,BAR3PDA
+29 QUIT
+30 ; *********************************************************************
+31 ;
FIXIEN ;attempt to find missing 3p bill
+1 QUIT
+2 ; *********************************************************************
+3 ;
MM ;check for 3p/ar mis-matches
+1 NEW I
+2 FOR I=0,2,7
SET BAR3P(I)=$GET(^ABMDBILL(BARDUZ2,BAR3PDA,I))
+3 SET BAR3PNMB=$PIECE(BAR3P(0),"^",1)
+4 KILL BARMM
+5 ;bill names
IF BAR3PNM'=BAR3PNMB
SET BARMM=1
+6 ;patient
IF $PIECE(BAR3P(0),"^",5)'=$PIECE(BAR(1),"^",1)
SET BARMM=1
+7 ;amt billed
IF (($PIECE(BAR3P(2),"^",1)+.005)\.01/100)'=(($PIECE(BAR(0),"^",13)+.005)\.01/100)
SET BARMM=1
+8 ;dos from
IF $PIECE(BAR3P(7),"^",1)'=$PIECE(BAR(1),"^",2)
SET BARMM=1
+9 ;insurer
+10 ;;;S BARITYP=$P($G(^AUTNINS(+$P(BAR3P(0),"^",8),2)),"^",1)
+11 SET BARINAME=$PIECE($GET(^AUTNINS(+$PIECE(BAR3P(0),U,8),0)),"^",1)
+12 ;PTR TO ^AUTTINTY (.211)
SET BARITYPX=$PIECE($GET(^AUTNINS(+$PIECE(BAR3P(0),U,8),3)),"^",1)
+13 ;P.OTT
SET BARITYP=$PIECE($GET(^AUTTINTY(BARITYPX,0)),U,2)
+14 ;I DUZ=838 W !,"BARITYP= ",BARITYP," ",$ZR R ASD QUIT ;------------------>
+15 IF BARITYP'="N"
Begin DoDot:1
+16 IF BARINAME=$GET(BAR(90050.01,BARBLDA,3,"E"))
QUIT
+17 SET BARMM=1
End DoDot:1
+18 IF BARITYP="N"
Begin DoDot:1
+19 IF $PIECE(^BARAC(DUZ(2),BAR(90050.01,BARBLDA,3,"I"),0),U)'["DPT("
QUIT
+20 IF BAR(90050.01,BARBLDA,3,"E")=BAR(90050.01,BARBLDA,101,"E")
QUIT
+21 SET BARMM=1
End DoDot:1
+22 IF '$GET(BARMM)
QUIT
+23 DO ADD
+24 SET DR=".04///1"
+25 DO ^DIE
+26 QUIT
+27 ; *********************************************************************
+28 ;
SBL ;check for small balance
+1 IF BARBAL'>0
QUIT
+2 SET BARSBL=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),0)),"^",14)
+3 IF 'BARSBL
SET BARSBL=5
+4 IF BARBAL>BARSBL
QUIT
+5 DO ADD
+6 SET DR=".03///1"
+7 DO ^DIE
+8 QUIT
+9 ; *********************************************************************
+10 ;
NEG ;check for negative balance
+1 IF BARBAL'<0
QUIT
+2 DO ADD
+3 SET DR=".02///1"
+4 DO ^DIE
+5 QUIT
+6 ; *********************************************************************
+7 ;
RR ;check if re-roll is needed
+1 IF BARBAL'=0
QUIT
+2 IF $PIECE(BAR3P(0),"^",4)="C"
QUIT
+3 IF $PIECE(BAR3P(0),"^",4)="X"
QUIT
+4 IF $PIECE(BAR(2),"^",8)'="R"
QUIT
+5 IF '+$PIECE(BAR(0),"^",13)
QUIT
+6 IF $GET(BARMM)
QUIT
+7 DO ADD
+8 SET DR=".06///1"
+9 DO ^DIE
+10 QUIT
+11 ; *********************************************************************
+12 ;
ADD ;add to a/r bill error file
+1 SET DA=BARBLDA
+2 IF +$GET(^BARBLER(DUZ(2),DA,0))
QUIT
+3 SET DIC="^BARBLER(DUZ(2),"
+4 SET DIC(0)="LX"
+5 SET X="`"_DA
+6 KILL DD,DO
+7 DO ^DIC
+8 QUIT
+9 ; *********************************************************************
+10 ;
DEV ;select device
+1 SET %ZIS="NQ"
+2 DO ^%ZIS
+3 IF POP
QUIT
+4 IF IO'=IO(0)
DO QUE
DO HOME^%ZIS
QUIT
+5 IF $DATA(IO("S"))
Begin DoDot:1
+6 SET IOP=ION
+7 DO ^%ZIS
End DoDot:1
+8 QUIT
