BARPNP2 ; IHS/SD/LSL - POSTING PATIENT LOOKUP ; 05/02/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,23**;OCT 26, 2005
;
; IHS/SD/LSL - 11/08/02 - V1.7 - NOIS CNA-1102-110028
; If when looping through ABC x-ref, there is no data for the bill,
; k the x-ref and q
;
; ********************************************************************
;
; verify Status of Bill,
; If the bill was 'CLOSED' not displayed - no 3P bill found
; If the bill was 'CANCELED' and Current bill amount is 0 not displayed - has already been worked
;** 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.
;HEAT93190 DEC 2012 P.OTTIS NOHEAT MARK DUPLICATE BILLS
; *********************************************************************
;
EN(BARPASS) ;EP - pat/bills lookup
N DIC,DIQ,DR,BARBLV,BARDT,BARPAT,BARBEG,BAREND,BARHIT,BARCNT
K ^BARTMP($J)
S BARCNT=0
I (+$G(BARPASS)=0) Q 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) DO
. S BARBDA=0
. F S BARBDA=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA)) Q:'BARBDA DO
.. I '$D(^BARBL(DUZ(2),BARBDA)) K ^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA) Q
.. 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,"B",BARCNT,BARBDA)
... 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 DO 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($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 !,BARLIN
. W ?6,$$SDT^BARDUTL($P(BARREC,U,1))
. W ?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 ?44,$E($P(BARREC,U,4),1,23)
. W ?70,$J($P(BARREC,U,5),8,2)
Q
; *********************************************************************
;
HEAD ;
W $$EN^BARVDF("IOF"),!
N BARPTNAM
Q:'+$G(BARPASS)
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
W !!
W ?32,"Billed",?70,"Current"
W !
W "Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
S BARDSH="",$P(BARDSH,"-",IOM)=""
W !,BARDSH
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 D 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($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 !,BARLIN
.W ?6,$$SDT^BARDUTL($P(BARREC,U,1))
.W ?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 ?44,$J($P(BARREC,U,6),8,2)
.W ?56,$J($P(BARREC,U,7),8,2)
.W ?70,$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
W !!?32,"Billed",?44,"Current",?56,"Current",?70,"Current"
W !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Payments",?56,"Adjust.",?70,"Balance"
S BARDSH=""
S $P(BARDSH,"-",IOM)=""
W !,BARDSH
Q
; *********************************************************************
;
CHKLINE(BARHD) ;EP
; 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
Q 0
DUPLBILL(BARBN) ;CHECK FOR DUPLICATE BILLS
; IF THE BILL# IS A DUPLICATE RETURNS: 1^EIN1^EIN2^PTR (PTR POINTS TO THE 'ORPHANT' EIN1 or EIN2)
;NEW BAREIN1,BAREIN2,BAR3PEIN,BARDUZ3P,BARAPP1,BARAPP2,BARRET
S BAREIN1=$O(^BARBL(DUZ(2),"B",BARBN,"")) I BAREIN1="" Q -1 ;0 ;NO DATA - WE DON'T CARE
S BAREIN2=$O(^BARBL(DUZ(2),"B",BARBN,BAREIN1)) I BAREIN2="" Q -2 ;0 ;ONLY 1 BILL - NO DUPS
;TAKE 1ST OF THE PAIR
S BARRET="1^"_BAREIN1_"^"_BAREIN2_"^"
S BAR3PEIN=$P($G(^BARBL(DUZ(2),BAREIN1,0)),"^",17)
S BARDUZ3P=$P($G(^BARBL(DUZ(2),BAREIN1,0)),"^",22)
I BAR3PEIN="" Q -3 ;0 ;NO DATA
I BARDUZ3P="" Q -4 ;0 ;NO DATA
;
S BARAPP1=0 I '$D(^ABMDBILL(BARDUZ3P,BAR3PEIN,0)) S BARAPP1=1 ;OK
;TAKE 2ND OF THE PAIR
S BAR3PEIN=$P($G(^BARBL(DUZ(2),BAREIN2,0)),"^",17)
S BARDUZ3P=$P($G(^BARBL(DUZ(2),BAREIN2,0)),"^",22)
I BAR3PEIN="" Q -5 ; 0 ;NO DATA
I BARDUZ3P="" Q -6 ;0 ;NO DATA
;
S BARAPP2=0 I '$D(^ABMDBILL(BARDUZ3P,BAR3PEIN,0)) S BARAPP2=1 ;OK
I BARAPP1+BARAPP2=1 D Q BARRET
. I BARAPP1=1 S BARRET=BARRET_1
. I BARAPP2=1 S BARRET=BARRET_2
Q BARRET_3 ;IF BOTH BILLS NOT FOUND IN 3PB
BARPNP2 ; IHS/SD/LSL - POSTING PATIENT LOOKUP ; 05/02/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,23**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 11/08/02 - V1.7 - NOIS CNA-1102-110028
+4 ; If when looping through ABC x-ref, there is no data for the bill,
+5 ; k the x-ref and q
+6 ;
+7 ; ********************************************************************
+8 ;
+9 ; verify Status of Bill,
+10 ; If the bill was 'CLOSED' not displayed - no 3P bill found
+11 ; If the bill was 'CANCELED' and Current bill amount is 0 not displayed - has already been worked
+12 ;** patient a/r lookup based on from/thru dos
+13 ;** called from ^BARPST
+14 ;** BARPASS = PATDFN^BEGDOS^ENDDOS
+15 ;** builds an array that includes all entries from a/r that meet the
+16 ; criteria.
+17 ;HEAT93190 DEC 2012 P.OTTIS NOHEAT MARK DUPLICATE BILLS
+18 ; *********************************************************************
+19 ;
EN(BARPASS) ;EP - pat/bills lookup
+1 NEW DIC,DIQ,DR,BARBLV,BARDT,BARPAT,BARBEG,BAREND,BARHIT,BARCNT
+2 KILL ^BARTMP($JOB)
+3 SET BARCNT=0
+4 IF (+$GET(BARPASS)=0)
QUIT 0
+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 IF '$DATA(^BARBL(DUZ(2),BARBDA))
KILL ^BARBL(DUZ(2),"ABC",BARPAT,BARDT,BARBDA)
QUIT
+20 SET DA=BARBDA
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 KILL ^BARTMP($JOB,"B",BARCNT,BARBDA)
+28 SET BARCNT=BARCNT-1
End DoDot:3
+29 IF BARBLV(16)="CLOSED"
SET BARCNT=BARCNT-1
+30 KILL BARBLV
End DoDot:2
End DoDot:1
+31 QUIT BARCNT
+32 ; *********************************************************************
+33 ;
HIT(BARPASS) ;EP - ** display a/r bills found
+1 NEW BARBDA,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
+2 SET (BARBDA,BARPG,BARSTOP)=0
+3 DO HEAD
+4 FOR
SET BARBDA=$ORDER(^BARTMP($JOB,BARBDA))
IF 'BARBDA
QUIT
Begin DoDot:1
+5 SET BARLIN=$ORDER(^BARTMP($JOB,BARBDA,""))
+6 SET BARREC=^BARTMP($JOB,BARBDA,BARLIN)
+7 SET BARBLO=$PIECE(BARREC,U,2)
IF $DATA(^BARTR(DUZ(2),"AM4",+BARBLO))
SET BARBLO="m"_BARBLO
+8 SET BARSTOP=$$CHKLINE(0)
IF BARSTOP
QUIT
+9 SET BARCMSG=" "
+10 IF $PIECE(BARREC,U,8)="3P CANCELLED"
SET BARCMSG="3P CAN"
+11 ;-------->P.OTT MARK DUPLICATE BILLS
SET BARTMP=$$DUPLBILL($PIECE(BARREC,U,2))
IF BARTMP>0
Begin DoDot:2
+12 SET BAREIN1=$PIECE(BARTMP,"^",2)
+13 SET BAREIN2=$PIECE(BARTMP,"^",3)
+14 SET BARDPTR=$PIECE(BARTMP,"^",4)
+15 IF BARDPTR=3
SET BARBLO="?"_BARBLO
QUIT
+16 ;! = ORPHANT (NO DATA IN 3PB)
IF BARBDA=BAREIN1
IF BARDPTR=1
SET BARBLO="!"_BARBLO
QUIT
+17 ;d = DUPLICATE (CORRECT ONE)
IF BARBDA=BAREIN2
IF BARDPTR=2
SET BARBLO="!"_BARBLO
QUIT
+18 IF BARBDA=BAREIN1
SET BARBLO="d"_BARBLO
QUIT
+19 IF BARBDA=BAREIN2
SET BARBLO="d"_BARBLO
QUIT
End DoDot:2
+20 ;---------------------------------------------------------< P.OTT
+21 ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
+22 SET BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBDA)
+23 IF $GET(BARTPB)'=""
SET BARSTAT=$PIECE($GET(^ABMDBILL($PIECE(BARTPB,","),$PIECE(BARTPB,",",2),0)),U,4)
+24 ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
+25 WRITE !,BARLIN
+26 WRITE ?6,$$SDT^BARDUTL($PIECE(BARREC,U,1))
+27 WRITE ?18,BARBLO
+28 ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
IF ($GET(BARSTAT)="X")
WRITE "*"
+29 WRITE ?25,BARCMSG
+30 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
+31 WRITE ?44,$EXTRACT($PIECE(BARREC,U,4),1,23)
+32 WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5),8,2)
End DoDot:1
IF BARSTOP
QUIT
+33 QUIT
+34 ; *********************************************************************
+35 ;
HEAD ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 NEW BARPTNAM
+3 IF '+$GET(BARPASS)
QUIT
+4 SET BARPG=BARPG+1
+5 SET BARPTNAM=$PIECE(^DPT(+BARPASS,0),U,1)
+6 IF $DATA(^BARTR(DUZ(2),"AM5",+BARPASS))
SET BARPTNAM="(msg) "_BARPTNAM
+7 WRITE "Claims for "_BARPTNAM_" from "_$$SDT^BARDUTL($PIECE(BARPASS,U,2))_" to "_$$SDT^BARDUTL($PIECE(BARPASS,U,3))
+8 WRITE ?(IOM-15),"Page: "_BARPG
+9 WRITE !!
+10 WRITE ?32,"Billed",?70,"Current"
+11 WRITE !
+12 WRITE "Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
+13 SET BARDSH=""
SET $PIECE(BARDSH,"-",IOM)=""
+14 WRITE !,BARDSH
+15 QUIT
+16 ; *********************************************************************
+17 ;
HIT1(BARPASS) ;EP - ** display a/r bills found
+1 NEW BARHIT,BARLIN,BARREC,BARBLO,BAREIN1,BAREIN2,BARDPTR
+2 SET (BARTPAY,BARTADJ,BARHIT,BARPG,BARSTOP)=0
+3 DO HEAD1
+4 FOR
SET BARHIT=$ORDER(^BARTMP($JOB,BARHIT))
IF 'BARHIT
QUIT
Begin DoDot:1
+5 SET BARLIN=$ORDER(^BARTMP($JOB,BARHIT,""))
+6 SET BARREC=^BARTMP($JOB,BARHIT,BARLIN)
+7 SET BARBLO=$PIECE(BARREC,U,2)
+8 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($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 !,BARLIN
+29 WRITE ?6,$$SDT^BARDUTL($PIECE(BARREC,U,1))
+30 WRITE ?18,BARBLO
+31 ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
IF ($GET(BARSTAT)="X")
WRITE "*"
+32 WRITE ?25,BARCMSG
+33 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
+34 WRITE ?44,$JUSTIFY($PIECE(BARREC,U,6),8,2)
+35 WRITE ?56,$JUSTIFY($PIECE(BARREC,U,7),8,2)
+36 WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5),8,2)
End DoDot:1
IF BARSTOP
QUIT
+37 QUIT
+38 ; *********************************************************************
+39 ;
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 WRITE !!?32,"Billed",?44,"Current",?56,"Current",?70,"Current"
+9 WRITE !,"Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Payments",?56,"Adjust.",?70,"Balance"
+10 SET BARDSH=""
+11 SET $PIECE(BARDSH,"-",IOM)=""
+12 WRITE !,BARDSH
+13 QUIT
+14 ; *********************************************************************
+15 ;
CHKLINE(BARHD) ;EP
+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 QUIT 0
DUPLBILL(BARBN) ;CHECK FOR DUPLICATE BILLS
+1 ; IF THE BILL# IS A DUPLICATE RETURNS: 1^EIN1^EIN2^PTR (PTR POINTS TO THE 'ORPHANT' EIN1 or EIN2)
+2 ;NEW BAREIN1,BAREIN2,BAR3PEIN,BARDUZ3P,BARAPP1,BARAPP2,BARRET
+3 ;0 ;NO DATA - WE DON'T CARE
SET BAREIN1=$ORDER(^BARBL(DUZ(2),"B",BARBN,""))
IF BAREIN1=""
QUIT -1
+4 ;0 ;ONLY 1 BILL - NO DUPS
SET BAREIN2=$ORDER(^BARBL(DUZ(2),"B",BARBN,BAREIN1))
IF BAREIN2=""
QUIT -2
+5 ;TAKE 1ST OF THE PAIR
+6 SET BARRET="1^"_BAREIN1_"^"_BAREIN2_"^"
+7 SET BAR3PEIN=$PIECE($GET(^BARBL(DUZ(2),BAREIN1,0)),"^",17)
+8 SET BARDUZ3P=$PIECE($GET(^BARBL(DUZ(2),BAREIN1,0)),"^",22)
+9 ;0 ;NO DATA
IF BAR3PEIN=""
QUIT -3
+10 ;0 ;NO DATA
IF BARDUZ3P=""
QUIT -4
+11 ;
+12 ;OK
SET BARAPP1=0
IF '$DATA(^ABMDBILL(BARDUZ3P,BAR3PEIN,0))
SET BARAPP1=1
+13 ;TAKE 2ND OF THE PAIR
+14 SET BAR3PEIN=$PIECE($GET(^BARBL(DUZ(2),BAREIN2,0)),"^",17)
+15 SET BARDUZ3P=$PIECE($GET(^BARBL(DUZ(2),BAREIN2,0)),"^",22)
+16 ; 0 ;NO DATA
IF BAR3PEIN=""
QUIT -5
+17 ;0 ;NO DATA
IF BARDUZ3P=""
QUIT -6
+18 ;
+19 ;OK
SET BARAPP2=0
IF '$DATA(^ABMDBILL(BARDUZ3P,BAR3PEIN,0))
SET BARAPP2=1
+20 IF BARAPP1+BARAPP2=1
Begin DoDot:1
+21 IF BARAPP1=1
SET BARRET=BARRET_1
+22 IF BARAPP2=1
SET BARRET=BARRET_2
End DoDot:1
QUIT BARRET
+23 ;IF BOTH BILLS NOT FOUND IN 3PB
QUIT BARRET_3
