BARPBEN2 ; IHS/SD/LSL - PRINT FROM AUTO POSTING ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; IHS/SD/LSL - 04/29/03 - V1.8
; Tweaked code for AR national release. Thanks to California Area
; for original code (AZLKAP02 - 07/10/2000)
;
Q
; ********************************************************************
;
PRINT ; EP
; PRINT
K DUOUT,DROUT,DTOUT,DIROUT
D SETHDR
I BARSBY="P" D PAT
I BARSBY="B" D BILL
D EXIT
Q
; ********************************************************************
;
SETHDR ;
; Set header Array
S BAR("HD",0)=""
S BAR("TXT")="Auto Post Beneficiary"
S BAR("LVL")=0
S BAR("CONJ")=""
D CHK^BARRHD ; Line 1 of Report header
S BAR("LVL")=BAR("LVL")+1
S BAR("HD",BAR("LVL"))=""
S BAR("TXT")="AR Account: "_BARACNM
S BAR("CONJ")="For "
D CHK^BARRHD ; Line 2 of Report header
S BAR("LVL")=BAR("LVL")+1
S BAR("HD",BAR("LVL"))=""
S BAR("TXT")=$S(BARSBY="B":"Bill",1:"Patient")
S BAR("CONJ")="By "
D CHK^BARRHD ; Line 2 of Report header
S BAR("PG")=0
S BAREQUAL="W !?64,""=============="""
Q
; ********************************************************************
;
PAT ; EP
; sort/print by Patient
S BAR("COL")="W !?3,""PATIENT"",?29,""BILL"",?51,""DOS"",?72,""AMOUNT"""
D HDB^BARRPSRB
I '+BARCNT D Q ; No data - quit
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
;
S BARPATNM=0
F S BARPATNM=$O(^XTMP("BAR-BEN",$J,BARPATNM)) Q:BARPATNM="" D PATBIL Q:$G(BAR("F1"))
D TOTAL
Q
; ********************************************************************
;
PATBIL ;
S BARBILL=""
F S BARBILL=$O(^XTMP("BAR-BEN",$J,BARPATNM,BARBILL)) Q:BARBILL="" D PATPRT Q:$G(BAR("F1"))
Q
; ********************************************************************
;
PATPRT ; EP
; Print one line Patient Summary
S BARHOLD=$G(^XTMP("BAR-BEN",$J,BARPATNM,BARBILL))
I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
W !,$E(BARPATNM,1,25) ; Patient Name
W ?29,$E(BARBILL,1,18) ; Bill Number
W ?51,$P(BARHOLD,U,2) ; DOS
W ?69,$J($P(BARHOLD,U),9,2) ; Write off Amount
Q
; ********************************************************************
; ********************************************************************
;
BILL ;EP
; sort/print by Bill
S BAR("COL")="W !?3,""BILL"",?22,""PATIENT"",?51,""DOS"",?72,""AMOUNT"""
D HDB^BARRPSRB
I '+BARCNT D Q ; No data - quit
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
;
S BARBILL=0
F S BARBILL=$O(^XTMP("BAR-BEN",$J,BARBILL)) Q:BARBILL="" D BILLPRT Q:$G(BAR("F1"))
D TOTAL
Q
; ********************************************************************
;
BILLPRT ; EP
; Print one line Bill summary
S BARHOLD=$G(^XTMP("BAR-BEN",$J,BARBILL))
I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
W !,$E(BARBILL,1,18) ; Bill Name
W ?22,$E($P(BARHOLD,U,3),1,25) ; Patient Name
W ?51,$P(BARHOLD,U,2) ; DOS
W ?69,$J($P(BARHOLD,U),9,2) ; Write off amount
Q
; ********************************************************************
;
TOTAL ;
; Write report totals
X BAREQUAL
W !,?10,"TOTAL BILLS: ",BARCNT
W ?40,"TOTAL AMOUNT",?64,$J(BARTOT,14,2)
Q
; ********************************************************************
;
EXIT ; EP
; clear variables
K ^XTMP("BAR-BEN",$J)
Q
BARPBEN2 ; IHS/SD/LSL - PRINT FROM AUTO POSTING ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 04/29/03 - V1.8
+4 ; Tweaked code for AR national release. Thanks to California Area
+5 ; for original code (AZLKAP02 - 07/10/2000)
+6 ;
+7 QUIT
+8 ; ********************************************************************
+9 ;
PRINT ; EP
+1 ; PRINT
+2 KILL DUOUT,DROUT,DTOUT,DIROUT
+3 DO SETHDR
+4 IF BARSBY="P"
DO PAT
+5 IF BARSBY="B"
DO BILL
+6 DO EXIT
+7 QUIT
+8 ; ********************************************************************
+9 ;
SETHDR ;
+1 ; Set header Array
+2 SET BAR("HD",0)=""
+3 SET BAR("TXT")="Auto Post Beneficiary"
+4 SET BAR("LVL")=0
+5 SET BAR("CONJ")=""
+6 ; Line 1 of Report header
DO CHK^BARRHD
+7 SET BAR("LVL")=BAR("LVL")+1
+8 SET BAR("HD",BAR("LVL"))=""
+9 SET BAR("TXT")="AR Account: "_BARACNM
+10 SET BAR("CONJ")="For "
+11 ; Line 2 of Report header
DO CHK^BARRHD
+12 SET BAR("LVL")=BAR("LVL")+1
+13 SET BAR("HD",BAR("LVL"))=""
+14 SET BAR("TXT")=$SELECT(BARSBY="B":"Bill",1:"Patient")
+15 SET BAR("CONJ")="By "
+16 ; Line 2 of Report header
DO CHK^BARRHD
+17 SET BAR("PG")=0
+18 SET BAREQUAL="W !?64,""=============="""
+19 QUIT
+20 ; ********************************************************************
+21 ;
PAT ; EP
+1 ; sort/print by Patient
+2 SET BAR("COL")="W !?3,""PATIENT"",?29,""BILL"",?51,""DOS"",?72,""AMOUNT"""
+3 DO HDB^BARRPSRB
+4 ; No data - quit
IF '+BARCNT
Begin DoDot:1
+5 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+6 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+7 ;
+8 SET BARPATNM=0
+9 FOR
SET BARPATNM=$ORDER(^XTMP("BAR-BEN",$JOB,BARPATNM))
IF BARPATNM=""
QUIT
DO PATBIL
IF $GET(BAR("F1"))
QUIT
+10 DO TOTAL
+11 QUIT
+12 ; ********************************************************************
+13 ;
PATBIL ;
+1 SET BARBILL=""
+2 FOR
SET BARBILL=$ORDER(^XTMP("BAR-BEN",$JOB,BARPATNM,BARBILL))
IF BARBILL=""
QUIT
DO PATPRT
IF $GET(BAR("F1"))
QUIT
+3 QUIT
+4 ; ********************************************************************
+5 ;
PATPRT ; EP
+1 ; Print one line Patient Summary
+2 SET BARHOLD=$GET(^XTMP("BAR-BEN",$JOB,BARPATNM,BARBILL))
+3 IF $Y>(IOSL-5)
DO HD^BARRPSRB
IF $GET(BAR("F1"))
QUIT
+4 ; Patient Name
WRITE !,$EXTRACT(BARPATNM,1,25)
+5 ; Bill Number
WRITE ?29,$EXTRACT(BARBILL,1,18)
+6 ; DOS
WRITE ?51,$PIECE(BARHOLD,U,2)
+7 ; Write off Amount
WRITE ?69,$JUSTIFY($PIECE(BARHOLD,U),9,2)
+8 QUIT
+9 ; ********************************************************************
+10 ; ********************************************************************
+11 ;
BILL ;EP
+1 ; sort/print by Bill
+2 SET BAR("COL")="W !?3,""BILL"",?22,""PATIENT"",?51,""DOS"",?72,""AMOUNT"""
+3 DO HDB^BARRPSRB
+4 ; No data - quit
IF '+BARCNT
Begin DoDot:1
+5 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+6 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+7 ;
+8 SET BARBILL=0
+9 FOR
SET BARBILL=$ORDER(^XTMP("BAR-BEN",$JOB,BARBILL))
IF BARBILL=""
QUIT
DO BILLPRT
IF $GET(BAR("F1"))
QUIT
+10 DO TOTAL
+11 QUIT
+12 ; ********************************************************************
+13 ;
BILLPRT ; EP
+1 ; Print one line Bill summary
+2 SET BARHOLD=$GET(^XTMP("BAR-BEN",$JOB,BARBILL))
+3 IF $Y>(IOSL-5)
DO HD^BARRPSRB
IF $GET(BAR("F1"))
QUIT
+4 ; Bill Name
WRITE !,$EXTRACT(BARBILL,1,18)
+5 ; Patient Name
WRITE ?22,$EXTRACT($PIECE(BARHOLD,U,3),1,25)
+6 ; DOS
WRITE ?51,$PIECE(BARHOLD,U,2)
+7 ; Write off amount
WRITE ?69,$JUSTIFY($PIECE(BARHOLD,U),9,2)
+8 QUIT
+9 ; ********************************************************************
+10 ;
TOTAL ;
+1 ; Write report totals
+2 XECUTE BAREQUAL
+3 WRITE !,?10,"TOTAL BILLS: ",BARCNT
+4 WRITE ?40,"TOTAL AMOUNT",?64,$JUSTIFY(BARTOT,14,2)
+5 QUIT
+6 ; ********************************************************************
+7 ;
EXIT ; EP
+1 ; clear variables
+2 KILL ^XTMP("BAR-BEN",$JOB)
+3 QUIT
