- BARBAD2 ; IHS/SD/LSL - PAYMENT PATIENT SELECTION JAN 15,1997 ; 05/07/2008
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,14,19**;OCT 26, 2005
- ;
- ; ** patient a/r lookup based on from/thru dos
- ; ** called from ^BARBAD
- ; ** 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
- ;
- ; *********************************************************************
- ;
- 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
- 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"
- .;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)
- .S:'$G(BARJ) BARJ=1
- .W:$P($G(BARTR(BARLIN,BARJ)),U,5)="V" ?70,$J($P(BARREC,U,5)+$P(BARREC,U,4),8,2)
- .W:$P($G(BARTR(BARLIN,BARJ)),U,5)="S" ?70,$J($P(BARREC,U,5)-$P(BARREC,U,4),8,2)
- .W:'$D(BARTR(BARLIN,BARJ)) ?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
- 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"
- .;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)
- .S:'$G(BARJ) BARJ=1
- .S:(($G(BARJ)>1)&'$G(BARTR(BARLIN,$G(BARJ)))) BARJ=1
- .I $D(BARTR(BARLIN,BARJ)) D
- . . W ?60,$J($P($G(BARTR(BARLIN,BARJ)),U,2),8,2)
- . . W:$P($G(BARTR(BARLIN,BARJ)),U,5)="V" ?71,$J($P($G(BARTR(BARLIN,BARJ)),U,6)+$P($G(BARTR(BARLIN,BARJ)),U,2),8,2)
- . . W:$P($G(BARTR(BARLIN,BARJ)),U,5)="S" ?71,$J($P($G(BARTR(BARLIN,BARJ)),U,6)-$P($G(BARTR(BARLIN,BARJ)),U,2),8,2)
- . . W:'$D(BARTR(BARLIN,BARJ)) ?71,$J($P($G(BARTR(BARLIN,BARJ)),U,6),8,2)
- .W:'$D(BARTR(BARLIN,BARJ)) ?60,"0.00"
- .W:'$D(BARTR(BARLIN,BARJ)) ?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^BARBAD2(.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
- BARBAD2 ; IHS/SD/LSL - PAYMENT PATIENT SELECTION JAN 15,1997 ; 05/07/2008
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,14,19**;OCT 26, 2005
- +2 ;
- +3 ; ** patient a/r lookup based on from/thru dos
- +4 ; ** called from ^BARBAD
- +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 ;
- +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
- +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 ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
- +15 SET BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARBDA)
- +16 IF $GET(BARTPB)'=""
- SET BARSTAT=$PIECE($GET(^ABMDBILL($PIECE(BARTPB,","),$PIECE(BARTPB,",",2),0)),U,4)
- +17 ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
- +18 WRITE !,$JUSTIFY(BARLIN,3)
- +19 WRITE ?6,$$SDT^BARDUTL($PIECE(BARREC,U,1))
- +20 ;W ?18,BARBLO,?25,BARCMSG ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
- +21 ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
- WRITE ?18,BARBLO_$SELECT($GET(BARSTAT)="X":"*",1:""),?25,BARCMSG
- +22 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
- +23 WRITE ?44,$EXTRACT($PIECE(BARREC,U,4),1,23)
- +24 ;W ?70,$J($P(BARREC,U,5),8,2)
- +25 IF '$GET(BARJ)
- SET BARJ=1
- +26 IF $PIECE($GET(BARTR(BARLIN,BARJ)),U,5)="V"
- WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5)+$PIECE(BARREC,U,4),8,2)
- +27 IF $PIECE($GET(BARTR(BARLIN,BARJ)),U,5)="S"
- WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5)-$PIECE(BARREC,U,4),8,2)
- +28 IF '$DATA(BARTR(BARLIN,BARJ))
- WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5),8,2)
- End DoDot:1
- IF BARSTOP
- QUIT
- +29 ;
- 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
- +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 ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
- +15 SET BARTPB=$$FIND3PB^BARUTL(DUZ(2),BARHIT)
- +16 IF $GET(BARTPB)'=""
- SET BARSTAT=$PIECE($GET(^ABMDBILL($PIECE(BARTPB,","),$PIECE(BARTPB,",",2),0)),U,4)
- +17 ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
- +18 WRITE !,$JUSTIFY(BARLIN,3),?6,$$SDT^BARDUTL($PIECE(BARREC,U,1)),?18,BARBLO
- +19 ;IHS/SD/SDR bar*1.8*4 DD item 4.1.7.1
- IF ($GET(BARSTAT)="X")
- WRITE "*"
- +20 WRITE ?25,BARCMSG
- +21 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
- +22 WRITE ?49,$JUSTIFY($PIECE(BARREC,U,6),8,2)
- +23 IF '$GET(BARJ)
- SET BARJ=1
- +24 IF (($GET(BARJ)>1)&'$GET(BARTR(BARLIN,$GET(BARJ))))
- SET BARJ=1
- +25 IF $DATA(BARTR(BARLIN,BARJ))
- Begin DoDot:2
- +26 WRITE ?60,$JUSTIFY($PIECE($GET(BARTR(BARLIN,BARJ)),U,2),8,2)
- +27 IF $PIECE($GET(BARTR(BARLIN,BARJ)),U,5)="V"
- WRITE ?71,$JUSTIFY($PIECE($GET(BARTR(BARLIN,BARJ)),U,6)+$PIECE($GET(BARTR(BARLIN,BARJ)),U,2),8,2)
- +28 IF $PIECE($GET(BARTR(BARLIN,BARJ)),U,5)="S"
- WRITE ?71,$JUSTIFY($PIECE($GET(BARTR(BARLIN,BARJ)),U,6)-$PIECE($GET(BARTR(BARLIN,BARJ)),U,2),8,2)
- +29 IF '$DATA(BARTR(BARLIN,BARJ))
- WRITE ?71,$JUSTIFY($PIECE($GET(BARTR(BARLIN,BARJ)),U,6),8,2)
- End DoDot:2
- +30 IF '$DATA(BARTR(BARLIN,BARJ))
- WRITE ?60,"0.00"
- +31 IF '$DATA(BARTR(BARLIN,BARJ))
- WRITE ?71,$JUSTIFY($PIECE(BARREC,U,5),8,2)
- End DoDot:1
- IF BARSTOP
- QUIT
- +32 QUIT
- +33 ; *********************************************************************
- +34 ;
- 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^BARBAD2(.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
