BARRERL2 ; IHS/SD/LSL - Print Synch Reports ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6**;OCT 26, 2005
;
; IHS/ASDS/LSL - 06/19/2001 - V1.5 Patch 1 - NOIS BXX-0501-150074
; Modified to correct the display of dollar amounts.
;
; IHS/SD/LSL - 12/06/02 - V1.7 - NOIS NHA-0601-180049
; Modified to find bill in 3PB properly
;
; IHS/SD/SDR - v1.8 p6 - DD 4.1.3
; Remove Negative Balance report and make it stand-alone report
;
; *********************************************************************
;
RR ;EP - re-roll
D ^BARRERL ;BAR*1.8*4
D RCHK
Q:'$G(BAROK)
S BARHDR="RE-ROLL"
S BARXRF="ARR"
D DEV
Q
; *********************************************************************
;
SB ;EP - small balance
D ^BARRERL ;BAR*1.8*4
D RCHK Q:'BAROK
S BARHDR="SMALL BALANCE"
S BARXRF="ASBL"
D DEV
Q
; *********************************************************************
;
;start old code bar*1.8*6 DD 4.1.3
NB ;EP - negative balance
D ^BARRERL ;BAR*1.8*4
D RCHK
Q:'BAROK
S BARHDR="NEGATIVE BALANCE"
S BARXRF="ANEG"
D DEV
Q
;end old code DD 4.1.3
; *********************************************************************
;
MM ;EP - 3p - a/r mis-matches
D ^BARRERL ;BAR*1.8*4
D RCHK
Q:'BAROK
S BARHDR="3P - A/R MISMATCH"
S BARXRF="AMM"
D DEV
Q
; *********************************************************************
;
IEN ;EP - 3P ien wrong
D ^BARRERL ;BAR*1.8*4
D RCHK
Q:'BAROK
S BARHDR="A/R MISSING 3P BILL"
S BARXRF="AIEN"
D DEV
Q
; *********************************************************************
;
RCHK ;check for error run
S BAROK=0
I $G(^BARBLER(DUZ(2),"RUNNING")) D Q
.W !!,"A/R Bill File Error Scan is currently running. The scan"
.W !,"must complete before printing lists.",!
.D EOP^BARUTL(1)
I '$G(^BARBLER(DUZ(2),"LASTRUN")) D Q
.W !!,"You need to run the 'Bill File Error Scan' option before printing any reports.",!
.D EOP^BARUTL(1)
S BAROK=1
Q
; *********************************************************************
;
DEV ;select device
W !
S %ZIS="NQ"
D ^%ZIS
Q:POP
I IO'=IO(0) D Q
.S ZTRTN="LNP^BARRERL2"
.N I
.F I="BARHDR","BARXRF" S ZTSAVE(I)=""
.S ZTDESC="A/R - 3P SYNCH REPORTS"
.D ^%ZTLOAD
.W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
.D HOME^%ZIS
I $D(IO("S")) D
.S IOP=ION
.D ^%ZIS
D LNP
K BARQUIT
Q
; *********************************************************************
;
LNP ;loop & print
K BARQUIT
S $P(BAREQ,"=",80)=""
S $P(BARDSH,"-",80)=""
S BARPG=0
D HDR
S DA=0
F S DA=$O(^BARBLER(DUZ(2),BARXRF,1,DA)) Q:'DA!($G(BARQUIT)) D
. S Y=1
.I $Y+5>IOSL D
..D EOP^BARUTL(0)
..I '+Y S BARQUIT=1 Q
..D HDR
.Q:$G(BARQUIT)
.K BAR
.S DIC="^BARBL(DUZ(2),"
.S DIQ="BAR("
.S DIQ(0)="IE"
.S DR=".01;3;13;15;17;22;101;102;108"
.D EN^DIQ1
.W !,"AR",?5,DA
.W ?11,$P(BAR(90050.01,DA,.01,"E"),"-",1)
.W ?20,$E(BAR(90050.01,DA,101,"E"),1,20)
.W ?41,$$SDT^BARDUTL(BAR(90050.01,DA,102,"I"))
.W ?52,$E(BAR(90050.01,DA,3,"E"),1,10)
.I BARXRF="ASBL"!(BARXRF="ANEG") D
..W ?69,$J($FN(+$G(BAR(90050.01,DA,15,"I")),",",3),10)
.E D
..W ?69,$J($FN(BAR(90050.01,DA,13,"I"),",",2),10)
.Q:BARXRF'="AMM"
. S BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),DA)
. Q:BAR("3P LOC")=""
. S BAR3PDUZ=$P(BAR("3P LOC"),",")
. S BAR3PIEN=$P(BAR("3P LOC"),",",2)
. N I
. F I=0,2,7 S BAR3P(I)=$G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,I))
. W !,"3P",?5,BAR3PIEN
.W ?11,$P(BAR3P(0),"^",1)
.W ?20,$E($P($G(^DPT(+$P(BAR3P(0),"^",5),0)),"^",1),1,20)
.W ?41,$$SDT^BARDUTL(+BAR3P(7))
.W ?52,$E($P($G(^AUTNINS(+$P(BAR3P(0),"^",8),0)),"^",1),1,10)
. W ?69,$J($FN(+BAR3P(2),",",2),10)
.W !
.K BAR3P
W !!,"E N D O F R E P O R T",!!
D EOP^BARUTL(1)
W $$EN^BARVDF("IOF")
K BARHDR,BARXRF,BAR,BAR3P
I $D(IO("S")) D ^%ZISC
Q
; *********************************************************************
;
HDR ;report header
S BARPG=BARPG+1
W $$EN^BARVDF("IOF")
W !,$$MDT^BARDUTL(DT)
W ?30,BARHDR
W ?70,"Page: ",BARPG
W !,BAREQ
W !,?5,"IEN BILL#",?20,"PATIENT",?41,"DOS",?52,"BILLED TO"
I BARXRF="ASBL"!(BARXRF="ANEG") D Q
.W ?72,"BALANCE"
.W !,BARDSH
W ?69,"AMT BILLED"
W !,BARDSH
Q
BARRERL2 ; IHS/SD/LSL - Print Synch Reports ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,6**;OCT 26, 2005
+2 ;
+3 ; IHS/ASDS/LSL - 06/19/2001 - V1.5 Patch 1 - NOIS BXX-0501-150074
+4 ; Modified to correct the display of dollar amounts.
+5 ;
+6 ; IHS/SD/LSL - 12/06/02 - V1.7 - NOIS NHA-0601-180049
+7 ; Modified to find bill in 3PB properly
+8 ;
+9 ; IHS/SD/SDR - v1.8 p6 - DD 4.1.3
+10 ; Remove Negative Balance report and make it stand-alone report
+11 ;
+12 ; *********************************************************************
+13 ;
RR ;EP - re-roll
+1 ;BAR*1.8*4
DO ^BARRERL
+2 DO RCHK
+3 IF '$GET(BAROK)
QUIT
+4 SET BARHDR="RE-ROLL"
+5 SET BARXRF="ARR"
+6 DO DEV
+7 QUIT
+8 ; *********************************************************************
+9 ;
SB ;EP - small balance
+1 ;BAR*1.8*4
DO ^BARRERL
+2 DO RCHK
IF 'BAROK
QUIT
+3 SET BARHDR="SMALL BALANCE"
+4 SET BARXRF="ASBL"
+5 DO DEV
+6 QUIT
+7 ; *********************************************************************
+8 ;
+9 ;start old code bar*1.8*6 DD 4.1.3
NB ;EP - negative balance
+1 ;BAR*1.8*4
DO ^BARRERL
+2 DO RCHK
+3 IF 'BAROK
QUIT
+4 SET BARHDR="NEGATIVE BALANCE"
+5 SET BARXRF="ANEG"
+6 DO DEV
+7 QUIT
+8 ;end old code DD 4.1.3
+9 ; *********************************************************************
+10 ;
MM ;EP - 3p - a/r mis-matches
+1 ;BAR*1.8*4
DO ^BARRERL
+2 DO RCHK
+3 IF 'BAROK
QUIT
+4 SET BARHDR="3P - A/R MISMATCH"
+5 SET BARXRF="AMM"
+6 DO DEV
+7 QUIT
+8 ; *********************************************************************
+9 ;
IEN ;EP - 3P ien wrong
+1 ;BAR*1.8*4
DO ^BARRERL
+2 DO RCHK
+3 IF 'BAROK
QUIT
+4 SET BARHDR="A/R MISSING 3P BILL"
+5 SET BARXRF="AIEN"
+6 DO DEV
+7 QUIT
+8 ; *********************************************************************
+9 ;
RCHK ;check for error run
+1 SET BAROK=0
+2 IF $GET(^BARBLER(DUZ(2),"RUNNING"))
Begin DoDot:1
+3 WRITE !!,"A/R Bill File Error Scan is currently running. The scan"
+4 WRITE !,"must complete before printing lists.",!
+5 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+6 IF '$GET(^BARBLER(DUZ(2),"LASTRUN"))
Begin DoDot:1
+7 WRITE !!,"You need to run the 'Bill File Error Scan' option before printing any reports.",!
+8 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+9 SET BAROK=1
+10 QUIT
+11 ; *********************************************************************
+12 ;
DEV ;select device
+1 WRITE !
+2 SET %ZIS="NQ"
+3 DO ^%ZIS
+4 IF POP
QUIT
+5 IF IO'=IO(0)
Begin DoDot:1
+6 SET ZTRTN="LNP^BARRERL2"
+7 NEW I
+8 FOR I="BARHDR","BARXRF"
SET ZTSAVE(I)=""
+9 SET ZTDESC="A/R - 3P SYNCH REPORTS"
+10 DO ^%ZTLOAD
+11 IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued.",!
+12 DO HOME^%ZIS
End DoDot:1
QUIT
+13 IF $DATA(IO("S"))
Begin DoDot:1
+14 SET IOP=ION
+15 DO ^%ZIS
End DoDot:1
+16 DO LNP
+17 KILL BARQUIT
+18 QUIT
+19 ; *********************************************************************
+20 ;
LNP ;loop & print
+1 KILL BARQUIT
+2 SET $PIECE(BAREQ,"=",80)=""
+3 SET $PIECE(BARDSH,"-",80)=""
+4 SET BARPG=0
+5 DO HDR
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^BARBLER(DUZ(2),BARXRF,1,DA))
IF 'DA!($GET(BARQUIT))
QUIT
Begin DoDot:1
+8 SET Y=1
+9 IF $Y+5>IOSL
Begin DoDot:2
+10 DO EOP^BARUTL(0)
+11 IF '+Y
SET BARQUIT=1
QUIT
+12 DO HDR
End DoDot:2
+13 IF $GET(BARQUIT)
QUIT
+14 KILL BAR
+15 SET DIC="^BARBL(DUZ(2),"
+16 SET DIQ="BAR("
+17 SET DIQ(0)="IE"
+18 SET DR=".01;3;13;15;17;22;101;102;108"
+19 DO EN^DIQ1
+20 WRITE !,"AR",?5,DA
+21 WRITE ?11,$PIECE(BAR(90050.01,DA,.01,"E"),"-",1)
+22 WRITE ?20,$EXTRACT(BAR(90050.01,DA,101,"E"),1,20)
+23 WRITE ?41,$$SDT^BARDUTL(BAR(90050.01,DA,102,"I"))
+24 WRITE ?52,$EXTRACT(BAR(90050.01,DA,3,"E"),1,10)
+25 IF BARXRF="ASBL"!(BARXRF="ANEG")
Begin DoDot:2
+26 WRITE ?69,$JUSTIFY($FNUMBER(+$GET(BAR(90050.01,DA,15,"I")),",",3),10)
End DoDot:2
+27 IF '$TEST
Begin DoDot:2
+28 WRITE ?69,$JUSTIFY($FNUMBER(BAR(90050.01,DA,13,"I"),",",2),10)
End DoDot:2
+29 IF BARXRF'="AMM"
QUIT
+30 SET BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),DA)
+31 IF BAR("3P LOC")=""
QUIT
+32 SET BAR3PDUZ=$PIECE(BAR("3P LOC"),",")
+33 SET BAR3PIEN=$PIECE(BAR("3P LOC"),",",2)
+34 NEW I
+35 FOR I=0,2,7
SET BAR3P(I)=$GET(^ABMDBILL(BAR3PDUZ,BAR3PIEN,I))
+36 WRITE !,"3P",?5,BAR3PIEN
+37 WRITE ?11,$PIECE(BAR3P(0),"^",1)
+38 WRITE ?20,$EXTRACT($PIECE($GET(^DPT(+$PIECE(BAR3P(0),"^",5),0)),"^",1),1,20)
+39 WRITE ?41,$$SDT^BARDUTL(+BAR3P(7))
+40 WRITE ?52,$EXTRACT($PIECE($GET(^AUTNINS(+$PIECE(BAR3P(0),"^",8),0)),"^",1),1,10)
+41 WRITE ?69,$JUSTIFY($FNUMBER(+BAR3P(2),",",2),10)
+42 WRITE !
+43 KILL BAR3P
End DoDot:1
+44 WRITE !!,"E N D O F R E P O R T",!!
+45 DO EOP^BARUTL(1)
+46 WRITE $$EN^BARVDF("IOF")
+47 KILL BARHDR,BARXRF,BAR,BAR3P
+48 IF $DATA(IO("S"))
DO ^%ZISC
+49 QUIT
+50 ; *********************************************************************
+51 ;
HDR ;report header
+1 SET BARPG=BARPG+1
+2 WRITE $$EN^BARVDF("IOF")
+3 WRITE !,$$MDT^BARDUTL(DT)
+4 WRITE ?30,BARHDR
+5 WRITE ?70,"Page: ",BARPG
+6 WRITE !,BAREQ
+7 WRITE !,?5,"IEN BILL#",?20,"PATIENT",?41,"DOS",?52,"BILLED TO"
+8 IF BARXRF="ASBL"!(BARXRF="ANEG")
Begin DoDot:1
+9 WRITE ?72,"BALANCE"
+10 WRITE !,BARDSH
End DoDot:1
QUIT
+11 WRITE ?69,"AMT BILLED"
+12 WRITE !,BARDSH
+13 QUIT
