BARRPPS ; IHS/SD/SDR - Patient Payment Summary ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92
;IHS/SD/SDR 1.8*28 CR9580 HEAT303780 Routine created
Q
; ***************************************
EN ;EP
K ^TMP($J,"BAR-PPS"),BAREND
D ACCTS ;select A/R Account
D:'$D(BAREND) DT ;select A/R Collection Batch date range
D:'$D(BAREND) COMMENTS ;Y/N if commments from item should print on report or not
G:$D(BAREND) CLEANUP
SEL ;Select device
S %ZIS="Q"
S %ZIS("A")="Enter DEVICE: "
D ^%ZIS Q:POP
I IO'=IO(0) D QUE,HOME^%ZIS S DIR(0)="E" D ^DIR K DIR Q
S IOP=ION D ^%ZIS
D PRINT
Q
QUE ;EP
K IO("Q")
S ZTRTN="PRINT^BARRPPS",ZTDESC="Patient Payment Summary"
S ZTSAVE("BAR*")=""
D ^%ZTLOAD
D ^%ZISC
I $D(ZTSK)[0 W !!?5,"REPORT CANCELLED!"
E W !!?5,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!
Q
ACCTS ;EP
; Select A/R Accounts to sort by
K BARY("ACCT")
D ^XBFMK
S DIC="^BARAC(DUZ(2),"
S DIC(0)="AEMQ"
S DIC("S")="I $P(^BARAC(DUZ(2),Y,0),U)[""AUPNPAT"""
S DIC("A")="Select A/R Account: "
F D Q:+Y<0
.I $D(BARY("ACCT")) S DIC("A")="Select Another A/R Account: "
.D ^DIC
.I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAREND=1 Q
.Q:+Y<0
.S BARY("ACCT",+Y)=""
I '$D(BARY("ACCT")),('$D(BAREND)) W !!,"At least one A/R account is required. Enter '^' to exit",! K DIC G ACCTS ;IHS/DIT/CPC - 20170427 CR9580 BAR*1.8*28
K DIC
Q
DT ;EP
D ^XBFMK
W !!," ============ Entry of A/R Collection Batch Range =============",!
S DIR("A")="Enter A/R Collection Batch STARTING DATE for the Report"
S DIR(0)="DOE"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAREND=1 Q
G DT:$D(DIRUT)
S BARY("DT",1)=Y
W !
S DIR("A")="Enter ENDING DATE for the Report"
S DIR(0)="DOE"
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAREND=1 Q
G DT:$D(DIRUT)
S BARY("DT",2)=Y
I BARY("DT",1)>BARY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than the End Date, TRY AGAIN!",!! G DT
Q
D ^XBFMK
W !
S DIR("A")="Print Collection Batch Comments (if Present)"
S DIR("B")="No"
S DIR(0)="Y"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAREND=1 Q
S BARY("COMM",1)=Y
K DIR
Q
;
PRINT ; EP
;Gather data for each patient and print summary
S BARACCTI=0
F S BARACCTI=$O(BARY("ACCT",BARACCTI)) Q:'BARACCTI D
.K ^TMP($J,"BAR-PPS")
.S BAR("PG")=1
.D GATHER ;gather data
.D CALC ;goes through found data and creates totals
.D SUMMARY ;print summary
Q
; ***************************************
GATHER ;EP
S BARSDT=BARY("DT",1)-.1
S BAREDT=BARY("DT",2)+.999999
F S BARSDT=$O(^BARCOL(DUZ(2),"C",BARSDT)) Q:'BARSDT!(BARSDT>BAREDT) D
.S BARCOL=0
.F S BARCOL=$O(^BARCOL(DUZ(2),"C",BARSDT,BARCOL)) Q:'BARCOL D
..S BARITEM=0
..F S BARITEM=$O(^BARCOL(DUZ(2),BARCOL,1,BARITEM)) Q:'BARITEM D
...I $P($G(^BARCOL(DUZ(2),BARCOL,1,BARITEM,0)),U,7)'=BARACCTI Q ;not our A/R Account
...S BARPTYP=$$GET1^DIQ(90052.02,$P($G(^BARCOL(DUZ(2),BARCOL,1,BARITEM,0)),U,2),6)
...I "^CA^CC^CK^GL^"'[("^"_BARPTYP_"^") Q ;only want Cash, Credit Card, Check, and General Ledger
...S BARCCRDT=$P($G(^BARCOL(DUZ(2),BARCOL,1,BARITEM,1)),U)
...S BARCDBT=$P($G(^BARCOL(DUZ(2),BARCOL,1,BARITEM,1)),U,2)
...S BARRCPT=$$GET1^DIQ(90050.06,$P($G(^BARCOL(DUZ(2),BARCOL,1,BARITEM,0)),U,23),".01")
...S ^TMP($J,"BAR-PPS",BARSDT,BARCOL,BARITEM)=BARPTYP_U_(BARCCRDT-BARCDBT)_U_BARRCPT
Q
CALC ;EP
Q:'$D(^TMP($J,"BAR-PPS")) ;no data found for A/R Account
S BARPCNT=0
S BARSDT=0
F S BARSDT=$O(^TMP($J,"BAR-PPS",BARSDT)) Q:'BARSDT D
.S BARCOL=0
.F S BARCOL=$O(^TMP($J,"BAR-PPS",BARSDT,BARCOL)) Q:'BARCOL D
..S BARITEM=0
..F S BARITEM=$O(^TMP($J,"BAR-PPS",BARSDT,BARCOL,BARITEM)) Q:'BARITEM D
...S $P(^TMP($J,"BAR-PPS","TOT"),U)=+$P(+$G(^TMP($J,"BAR-PPS","TOT")),U)+$P($G(^TMP($J,"BAR-PPS",BARSDT,BARCOL,BARITEM)),U,2) ;total amount batched
...;look through transactions for payments posted; this is posted amount
...S BARTRANS=0
...F S BARTRANS=$O(^BARTR(DUZ(2),"ACB",BARCOL,BARITEM,40,BARTRANS)) Q:'BARTRANS D
....S $P(^TMP($J,"BAR-PPS","TOT"),U,2)=(+$P($G(^TMP($J,"BAR-PPS","TOT")),U,2)+($$GET1^DIQ(90050.03,BARTRANS,"3.5"))) ;total amount posted
....S BARPCNT=+$G(BARPCNT)+1
S $P(^TMP($J,"BAR-PPS","TOT"),U,3)=(($P($G(^TMP($J,"BAR-PPS","TOT")),U))-($P($G(^TMP($J,"BAR-PPS","TOT")),U,2))) ;total to be posted
S $P(^TMP($J,"BAR-PPS","TOT"),U,4)=+BARPCNT ;Payment Count
Q
; ***************************************
;
SUMMARY ;
; Print report if user selected SORT CRITERIA Billing Entity or
; Allowance Category and Report Type w/o payers
;
S BAR("PG")=0
D HDB ; Page and column header
I '$D(^TMP($J,"BAR-PPS")) D Q ; No data - quit
.W !!!!!?25,"*** NO DATA TO PRINT ***"
.D EOP^BARUTL(0)
S BARSDT=0
F S BARSDT=$O(^TMP($J,"BAR-PPS",BARSDT)) Q:'BARSDT D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S BARCLIEN=0
.F S BARCLIEN=$O(^TMP($J,"BAR-PPS",BARSDT,BARCLIEN)) Q:'BARCLIEN D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
..S BARITEM=0
..F S BARITEM=$O(^TMP($J,"BAR-PPS",BARSDT,BARCLIEN,BARITEM)) Q:'BARITEM D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
...I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
...W !,$E($P($G(^BARCOL(DUZ(2),BARCLIEN,0)),U),1,26) ;COLLECTION BATCH
...W ?27,BARITEM ;COLLECTION BATCH ITEM #
...W ?30,$P($G(^TMP($J,"BAR-PPS",BARSDT,BARCLIEN,BARITEM)),U,3) ;RECEIPT #
...W ?43,$P($G(^TMP($J,"BAR-PPS",BARSDT,BARCLIEN,BARITEM)),U) ;TYPE OF PAYMENT
...W ?49,$J($FN($P($G(^TMP($J,"BAR-PPS",BARSDT,BARCLIEN,BARITEM)),U,2),",",2),8) ;BATCH ITEM AMOUNT
...D WRTBILL
...I +$G(BARY("COMM",1))=1 D WRTCOMM
W !,?47,"__________",?68,"__________" ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
W !,?45,$J($FN(+$P($G(^TMP($J,"BAR-PPS","TOT")),U),",",2),12),?66,$J($FN(+$P($G(^TMP($J,"BAR-PPS","TOT")),U,2),",",2),12),! ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
W !!,"REPORT COMPLETE FOR "_$$GET1^DIQ(90050.02,BARACCTI,".01","E")
D EOP^BARUTL(0)
Q
WRTBILL ;EP
S BARTRANS=0,BARHASTR=0
F S BARTRANS=$O(^BARTR(DUZ(2),"ACB",BARCLIEN,BARITEM,40,BARTRANS)) Q:'BARTRANS D
.W ?58,$E($$GET1^DIQ(90050.01,$P($G(^BARTR(DUZ(2),BARTRANS,0)),U,4),".01","E"),1,10) ;BILL NUMBER ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
.W ?70,$J($FN($$GET1^DIQ(90050.03,BARTRANS,"3.5","E"),",",2),8),! ;AMOUNT POSTED TO BILL ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
.S BARHASTR=1
Q
WRTCOMM ;EP
I BARHASTR=0 W ! ;make sure comment starts on separate line
K BARCOM
S IENS=BARITEM_","_BARCLIEN_","
D GETS^DIQ(90051.1101,IENS,"301","","BARCOM")
I $G(BARCOM(90051.1101,IENS,301,1))="" Q ;quit if no comment on item
W ?2,"Comment: "
S BARCNT=0
F S BARCNT=$O(BARCOM(90051.1101,IENS,301,BARCNT)) Q:'BARCNT D
.W !?4,$G(BARCOM(90051.1101,IENS,301,BARCNT))
Q
; ***************************************
HD ; EP
D PAZ^BARRUTL
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q
; ***************************************
;
HDB ; EP
;Page and column header
S BAR("PG")=BAR("PG")+1
S BAR("I")=""
W $$EN^BARVDF("IOF"),!
D CENTER("Patient Payment Summary")
W !
D CENTER($P($G(^DIC(4,DUZ(2),0)),U))
W !
D NOW^%DTC
S Y=%
X ^DD("DD")
W $P(Y,":",1,2),?72,"Page ",BAR("PG")
S $P(BAR("DASH"),"-",$S($D(BAR(132)):132,1:80))=""
W !,BAR("DASH"),!
;
W ?3,"Patient Name: ",$$GET1^DIQ(90050.02,BARACCTI,".01","E")
W ?50,"HRN: ",$P($G(^AUPNPAT($P($$GET1^DIQ(90050.02,BARACCTI,".01","I"),";"),41,DUZ(2),0)),U,2),!!
W "Total Amount Batched: ",$J($FN(+$P($G(^TMP($J,"BAR-PPS","TOT")),U),",",2),12)
W ?50,"Num of Pymts Posted: ",+$P($G(^TMP($J,"BAR-PPS","TOT")),U,4),!
W ?7,"Amount Posted: ",$J($FN(+$P($G(^TMP($J,"BAR-PPS","TOT")),U,2),",",2),12),!
W ?8,"To Be Posted: ",$J($FN(+$P($G(^TMP($J,"BAR-PPS","TOT")),U,3),",",2),12),!
W BAR("DASH"),!
W ?50,"Batched",?60,"Bill",?72,"Posted",! ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
W "Collection Batch",?25,"Item",?30,"Receipt#",?42,"Type",?51,"Amount",?60,"Number",?72,"Amount",! ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
W BAR("DASH"),!
Q
CENTER(X) ;EP
;S CENTER=IOM/2 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
S CENTER=$S($D(BAR(132)):132,1:80)/2 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
W ?CENTER-($L(X)/2),X
Q
CLEANUP ;CLEAN VARIABLES
K BAREND,DIC,DIR
Q
;EOR - IHS/DIT/CPC 1.8*28
BARRPPS ; IHS/SD/SDR - Patient Payment Summary ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92
+2 ;IHS/SD/SDR 1.8*28 CR9580 HEAT303780 Routine created
+3 QUIT
+4 ; ***************************************
EN ;EP
+1 KILL ^TMP($JOB,"BAR-PPS"),BAREND
+2 ;select A/R Account
DO ACCTS
+3 ;select A/R Collection Batch date range
IF '$DATA(BAREND)
DO DT
+4 ;Y/N if commments from item should print on report or not
IF '$DATA(BAREND)
DO COMMENTS
+5 IF $DATA(BAREND)
GOTO CLEANUP
SEL ;Select device
+1 SET %ZIS="Q"
+2 SET %ZIS("A")="Enter DEVICE: "
+3 DO ^%ZIS
IF POP
QUIT
+4 IF IO'=IO(0)
DO QUE
DO HOME^%ZIS
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+5 SET IOP=ION
DO ^%ZIS
+6 DO PRINT
+7 QUIT
QUE ;EP
+1 KILL IO("Q")
+2 SET ZTRTN="PRINT^BARRPPS"
SET ZTDESC="Patient Payment Summary"
+3 SET ZTSAVE("BAR*")=""
+4 DO ^%ZTLOAD
+5 DO ^%ZISC
+6 IF $DATA(ZTSK)[0
WRITE !!?5,"REPORT CANCELLED!"
+7 IF '$TEST
WRITE !!?5,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!
+8 QUIT
ACCTS ;EP
+1 ; Select A/R Accounts to sort by
+2 KILL BARY("ACCT")
+3 DO ^XBFMK
+4 SET DIC="^BARAC(DUZ(2),"
+5 SET DIC(0)="AEMQ"
+6 SET DIC("S")="I $P(^BARAC(DUZ(2),Y,0),U)[""AUPNPAT"""
+7 SET DIC("A")="Select A/R Account: "
+8 FOR
Begin DoDot:1
+9 IF $DATA(BARY("ACCT"))
SET DIC("A")="Select Another A/R Account: "
+10 DO ^DIC
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAREND=1
QUIT
+12 IF +Y<0
QUIT
+13 SET BARY("ACCT",+Y)=""
End DoDot:1
IF +Y<0
QUIT
+14 ;IHS/DIT/CPC - 20170427 CR9580 BAR*1.8*28
IF '$DATA(BARY("ACCT"))
IF ('$DATA(BAREND))
WRITE !!,"At least one A/R account is required. Enter '^' to exit",!
KILL DIC
GOTO ACCTS
+15 KILL DIC
+16 QUIT
DT ;EP
+1 DO ^XBFMK
+2 WRITE !!," ============ Entry of A/R Collection Batch Range =============",!
+3 SET DIR("A")="Enter A/R Collection Batch STARTING DATE for the Report"
+4 SET DIR(0)="DOE"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAREND=1
QUIT
+7 IF $DATA(DIRUT)
GOTO DT
+8 SET BARY("DT",1)=Y
+9 WRITE !
+10 SET DIR("A")="Enter ENDING DATE for the Report"
+11 SET DIR(0)="DOE"
+12 DO ^DIR
+13 KILL DIR
+14 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAREND=1
QUIT
+15 IF $DATA(DIRUT)
GOTO DT
+16 SET BARY("DT",2)=Y
+17 IF BARY("DT",1)>BARY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than the End Date, TRY AGAIN!",!!
GOTO DT
+18 QUIT
+1 DO ^XBFMK
+2 WRITE !
+3 SET DIR("A")="Print Collection Batch Comments (if Present)"
+4 SET DIR("B")="No"
+5 SET DIR(0)="Y"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAREND=1
QUIT
+8 SET BARY("COMM",1)=Y
+9 KILL DIR
+10 QUIT
+11 ;
PRINT ; EP
+1 ;Gather data for each patient and print summary
+2 SET BARACCTI=0
+3 FOR
SET BARACCTI=$ORDER(BARY("ACCT",BARACCTI))
IF 'BARACCTI
QUIT
Begin DoDot:1
+4 KILL ^TMP($JOB,"BAR-PPS")
+5 SET BAR("PG")=1
+6 ;gather data
DO GATHER
+7 ;goes through found data and creates totals
DO CALC
+8 ;print summary
DO SUMMARY
End DoDot:1
+9 QUIT
+10 ; ***************************************
GATHER ;EP
+1 SET BARSDT=BARY("DT",1)-.1
+2 SET BAREDT=BARY("DT",2)+.999999
+3 FOR
SET BARSDT=$ORDER(^BARCOL(DUZ(2),"C",BARSDT))
IF 'BARSDT!(BARSDT>BAREDT)
QUIT
Begin DoDot:1
+4 SET BARCOL=0
+5 FOR
SET BARCOL=$ORDER(^BARCOL(DUZ(2),"C",BARSDT,BARCOL))
IF 'BARCOL
QUIT
Begin DoDot:2
+6 SET BARITEM=0
+7 FOR
SET BARITEM=$ORDER(^BARCOL(DUZ(2),BARCOL,1,BARITEM))
IF 'BARITEM
QUIT
Begin DoDot:3
+8 ;not our A/R Account
IF $PIECE($GET(^BARCOL(DUZ(2),BARCOL,1,BARITEM,0)),U,7)'=BARACCTI
QUIT
+9 SET BARPTYP=$$GET1^DIQ(90052.02,$PIECE($GET(^BARCOL(DUZ(2),BARCOL,1,BARITEM,0)),U,2),6)
+10 ;only want Cash, Credit Card, Check, and General Ledger
IF "^CA^CC^CK^GL^"'[("^"_BARPTYP_"^")
QUIT
+11 SET BARCCRDT=$PIECE($GET(^BARCOL(DUZ(2),BARCOL,1,BARITEM,1)),U)
+12 SET BARCDBT=$PIECE($GET(^BARCOL(DUZ(2),BARCOL,1,BARITEM,1)),U,2)
+13 SET BARRCPT=$$GET1^DIQ(90050.06,$PIECE($GET(^BARCOL(DUZ(2),BARCOL,1,BARITEM,0)),U,23),".01")
+14 SET ^TMP($JOB,"BAR-PPS",BARSDT,BARCOL,BARITEM)=BARPTYP_U_(BARCCRDT-BARCDBT)_U_BARRCPT
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
CALC ;EP
+1 ;no data found for A/R Account
IF '$DATA(^TMP($JOB,"BAR-PPS"))
QUIT
+2 SET BARPCNT=0
+3 SET BARSDT=0
+4 FOR
SET BARSDT=$ORDER(^TMP($JOB,"BAR-PPS",BARSDT))
IF 'BARSDT
QUIT
Begin DoDot:1
+5 SET BARCOL=0
+6 FOR
SET BARCOL=$ORDER(^TMP($JOB,"BAR-PPS",BARSDT,BARCOL))
IF 'BARCOL
QUIT
Begin DoDot:2
+7 SET BARITEM=0
+8 FOR
SET BARITEM=$ORDER(^TMP($JOB,"BAR-PPS",BARSDT,BARCOL,BARITEM))
IF 'BARITEM
QUIT
Begin DoDot:3
+9 ;total amount batched
SET $PIECE(^TMP($JOB,"BAR-PPS","TOT"),U)=+$PIECE(+$GET(^TMP($JOB,"BAR-PPS","TOT")),U)+$PIECE($GET(^TMP($JOB,"BAR-PPS",BARSDT,BARCOL,BARITEM)),U,2)
+10 ;look through transactions for payments posted; this is posted amount
+11 SET BARTRANS=0
+12 FOR
SET BARTRANS=$ORDER(^BARTR(DUZ(2),"ACB",BARCOL,BARITEM,40,BARTRANS))
IF 'BARTRANS
QUIT
Begin DoDot:4
+13 ;total amount posted
SET $PIECE(^TMP($JOB,"BAR-PPS","TOT"),U,2)=(+$PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U,2)+($$GET1^DIQ(90050.03,BARTRANS,"3.5")))
+14 SET BARPCNT=+$GET(BARPCNT)+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;total to be posted
SET $PIECE(^TMP($JOB,"BAR-PPS","TOT"),U,3)=(($PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U))-($PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U,2)))
+16 ;Payment Count
SET $PIECE(^TMP($JOB,"BAR-PPS","TOT"),U,4)=+BARPCNT
+17 QUIT
+18 ; ***************************************
+19 ;
SUMMARY ;
+1 ; Print report if user selected SORT CRITERIA Billing Entity or
+2 ; Allowance Category and Report Type w/o payers
+3 ;
+4 SET BAR("PG")=0
+5 ; Page and column header
DO HDB
+6 ; No data - quit
IF '$DATA(^TMP($JOB,"BAR-PPS"))
Begin DoDot:1
+7 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+8 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+9 SET BARSDT=0
+10 FOR
SET BARSDT=$ORDER(^TMP($JOB,"BAR-PPS",BARSDT))
IF 'BARSDT
QUIT
Begin DoDot:1
+11 SET BARCLIEN=0
+12 FOR
SET BARCLIEN=$ORDER(^TMP($JOB,"BAR-PPS",BARSDT,BARCLIEN))
IF 'BARCLIEN
QUIT
Begin DoDot:2
+13 SET BARITEM=0
+14 FOR
SET BARITEM=$ORDER(^TMP($JOB,"BAR-PPS",BARSDT,BARCLIEN,BARITEM))
IF 'BARITEM
QUIT
Begin DoDot:3
+15 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+16 ;COLLECTION BATCH
WRITE !,$EXTRACT($PIECE($GET(^BARCOL(DUZ(2),BARCLIEN,0)),U),1,26)
+17 ;COLLECTION BATCH ITEM #
WRITE ?27,BARITEM
+18 ;RECEIPT #
WRITE ?30,$PIECE($GET(^TMP($JOB,"BAR-PPS",BARSDT,BARCLIEN,BARITEM)),U,3)
+19 ;TYPE OF PAYMENT
WRITE ?43,$PIECE($GET(^TMP($JOB,"BAR-PPS",BARSDT,BARCLIEN,BARITEM)),U)
+20 ;BATCH ITEM AMOUNT
WRITE ?49,$JUSTIFY($FNUMBER($PIECE($GET(^TMP($JOB,"BAR-PPS",BARSDT,BARCLIEN,BARITEM)),U,2),",",2),8)
+21 DO WRTBILL
+22 IF +$GET(BARY("COMM",1))=1
DO WRTCOMM
End DoDot:3
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
End DoDot:2
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+23 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
WRITE !,?47,"__________",?68,"__________"
+24 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
WRITE !,?45,$JUSTIFY($FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U),",",2),12),?66,$JUSTIFY($FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U,2),",",2),12),!
+25 WRITE !!,"REPORT COMPLETE FOR "_$$GET1^DIQ(90050.02,BARACCTI,".01","E")
+26 DO EOP^BARUTL(0)
+27 QUIT
WRTBILL ;EP
+1 SET BARTRANS=0
SET BARHASTR=0
+2 FOR
SET BARTRANS=$ORDER(^BARTR(DUZ(2),"ACB",BARCLIEN,BARITEM,40,BARTRANS))
IF 'BARTRANS
QUIT
Begin DoDot:1
+3 ;BILL NUMBER ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
WRITE ?58,$EXTRACT($$GET1^DIQ(90050.01,$PIECE($GET(^BARTR(DUZ(2),BARTRANS,0)),U,4),".01","E"),1,10)
+4 ;AMOUNT POSTED TO BILL ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
WRITE ?70,$JUSTIFY($FNUMBER($$GET1^DIQ(90050.03,BARTRANS,"3.5","E"),",",2),8),!
+5 SET BARHASTR=1
End DoDot:1
+6 QUIT
WRTCOMM ;EP
+1 ;make sure comment starts on separate line
IF BARHASTR=0
WRITE !
+2 KILL BARCOM
+3 SET IENS=BARITEM_","_BARCLIEN_","
+4 DO GETS^DIQ(90051.1101,IENS,"301","","BARCOM")
+5 ;quit if no comment on item
IF $GET(BARCOM(90051.1101,IENS,301,1))=""
QUIT
+6 WRITE ?2,"Comment: "
+7 SET BARCNT=0
+8 FOR
SET BARCNT=$ORDER(BARCOM(90051.1101,IENS,301,BARCNT))
IF 'BARCNT
QUIT
Begin DoDot:1
+9 WRITE !?4,$GET(BARCOM(90051.1101,IENS,301,BARCNT))
End DoDot:1
+10 QUIT
+11 ; ***************************************
HD ; EP
+1 DO PAZ^BARRUTL
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
QUIT
+3 ; ***************************************
+4 ;
HDB ; EP
+1 ;Page and column header
+2 SET BAR("PG")=BAR("PG")+1
+3 SET BAR("I")=""
+4 WRITE $$EN^BARVDF("IOF"),!
+5 DO CENTER("Patient Payment Summary")
+6 WRITE !
+7 DO CENTER($PIECE($GET(^DIC(4,DUZ(2),0)),U))
+8 WRITE !
+9 DO NOW^%DTC
+10 SET Y=%
+11 XECUTE ^DD("DD")
+12 WRITE $PIECE(Y,":",1,2),?72,"Page ",BAR("PG")
+13 SET $PIECE(BAR("DASH"),"-",$SELECT($DATA(BAR(132)):132,1:80))=""
+14 WRITE !,BAR("DASH"),!
+15 ;
+16 WRITE ?3,"Patient Name: ",$$GET1^DIQ(90050.02,BARACCTI,".01","E")
+17 WRITE ?50,"HRN: ",$PIECE($GET(^AUPNPAT($PIECE($$GET1^DIQ(90050.02,BARACCTI,".01","I"),";"),41,DUZ(2),0)),U,2),!!
+18 WRITE "Total Amount Batched: ",$JUSTIFY($FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U),",",2),12)
+19 WRITE ?50,"Num of Pymts Posted: ",+$PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U,4),!
+20 WRITE ?7,"Amount Posted: ",$JUSTIFY($FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U,2),",",2),12),!
+21 WRITE ?8,"To Be Posted: ",$JUSTIFY($FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PPS","TOT")),U,3),",",2),12),!
+22 WRITE BAR("DASH"),!
+23 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
WRITE ?50,"Batched",?60,"Bill",?72,"Posted",!
+24 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
WRITE "Collection Batch",?25,"Item",?30,"Receipt#",?42,"Type",?51,"Amount",?60,"Number",?72,"Amount",!
+25 WRITE BAR("DASH"),!
+26 QUIT
CENTER(X) ;EP
+1 ;S CENTER=IOM/2 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
+2 ;IHS/DIT/CPC - 20180427 CR9580 BAR*1.8*28
SET CENTER=$SELECT($DATA(BAR(132)):132,1:80)/2
+3 WRITE ?CENTER-($LENGTH(X)/2),X
+4 QUIT
CLEANUP ;CLEAN VARIABLES
+1 KILL BAREND,DIC,DIR
+2 QUIT
+3 ;EOR - IHS/DIT/CPC 1.8*28
