BARPST2 ; IHS/SD/LSL - PAYMENT PATIENT SELECTION JAN 15,1997 ; 05/07/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,14,23**;OCT 26, 2005
;
; ** patient a/r lookup based on from/thru dos
; ** called from ^BARPST
; ** BARPASS = PATDFN^BEGDOS^ENDDOS
; ** builds an array that includes all entries from a/r that meet the
; criteria.
; - If Bill was 'CLOSED' then not displayed - not found in 3P system
; - If Bill was 'CANCELED' and current amount due is 0 - not displayes, already worked
;HEAT93190 DEC 2012 P.OTTIS NOHEAT MARK DUPLICATE BILLS
; *********************************************************************
;
EN(BARPASS) ; EP
; Pat/BIll lookup
N DIC,DIQ,DR,BARBLV,BARDT,BARPAT,BARBEG,BAREND,BARHIT,BARCNT
K ^BARTMP($J)
Q:+BARPASS=0
S BARPAT=+BARPASS
S BARBEG=$P(BARPASS,U,2)
S BAREND=$P(BARPASS,U,3)
S X1=BARBEG
S X2=-1
D C^%DTC
S BARDT=X
S DIC="^BARBL(DUZ(2),"
S DR=".01;3;13;15;16"
S DIQ="BARBLV("
S BARCNT=0
F S BARDT=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDT)) Q:'BARDT!(BARDT>BAREND) D
.S BARBDA=0
.F S BARBDA=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA)) Q:'BARBDA D
..S DA=BARBDA
..D EN^XBDIQ1
..S BARCNT=BARCNT+1
..I BARBLV(16)'="CLOSED" D
...S ^BARTMP($J,BARBDA,BARCNT)=BARDT_U_BARBLV(.01)_U_BARBLV(13)_U_BARBLV(3)_U_BARBLV(15)_U_U_U_BARBLV(16)
...S ^BARTMP($J,"B",BARCNT,BARBDA)=""
..I (BARBLV(16)="3P CANCELLED")&(BARBLV(15)=0) D
...K ^BARTMP($J,BARBDA,BARCNT)
...;K ^BARTMP($J,BARCNT,BARBDA)
...K ^BARTMP($J,"B",BARCNT,BARBDA) ;IHS/SD/TPF 9/24/2009 H5512
...S BARCNT=BARCNT-1
..I BARBLV(16)="CLOSED" S BARCNT=BARCNT-1
..K BARBLV
Q BARCNT
; *********************************************************************
;
HIT(BARPASS) ; EP
; ** display a/r bills found
N BARBDA,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
S (BARBDA,BARPG,BARSTOP)=0
D HEAD
F S BARBDA=$O(^BARTMP($J,BARBDA)) Q:'BARBDA D Q:BARSTOP
.S BARLIN=$O(^BARTMP($J,BARBDA,""))
.S BARREC=^BARTMP($J,BARBDA,BARLIN)
.S BARBLO=$P(BARREC,U,2)
.I $D(^BARTR(DUZ(2),"AM4",+BARBLO)) S BARBLO="m"_BARBLO
.S BARSTOP=$$CHKLINE(0)
.Q:BARSTOP
.S BARCMSG=" "
.S:$P(BARREC,U,8)="3P CANCELLED" BARCMSG="3P CAN"
. S BARTMP=$$DUPLBILL^BARPNP2($P(BARREC,U,2)) I BARTMP>0 D ;-------->P.OTT MARK DUPLICATE BILLS
. . S BAREIN1=$P(BARTMP,"^",2)
. . S BAREIN2=$P(BARTMP,"^",3)
. . S BARDPTR=$P(BARTMP,"^",4)
. . I BARDPTR=3 S BARBLO="?"_BARBLO Q
. . I BARBDA=BAREIN1,BARDPTR=1 S BARBLO="!"_BARBLO Q ;! = ORPHANT (NO DATA IN 3PB)
. . I BARBDA=BAREIN2,BARDPTR=2 S BARBLO="!"_BARBLO Q ;d = DUPLICATE (CORRECT ONE)
. . I BARBDA=BAREIN1 S BARBLO="d"_BARBLO Q
. . I BARBDA=BAREIN2 S BARBLO="d"_BARBLO Q
. ;---------------------------------------------------------< P.OTT
.;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
.S BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBDA)
.S:$G(BARTPB)'="" BARSTAT=$P($G(^ABMDBILL($P(BARTPB,","),$P(BARTPB,",",2),0)),U,4)
.;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
.W !,$J(BARLIN,3)
.W ?6,$$SDT^BARDUTL($P(BARREC,U,1))
.;W ?18,BARBLO,?25,BARCMSG ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
.W ?18,BARBLO_$S($G(BARSTAT)="X":"*",1:""),?25,BARCMSG ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
.W ?32,$J($P(BARREC,U,3),8,2)
.W ?44,$E($P(BARREC,U,4),1,23)
.W ?70,$J($P(BARREC,U,5),8,2)
;
EXIT ;
Q
; *********************************************************************
;
HEAD ;
W $$EN^BARVDF("IOF"),!
N BARPTNAM
S BARPG=BARPG+1
S BARPTNAM=$P(^DPT(+BARPASS,0),U,1)
I $D(^BARTR(DUZ(2),"AM5",+BARPASS)) S BARPTNAM="(msg) "_BARPTNAM
W "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
W ?(IOM-15),"Page: "_BARPG,!!
;D SUBHD(.BARCOL,.BARITM,BARPMT) ;BAR*1.8*4 DD 4.1.7.2
D SUBHD(.BARCOL,.BARITM,$G(BARPMT)) ;BAR*1.8*4 DD 4.1.7.2
W !!?32,"Billed",?70,"Current"
W !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
S BARDSH=""
S $P(BARDSH,"-",IOM)=""
W !,BARDSH
;
EHEAD ;
Q
; *********************************************************************
;
; changes needed for the Collection Batch DD update (triggers)
SUBHD(BARCOL,BARITM,BARPMT) ; EP
Q:'$D(BARCOL) ;BAR*1.8*4 DD 4.1.7.2
; ** display batch and item headers
K BARCLV,BARITV,BAREOV
N DA,DIC,DIQ,DR
S DIC=90051.01
S DIQ="BARCLV("
S DR=".01;15:18;21"
S DA=+BARCOL
D EN^XBDIQ1
;
S DIC=90051.1101
S DIQ="BARITV("
S DR=".01;18;19;101;103;105"
S DA=+BARITM
S DA(1)=+BARCOL
D EN^XBDIQ1
;
I +$G(BAREOB) D
. S DIC=90051.1101601
. S DIQ="BAREOV("
. S DR=".01;2;3;4;5"
. S DA=+BAREOB
. S DA(2)=+BARCOL
. S DA(1)=+BARITM
. D EN^XBDIQ1
;
W "Batch : "_$E($P(BARCLV(.01),"-",1),1,19)
W ?27,"Item : "_BARITV(.01)
I +$G(BAREOB) W ?50,"Location: "_BAREOV(.01)
W !,"Amount : "_$J(BARCLV(15),8,2)
; changes needed for the Collection Batch DD update (triggers)
W ?27,"Amount : "_$J(BARITV(101),8,2)
I +$G(BAREOB) W ?50," Amount : "_$J(BAREOV(2),8,2)
W !,"Posted : "_$J(BARCLV(16)+BARPMT,8,2)
; changes needed for the Collection Batch DD update (triggers)
W ?27,"Posted : "_$J(BARITV(18)+BARPMT,8,2)
I +$G(BAREOB) W ?50," Posted : "_$J(BAREOV(3)+BARPMT,8,2)
W !,"Unalloc: "_$J(BARCLV(21),8,2)
W ?27,"Unalloc: "_$J(BARITV(105),8,2)
I +$G(BAREOB) W ?50," Unalloc: "_$J(BAREOV(5),8,2)
W !
;
B1 ;
W "Balance: "_$J(BARCLV(17)-BARPMT,8,2)
W ?27,"Balance: "_$J(BARITV(19)-BARPMT,8,2)
;
B2 ;
I +$G(BAREOB) W ?50," Balance: "_$J(BAREOV(4)-BARPMT,8,2)
Q
; *********************************************************************
;
HIT1(BARPASS) ; EP
; ** display a/r bills found
N BARHIT,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
S (BARTPAY,BARTADJ,BARHIT,BARPG,BARSTOP)=0
D HEAD1
F S BARHIT=$O(^BARTMP($J,BARHIT)) Q:'BARHIT DO Q:BARSTOP
.S BARLIN=$O(^BARTMP($J,BARHIT,""))
.S BARREC=^BARTMP($J,BARHIT,BARLIN)
.S BARBLO=$P(BARREC,U,2) I $D(^BARTR(DUZ(2),"AM4",+BARBLO)) S BARBLO="m"_BARBLO
.S BARTPAY=BARTPAY+$P(BARREC,U,6)
.S BARTADJ=BARTADJ+$P(BARREC,U,7)
.S BARSTOP=$$CHKLINE(1) Q:BARSTOP
.S BARCMSG=" "
.S:$P(BARREC,U,8)="3P CANCELLED" BARCMSG="3P CAN"
. S BARTMP=$$DUPLBILL^BARPNP2($P(BARREC,U,2)) I BARTMP>0 D ;-------->P.OTT MARK DUPLICATE BILLS
. . S BAREIN1=$P(BARTMP,"^",2)
. . S BAREIN2=$P(BARTMP,"^",3)
. . S BARDPTR=$P(BARTMP,"^",4)
. . I BARDPTR=3 S BARBLO="?"_BARBLO Q
. . I BARHIT=BAREIN1,BARDPTR=1 S BARBLO="!"_BARBLO Q ;! = ORPHANT (NO DATA IN 3PB)
. . I BARHIT=BAREIN2,BARDPTR=2 S BARBLO="!"_BARBLO Q ;d = DUPLICATE (CORRECT ONE)
. . I BARHIT=BAREIN1 S BARBLO="d"_BARBLO Q
. . I BARHIT=BAREIN2 S BARBLO="d"_BARBLO Q
. ;---------------------------------------------------------< P.OTT
.;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
.S BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARHIT)
.S:$G(BARTPB)'="" BARSTAT=$P($G(^ABMDBILL($P(BARTPB,","),$P(BARTPB,",",2),0)),U,4)
.;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
.W !,$J(BARLIN,3),?6,$$SDT^BARDUTL($P(BARREC,U,1)),?18,BARBLO
.W:($G(BARSTAT)="X") "*" ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
.W ?25,BARCMSG
.W ?32,$J($P(BARREC,U,3),8,2)
.W ?49,$J($P(BARREC,U,6),8,2)
.W ?60,$J($P(BARREC,U,7),8,2)
.W ?71,$J($P(BARREC,U,5),8,2)
Q
; *********************************************************************
;
HEAD1 ;
W $$EN^BARVDF("IOF"),!
N BARPTNAM
S BARPG=BARPG+1
S BARPTNAM=$P(^DPT(+BARPASS,0),U,1)
I $D(^BARTR(DUZ(2),"AM5",+BARPASS)) S BARPTNAM="(msg) "_BARPTNAM
W "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($P(BARPASS,U,2))_" to "_$$SDT^BARDUTL($P(BARPASS,U,3))
W ?(IOM-15),"Page: "_BARPG,!!
D SUBHD^BARPST2(.BARCOL,.BARITM,$G(BARPMT))
W !!?40,"Billed",?50,"Current",?61,"Current",?72,"Current"
W !,"Line #",?8,"DOS",?18,"Claim #",?40,"Amount",?50,"Paymnts",?62,"Adjust",?72,"Balance"
S BARDSH=""
S $P(BARDSH,"-",IOM)=""
W !,BARDSH
Q
; *********************************************************************
;
CHKLINE(BARHD) ;
; Q 0 = CONTINUE
; Q 1 = STOP
N X
I ($Y+5)<IOSL Q 0
W !?(IOM-15),"continued==>"
D EOP^BARUTL(0)
I 'Y Q 1
I BARHD=0 D HEAD
I BARHD=1 D HEAD1
;
ECHKLINE ;
Q 0
BARPST2 ; IHS/SD/LSL - PAYMENT PATIENT SELECTION JAN 15,1997 ; 05/07/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,14,23**;OCT 26, 2005
+2 ;
+3 ; ** patient a/r lookup based on from/thru dos
+4 ; ** called from ^BARPST
+5 ; ** BARPASS = PATDFN^BEGDOS^ENDDOS
+6 ; ** builds an array that includes all entries from a/r that meet the
+7 ; criteria.
+8 ; - If Bill was 'CLOSED' then not displayed - not found in 3P system
+9 ; - If Bill was 'CANCELED' and current amount due is 0 - not displayes, already worked
+10 ;HEAT93190 DEC 2012 P.OTTIS NOHEAT MARK DUPLICATE BILLS
+11 ; *********************************************************************
+12 ;
EN(BARPASS) ; EP
+1 ; Pat/BIll lookup
+2 NEW DIC,DIQ,DR,BARBLV,BARDT,BARPAT,BARBEG,BAREND,BARHIT,BARCNT
+3 KILL ^BARTMP($JOB)
+4 IF +BARPASS=0
QUIT
+5 SET BARPAT=+BARPASS
+6 SET BARBEG=$PIECE(BARPASS,U,2)
+7 SET BAREND=$PIECE(BARPASS,U,3)
+8 SET X1=BARBEG
+9 SET X2=-1
+10 DO C^%DTC
+11 SET BARDT=X
+12 SET DIC="^BARBL(DUZ(2),"
+13 SET DR=".01;3;13;15;16"
+14 SET DIQ="BARBLV("
+15 SET BARCNT=0
+16 FOR
SET BARDT=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDT))
IF 'BARDT!(BARDT>BAREND)
QUIT
Begin DoDot:1
+17 SET BARBDA=0
+18 FOR
SET BARBDA=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA))
IF 'BARBDA
QUIT
Begin DoDot:2
+19 SET DA=BARBDA
+20 DO EN^XBDIQ1
+21 SET BARCNT=BARCNT+1
+22 IF BARBLV(16)'="CLOSED"
Begin DoDot:3
+23 SET ^BARTMP($JOB,BARBDA,BARCNT)=BARDT_U_BARBLV(.01)_U_BARBLV(13)_U_BARBLV(3)_U_BARBLV(15)_U_U_U_BARBLV(16)
+24 SET ^BARTMP($JOB,"B",BARCNT,BARBDA)=""
End DoDot:3
+25 IF (BARBLV(16)="3P CANCELLED")&(BARBLV(15)=0)
Begin DoDot:3
+26 KILL ^BARTMP($JOB,BARBDA,BARCNT)
+27 ;K ^BARTMP($J,BARCNT,BARBDA)
+28 ;IHS/SD/TPF 9/24/2009 H5512
KILL ^BARTMP($JOB,"B",BARCNT,BARBDA)
+29 SET BARCNT=BARCNT-1
End DoDot:3
+30 IF BARBLV(16)="CLOSED"
SET BARCNT=BARCNT-1
+31 KILL BARBLV
End DoDot:2
End DoDot:1
+32 QUIT BARCNT
+33 ; *********************************************************************
+34 ;
HIT(BARPASS) ; EP
+1 ; ** display a/r bills found
+2 NEW BARBDA,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
+3 SET (BARBDA,BARPG,BARSTOP)=0
+4 DO HEAD
+5 FOR
SET BARBDA=$ORDER(^BARTMP($JOB,BARBDA))
IF 'BARBDA
QUIT
Begin DoDot:1
+6 SET BARLIN=$ORDER(^BARTMP($JOB,BARBDA,""))
+7 SET BARREC=^BARTMP($JOB,BARBDA,BARLIN)
+8 SET BARBLO=$PIECE(BARREC,U,2)
+9 IF $DATA(^BARTR(DUZ(2),"AM4",+BARBLO))
SET BARBLO="m"_BARBLO
+10 SET BARSTOP=$$CHKLINE(0)
+11 IF BARSTOP
QUIT
+12 SET BARCMSG=" "
+13 IF $PIECE(BARREC,U,8)="3P CANCELLED"
SET BARCMSG="3P CAN"
+14 ;-------->P.OTT MARK DUPLICATE BILLS
SET BARTMP=$$DUPLBILL^BARPNP2($PIECE(BARREC,U,2))
IF BARTMP>0
Begin DoDot:2
+15 SET BAREIN1=$PIECE(BARTMP,"^",2)
+16 SET BAREIN2=$PIECE(BARTMP,"^",3)
+17 SET BARDPTR=$PIECE(BARTMP,"^",4)
+18 IF BARDPTR=3
SET BARBLO="?"_BARBLO
QUIT
+19 ;! = ORPHANT (NO DATA IN 3PB)
IF BARBDA=BAREIN1
IF BARDPTR=1
SET BARBLO="!"_BARBLO
QUIT
+20 ;d = DUPLICATE (CORRECT ONE)
IF BARBDA=BAREIN2
IF BARDPTR=2
SET BARBLO="!"_BARBLO
QUIT
+21 IF BARBDA=BAREIN1
SET BARBLO="d"_BARBLO
QUIT
+22 IF BARBDA=BAREIN2
SET BARBLO="d"_BARBLO
QUIT
End DoDot:2
+23 ;---------------------------------------------------------< P.OTT
+24 ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
+25 SET BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBDA)
+26 IF $GET(BARTPB)'=""
SET BARSTAT=$PIECE($GET(^ABMDBILL($PIECE(BARTPB,","),$PIECE(BARTPB,",",2),0)),U,4)
+27 ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
+28 WRITE !,$JUSTIFY(BARLIN,3)
+29 WRITE ?6,$$SDT^BARDUTL($PIECE(BARREC,U,1))
+30 ;W ?18,BARBLO,?25,BARCMSG ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
+31 ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
WRITE ?18,BARBLO_$SELECT($GET(BARSTAT)="X":"*",1:""),?25,BARCMSG
+32 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
+33 WRITE ?44,$EXTRACT($PIECE(BARREC,U,4),1,23)
+34 WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5),8,2)
End DoDot:1
IF BARSTOP
QUIT
+35 ;
EXIT ;
+1 QUIT
+2 ; *********************************************************************
+3 ;
HEAD ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 NEW BARPTNAM
+3 SET BARPG=BARPG+1
+4 SET BARPTNAM=$PIECE(^DPT(+BARPASS,0),U,1)
+5 IF $DATA(^BARTR(DUZ(2),"AM5",+BARPASS))
SET BARPTNAM="(msg) "_BARPTNAM
+6 WRITE "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($PIECE(BARPASS,U,2))_" to "_$$SDT^BARDUTL($PIECE(BARPASS,U,3))
+7 WRITE ?(IOM-15),"Page: "_BARPG,!!
+8 ;D SUBHD(.BARCOL,.BARITM,BARPMT) ;BAR*1.8*4 DD 4.1.7.2
+9 ;BAR*1.8*4 DD 4.1.7.2
DO SUBHD(.BARCOL,.BARITM,$GET(BARPMT))
+10 WRITE !!?32,"Billed",?70,"Current"
+11 WRITE !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
+12 SET BARDSH=""
+13 SET $PIECE(BARDSH,"-",IOM)=""
+14 WRITE !,BARDSH
+15 ;
EHEAD ;
+1 QUIT
+2 ; *********************************************************************
+3 ;
+4 ; changes needed for the Collection Batch DD update (triggers)
SUBHD(BARCOL,BARITM,BARPMT) ; EP
+1 ;BAR*1.8*4 DD 4.1.7.2
IF '$DATA(BARCOL)
QUIT
+2 ; ** display batch and item headers
+3 KILL BARCLV,BARITV,BAREOV
+4 NEW DA,DIC,DIQ,DR
+5 SET DIC=90051.01
+6 SET DIQ="BARCLV("
+7 SET DR=".01;15:18;21"
+8 SET DA=+BARCOL
+9 DO EN^XBDIQ1
+10 ;
+11 SET DIC=90051.1101
+12 SET DIQ="BARITV("
+13 SET DR=".01;18;19;101;103;105"
+14 SET DA=+BARITM
+15 SET DA(1)=+BARCOL
+16 DO EN^XBDIQ1
+17 ;
+18 IF +$GET(BAREOB)
Begin DoDot:1
+19 SET DIC=90051.1101601
+20 SET DIQ="BAREOV("
+21 SET DR=".01;2;3;4;5"
+22 SET DA=+BAREOB
+23 SET DA(2)=+BARCOL
+24 SET DA(1)=+BARITM
+25 DO EN^XBDIQ1
End DoDot:1
+26 ;
+27 WRITE "Batch : "_$EXTRACT($PIECE(BARCLV(.01),"-",1),1,19)
+28 WRITE ?27,"Item : "_BARITV(.01)
+29 IF +$GET(BAREOB)
WRITE ?50,"Location: "_BAREOV(.01)
+30 WRITE !,"Amount : "_$JUSTIFY(BARCLV(15),8,2)
+31 ; changes needed for the Collection Batch DD update (triggers)
+32 WRITE ?27,"Amount : "_$JUSTIFY(BARITV(101),8,2)
+33 IF +$GET(BAREOB)
WRITE ?50," Amount : "_$JUSTIFY(BAREOV(2),8,2)
+34 WRITE !,"Posted : "_$JUSTIFY(BARCLV(16)+BARPMT,8,2)
+35 ; changes needed for the Collection Batch DD update (triggers)
+36 WRITE ?27,"Posted : "_$JUSTIFY(BARITV(18)+BARPMT,8,2)
+37 IF +$GET(BAREOB)
WRITE ?50," Posted : "_$JUSTIFY(BAREOV(3)+BARPMT,8,2)
+38 WRITE !,"Unalloc: "_$JUSTIFY(BARCLV(21),8,2)
+39 WRITE ?27,"Unalloc: "_$JUSTIFY(BARITV(105),8,2)
+40 IF +$GET(BAREOB)
WRITE ?50," Unalloc: "_$JUSTIFY(BAREOV(5),8,2)
+41 WRITE !
+42 ;
B1 ;
+1 WRITE "Balance: "_$JUSTIFY(BARCLV(17)-BARPMT,8,2)
+2 WRITE ?27,"Balance: "_$JUSTIFY(BARITV(19)-BARPMT,8,2)
+3 ;
B2 ;
+1 IF +$GET(BAREOB)
WRITE ?50," Balance: "_$JUSTIFY(BAREOV(4)-BARPMT,8,2)
+2 QUIT
+3 ; *********************************************************************
+4 ;
HIT1(BARPASS) ; EP
+1 ; ** display a/r bills found
+2 NEW BARHIT,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
+3 SET (BARTPAY,BARTADJ,BARHIT,BARPG,BARSTOP)=0
+4 DO HEAD1
+5 FOR
SET BARHIT=$ORDER(^BARTMP($JOB,BARHIT))
IF 'BARHIT
QUIT
Begin DoDot:1
+6 SET BARLIN=$ORDER(^BARTMP($JOB,BARHIT,""))
+7 SET BARREC=^BARTMP($JOB,BARHIT,BARLIN)
+8 SET BARBLO=$PIECE(BARREC,U,2)
IF $DATA(^BARTR(DUZ(2),"AM4",+BARBLO))
SET BARBLO="m"_BARBLO
+9 SET BARTPAY=BARTPAY+$PIECE(BARREC,U,6)
+10 SET BARTADJ=BARTADJ+$PIECE(BARREC,U,7)
+11 SET BARSTOP=$$CHKLINE(1)
IF BARSTOP
QUIT
+12 SET BARCMSG=" "
+13 IF $PIECE(BARREC,U,8)="3P CANCELLED"
SET BARCMSG="3P CAN"
+14 ;-------->P.OTT MARK DUPLICATE BILLS
SET BARTMP=$$DUPLBILL^BARPNP2($PIECE(BARREC,U,2))
IF BARTMP>0
Begin DoDot:2
+15 SET BAREIN1=$PIECE(BARTMP,"^",2)
+16 SET BAREIN2=$PIECE(BARTMP,"^",3)
+17 SET BARDPTR=$PIECE(BARTMP,"^",4)
+18 IF BARDPTR=3
SET BARBLO="?"_BARBLO
QUIT
+19 ;! = ORPHANT (NO DATA IN 3PB)
IF BARHIT=BAREIN1
IF BARDPTR=1
SET BARBLO="!"_BARBLO
QUIT
+20 ;d = DUPLICATE (CORRECT ONE)
IF BARHIT=BAREIN2
IF BARDPTR=2
SET BARBLO="!"_BARBLO
QUIT
+21 IF BARHIT=BAREIN1
SET BARBLO="d"_BARBLO
QUIT
+22 IF BARHIT=BAREIN2
SET BARBLO="d"_BARBLO
QUIT
End DoDot:2
+23 ;---------------------------------------------------------< P.OTT
+24 ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
+25 SET BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARHIT)
+26 IF $GET(BARTPB)'=""
SET BARSTAT=$PIECE($GET(^ABMDBILL($PIECE(BARTPB,","),$PIECE(BARTPB,",",2),0)),U,4)
+27 ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
+28 WRITE !,$JUSTIFY(BARLIN,3),?6,$$SDT^BARDUTL($PIECE(BARREC,U,1)),?18,BARBLO
+29 ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
IF ($GET(BARSTAT)="X")
WRITE "*"
+30 WRITE ?25,BARCMSG
+31 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
+32 WRITE ?49,$JUSTIFY($PIECE(BARREC,U,6),8,2)
+33 WRITE ?60,$JUSTIFY($PIECE(BARREC,U,7),8,2)
+34 WRITE ?71,$JUSTIFY($PIECE(BARREC,U,5),8,2)
End DoDot:1
IF BARSTOP
QUIT
+35 QUIT
+36 ; *********************************************************************
+37 ;
HEAD1 ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 NEW BARPTNAM
+3 SET BARPG=BARPG+1
+4 SET BARPTNAM=$PIECE(^DPT(+BARPASS,0),U,1)
+5 IF $DATA(^BARTR(DUZ(2),"AM5",+BARPASS))
SET BARPTNAM="(msg) "_BARPTNAM
+6 WRITE "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($PIECE(BARPASS,U,2))_" to "_$$SDT^BARDUTL($PIECE(BARPASS,U,3))
+7 WRITE ?(IOM-15),"Page: "_BARPG,!!
+8 DO SUBHD^BARPST2(.BARCOL,.BARITM,$GET(BARPMT))
+9 WRITE !!?40,"Billed",?50,"Current",?61,"Current",?72,"Current"
+10 WRITE !,"Line #",?8,"DOS",?18,"Claim #",?40,"Amount",?50,"Paymnts",?62,"Adjust",?72,"Balance"
+11 SET BARDSH=""
+12 SET $PIECE(BARDSH,"-",IOM)=""
+13 WRITE !,BARDSH
+14 QUIT
+15 ; *********************************************************************
+16 ;
CHKLINE(BARHD) ;
+1 ; Q 0 = CONTINUE
+2 ; Q 1 = STOP
+3 NEW X
+4 IF ($Y+5)<IOSL
QUIT 0
+5 WRITE !?(IOM-15),"continued==>"
+6 DO EOP^BARUTL(0)
+7 IF 'Y
QUIT 1
+8 IF BARHD=0
DO HEAD
+9 IF BARHD=1
DO HEAD1
+10 ;
ECHKLINE ;
+1 QUIT 0
