BARDLOG ; IHS/SD/LSL - A/R Debt Collection Log Report ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
;
; IHS/SD/LSL - 04/08/2004 - V1.8
; Routine created. Modified from BBMDCLOG
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; ********************************************************************
;
EP ; EP
K BARY,BAR
D:'$D(BARUSR) INIT^BARUTL ; Set up basic A/R Variables
S BARMENU=$S($D(XQY0):$P(XQY0,U,2),1:$P($G(^XUTL("XQ",$J,"S")),U,3))
D DATES ; Ask date range
I +BARSTART<1 Q ;No dates entered
S BARQ("RC")="PROCESS^BARDLOG" ; Build tmp global with data
S BARQ("RP")="PRINT^BARDLOG" ; Print reports from tmp global
I BARMENU["Payment" S BARQ("RP")="PRINTP^BARDLOG"
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
;D PAZ^BARRUTL ; Press return to continue
Q
; ********************************************************************
;
DATES ; EP
W !!,"Enter Transmission Date Range...",!
S BARSTART=$$DATE^BARDUTL(1)
I BARSTART<1 Q
S BAREND=$$DATE^BARDUTL(2)
I BAREND<1 W ! G DATES
I BAREND<BARSTART D G DATES
.W *7
.W !!,"The END date must not be before the START date.",!
Q
; ********************************************************************
; ********************************************************************
;
PROCESS ; EP
K ^TMP($J,"BAR-DLOG")
S X1=BARSTART
S X2=-1
D C^%DTC
S BARDATE=X ; Find day before start
;
F S BARDATE=$O(^BARDEBT("B",BARDATE)) Q:'+BARDATE!(BARDATE>BAREND) D LOOP
Q
; ********************************************************************
;
LOOP ;
S BARIEN=0
F S BARIEN=$O(^BARDEBT("B",BARDATE,BARIEN)) Q:'+BARIEN D DATA
Q
; ********************************************************************
;
DATA ; EP
Q:'$D(^BARDEBT(BARIEN,0)) ; No data
S BARAC=$$GET1^DIQ(90050.05,BARIEN,.07)
S:BARAC="" BARAC="Unknown"
S BARHOLD=DUZ(2)
S DUZ(2)=$P($G(^BARDEBT(BARIEN,0)),U,8)
I '+DUZ(2) S DUZ(2)=BARHOLD
S BARBL=$$GET1^DIQ(90050.05,BARIEN,.02)
S BARBLI=$$GET1^DIQ(90050.05,BARIEN,.02,"I") ;RLT
S BARDOS=$$GET1^DIQ(90050.05,BARIEN,".02:DOS BEGIN","I")
S:BARDOS="" BARDOS="******"
S BARBAL=$$GET1^DIQ(90050.05,BARIEN,.03)
S BARACT=$$GET1^DIQ(90050.05,BARIEN,.04)
;S:BARACT="STARTS" BARPAID=$$TRANS^BARDUTL(DUZ(2),BARIEN,"P") ; payments for bill
S:BARACT="STARTS" BARPAID=$$TRANS^BARDUTL(DUZ(2),BARBLI,"P") ; RLT
S DUZ(2)=BARHOLD
S ^TMP($J,"BAR-DLOG",BARAC,BARDOS,BARIEN)=BARBL_U_BARDATE_U_BARBAL_U_BARACT
S:BARACT="STARTS" $P(^TMP($J,"BAR-DLOG",BARAC,BARDOS,BARIEN),U,5)=BARPAID
Q
; ********************************************************************
; ********************************************************************
;
PRINT ; EP
; Print Debt Collection Log Report
K BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD
S BARPG=0
D NOW^%DTC
S Y=%
X ^DD("DD")
S BARUN=$P(Y,":",1,2)
S $P(BARDASH,"-",81)=""
D HEAD
;
; No data
I '$D(^TMP($J,"BAR-DLOG")) D Q
. W !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)
. D PAZ^BARRUTL
;
S (BARTOT,BARCNT,BARSTOP)=0
S BARAC=""
F S BARAC=$O(^TMP($J,"BAR-DLOG",BARAC)) Q:BARAC="" D ACCT Q:BARSTOP
Q:BARSTOP
W !?50,"------------"
W !?50,$J(BARTOT,10,2)," (",BARCNT,")"
D PAZ^BARRUTL
Q
; ********************************************************************
;
ACCT ;
W !?5,"A/R Account: ",BARAC
S BARPTOT=0,BARPCNT=0
S BARDOS=""
F S BARDOS=$O(^TMP($J,"BAR-DLOG",BARAC,BARDOS)) Q:BARDOS="" D DOS Q:BARSTOP
Q:BARSTOP
W !?50,"------------"
W !?50,$J(BARPTOT,10,2)," (",BARPCNT,")"
Q
; ********************************************************************
;
DOS ;
S BARIEN=0
F S BARIEN=$O(^TMP($J,"BAR-DLOG",BARAC,BARDOS,BARIEN)) Q:'+BARIEN D BILL Q:BARSTOP
Q
; ********************************************************************
;
BILL ;
S BAREC=^TMP($J,"BAR-DLOG",BARAC,BARDOS,BARIEN)
S BARBL=$P(BAREC,U)
S BARDATE=$P(BAREC,U,2)
S BARBAL=$P(BAREC,U,3)
S BARACT=$P(BAREC,U,4)
S BARSTOP=$$CHKLINE(BARAC)
Q:BARSTOP
W !,$$SDT^BARDUTL(BARDATE),?12,BARBL,?35,$$SDT^BARDUTL(BARDOS)
W ?50,$J(BARBAL,10,2),?65,BARACT
S BARPTOT=BARPTOT+BARBAL
S BARTOT=BARTOT+BARBAL
S BARCNT=BARCNT+1
S BARPCNT=BARPCNT+1
Q
; ********************************************************************
;
CHKLINE(BARAC) ;EP
; Q 0 = CONTINUE
; Q 1 = STOP
N X
I ($Y+5)<IOSL Q 0
W !?(IOM-15),"continued==>"
I $E(IOST)="C" D I 'Y Q 1
. S DIR(0)="E" W ! D ^DIR
D HEAD
W !?5,"A/R Account: "_BARAC
Q 0
; ********************************************************************
;
HEAD ;
S BARPG=BARPG+1
W $$EN^BARVDF("IOF")
W !,$$CJ^XLFSTR("DEBT COLLECTION LOG",IOM)
W !!,"Run Date: ",BARUN
W ?IOM-15,"Page: "_BARPG
W !!,"DATE SENT",?12,"AR BILL",?35,"DOS",?50,"AR BALANCE",?65,"ACTION CODE"
W !,BARDASH
Q
; ********************************************************************
; ********************************************************************
;
PRINTP ; EP
; Print Debt Collection Payment Report
K BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD
S BARHDR="DEBT COLLECTION PAYMENT REPORT"
S BARPG=0
D NOW^%DTC
S Y=%
X ^DD("DD")
S BARUN=$P(Y,":",1,2)
S $P(BARDASH,"-",81)=""
D HEADP
;
; No data
I '$D(^TMP($J,"BAR-DLOG")) D Q
. W !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)
. D PAZ^BARRUTL
;
S (BARTOT,BARCNT,BARSTOP)=0
S BARTOT2=0
S BARAC=""
F S BARAC=$O(^TMP($J,"BAR-DLOG",BARAC)) Q:BARAC="" D ACCTP Q:BARSTOP
Q:BARSTOP
W !?42,"----------",?69,"----------"
W !?42,$J(BARTOT,10,2)," (",BARCNT,")",?69,$J(BARTOT2,10,2)
D PAZ^BARRUTL
Q
; ********************************************************************
;
ACCTP ; EP
W !?5,"A/R Account: ",BARAC
S BARPTOT=0,BARPCNT=0,BARPTOT2=0
S BARDOS=""
F S BARDOS=$O(^TMP($J,"BAR-DLOG",BARAC,BARDOS)) Q:BARDOS="" D DOSP Q:BARSTOP
Q:BARSTOP
W !?42,"----------",?69,"----------"
W !?42,$J(BARPTOT,10,2)," (",BARPCNT,")",?69,$J(BARPTOT2,10,2)
Q
; ********************************************************************
;
DOSP ;
S BARIEN=0
F S BARIEN=$O(^TMP($J,"BAR-DLOG",BARAC,BARDOS,BARIEN)) Q:'+BARIEN D BILLP Q:BARSTOP
Q
; ********************************************************************
;
BILLP ;
S BAREC=^TMP($J,"BAR-DLOG",BARAC,BARDOS,BARIEN)
S BARBL=$P(BAREC,U)
S BARDATE=$P(BAREC,U,2)
S BARBAL=$P(BAREC,U,3)
S BARACT=$P(BAREC,U,4)
S BARPAID=$P(BAREC,U,5)
S BARSTOP=$$CHKLINEP(BARAC)
Q:BARSTOP
W !,$$SDT^BARDUTL(BARDATE) ; Date transmitted
W ?13,$E(BARBL,1,15) ; Bill Name
W ?30,$$SDT^BARDUTL(BARDOS) ; Date of Service (Begin)
W ?42,$J(BARBAL,10,2) ; Bill balance from Log
W ?55,BARACT ; Action code
W:BARACT="STARTS" ?69,$J(BARPAID,10,2) ; All payments for bill
S BARPTOT=BARPTOT+BARBAL
S BARTOT=BARTOT+BARBAL
S:BARACT="STARTS" BARPTOT2=BARPTOT2+BARPAID
S:BARACT="STARTS" BARTOT2=BARTOT2+BARPAID
S BARCNT=BARCNT+1
S BARPCNT=BARPCNT+1
Q
; ********************************************************************
;
CHKLINEP(BARAC) ;EP
; Q 0 = CONTINUE
; Q 1 = STOP
N X
I ($Y+5)<IOSL Q 0
W !?(IOM-15),"continued==>"
I $E(IOST)="C" D I 'Y Q 1
. S DIR(0)="E" W ! D ^DIR
D HEADP
W !?5,"A/R Account: "_BARAC
Q 0
; ********************************************************************
;
HEADP ;EP
S BARPG=BARPG+1
W $$EN^BARVDF("IOF")
W !,$$CJ^XLFSTR(BARHDR,IOM)
W !!,"Run Date: ",BARUN
W ?IOM-15,"Page: "_BARPG
W !!,"DATE SENT",?13,"AR BILL",?30,"DOS",?42,"AR BALANCE",?55,"ACTION CODE",?72,"PAYMENT"
W !,BARDASH
Q
BARDLOG ; IHS/SD/LSL - A/R Debt Collection Log Report ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 04/08/2004 - V1.8
+4 ; Routine created. Modified from BBMDCLOG
+5 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+6 ; ********************************************************************
+7 ;
EP ; EP
+1 KILL BARY,BAR
+2 ; Set up basic A/R Variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+3 SET BARMENU=$SELECT($DATA(XQY0):$PIECE(XQY0,U,2),1:$PIECE($GET(^XUTL("XQ",$JOB,"S")),U,3))
+4 ; Ask date range
DO DATES
+5 ;No dates entered
IF +BARSTART<1
QUIT
+6 ; Build tmp global with data
SET BARQ("RC")="PROCESS^BARDLOG"
+7 ; Print reports from tmp global
SET BARQ("RP")="PRINT^BARDLOG"
+8 IF BARMENU["Payment"
SET BARQ("RP")="PRINTP^BARDLOG"
+9 ; Namespace for variables
SET BARQ("NS")="BAR"
+10 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+11 ; Double queuing
DO ^BARDBQUE
+12 ;D PAZ^BARRUTL ; Press return to continue
+13 QUIT
+14 ; ********************************************************************
+15 ;
DATES ; EP
+1 WRITE !!,"Enter Transmission Date Range...",!
+2 SET BARSTART=$$DATE^BARDUTL(1)
+3 IF BARSTART<1
QUIT
+4 SET BAREND=$$DATE^BARDUTL(2)
+5 IF BAREND<1
WRITE !
GOTO DATES
+6 IF BAREND<BARSTART
Begin DoDot:1
+7 WRITE *7
+8 WRITE !!,"The END date must not be before the START date.",!
End DoDot:1
GOTO DATES
+9 QUIT
+10 ; ********************************************************************
+11 ; ********************************************************************
+12 ;
PROCESS ; EP
+1 KILL ^TMP($JOB,"BAR-DLOG")
+2 SET X1=BARSTART
+3 SET X2=-1
+4 DO C^%DTC
+5 ; Find day before start
SET BARDATE=X
+6 ;
+7 FOR
SET BARDATE=$ORDER(^BARDEBT("B",BARDATE))
IF '+BARDATE!(BARDATE>BAREND)
QUIT
DO LOOP
+8 QUIT
+9 ; ********************************************************************
+10 ;
LOOP ;
+1 SET BARIEN=0
+2 FOR
SET BARIEN=$ORDER(^BARDEBT("B",BARDATE,BARIEN))
IF '+BARIEN
QUIT
DO DATA
+3 QUIT
+4 ; ********************************************************************
+5 ;
DATA ; EP
+1 ; No data
IF '$DATA(^BARDEBT(BARIEN,0))
QUIT
+2 SET BARAC=$$GET1^DIQ(90050.05,BARIEN,.07)
+3 IF BARAC=""
SET BARAC="Unknown"
+4 SET BARHOLD=DUZ(2)
+5 SET DUZ(2)=$PIECE($GET(^BARDEBT(BARIEN,0)),U,8)
+6 IF '+DUZ(2)
SET DUZ(2)=BARHOLD
+7 SET BARBL=$$GET1^DIQ(90050.05,BARIEN,.02)
+8 ;RLT
SET BARBLI=$$GET1^DIQ(90050.05,BARIEN,.02,"I")
+9 SET BARDOS=$$GET1^DIQ(90050.05,BARIEN,".02:DOS BEGIN","I")
+10 IF BARDOS=""
SET BARDOS="******"
+11 SET BARBAL=$$GET1^DIQ(90050.05,BARIEN,.03)
+12 SET BARACT=$$GET1^DIQ(90050.05,BARIEN,.04)
+13 ;S:BARACT="STARTS" BARPAID=$$TRANS^BARDUTL(DUZ(2),BARIEN,"P") ; payments for bill
+14 ; RLT
IF BARACT="STARTS"
SET BARPAID=$$TRANS^BARDUTL(DUZ(2),BARBLI,"P")
+15 SET DUZ(2)=BARHOLD
+16 SET ^TMP($JOB,"BAR-DLOG",BARAC,BARDOS,BARIEN)=BARBL_U_BARDATE_U_BARBAL_U_BARACT
+17 IF BARACT="STARTS"
SET $PIECE(^TMP($JOB,"BAR-DLOG",BARAC,BARDOS,BARIEN),U,5)=BARPAID
+18 QUIT
+19 ; ********************************************************************
+20 ; ********************************************************************
+21 ;
PRINT ; EP
+1 ; Print Debt Collection Log Report
+2 KILL BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD
+3 SET BARPG=0
+4 DO NOW^%DTC
+5 SET Y=%
+6 XECUTE ^DD("DD")
+7 SET BARUN=$PIECE(Y,":",1,2)
+8 SET $PIECE(BARDASH,"-",81)=""
+9 DO HEAD
+10 ;
+11 ; No data
+12 IF '$DATA(^TMP($JOB,"BAR-DLOG"))
Begin DoDot:1
+13 WRITE !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)
+14 DO PAZ^BARRUTL
End DoDot:1
QUIT
+15 ;
+16 SET (BARTOT,BARCNT,BARSTOP)=0
+17 SET BARAC=""
+18 FOR
SET BARAC=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC))
IF BARAC=""
QUIT
DO ACCT
IF BARSTOP
QUIT
+19 IF BARSTOP
QUIT
+20 WRITE !?50,"------------"
+21 WRITE !?50,$JUSTIFY(BARTOT,10,2)," (",BARCNT,")"
+22 DO PAZ^BARRUTL
+23 QUIT
+24 ; ********************************************************************
+25 ;
ACCT ;
+1 WRITE !?5,"A/R Account: ",BARAC
+2 SET BARPTOT=0
SET BARPCNT=0
+3 SET BARDOS=""
+4 FOR
SET BARDOS=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC,BARDOS))
IF BARDOS=""
QUIT
DO DOS
IF BARSTOP
QUIT
+5 IF BARSTOP
QUIT
+6 WRITE !?50,"------------"
+7 WRITE !?50,$JUSTIFY(BARPTOT,10,2)," (",BARPCNT,")"
+8 QUIT
+9 ; ********************************************************************
+10 ;
DOS ;
+1 SET BARIEN=0
+2 FOR
SET BARIEN=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC,BARDOS,BARIEN))
IF '+BARIEN
QUIT
DO BILL
IF BARSTOP
QUIT
+3 QUIT
+4 ; ********************************************************************
+5 ;
BILL ;
+1 SET BAREC=^TMP($JOB,"BAR-DLOG",BARAC,BARDOS,BARIEN)
+2 SET BARBL=$PIECE(BAREC,U)
+3 SET BARDATE=$PIECE(BAREC,U,2)
+4 SET BARBAL=$PIECE(BAREC,U,3)
+5 SET BARACT=$PIECE(BAREC,U,4)
+6 SET BARSTOP=$$CHKLINE(BARAC)
+7 IF BARSTOP
QUIT
+8 WRITE !,$$SDT^BARDUTL(BARDATE),?12,BARBL,?35,$$SDT^BARDUTL(BARDOS)
+9 WRITE ?50,$JUSTIFY(BARBAL,10,2),?65,BARACT
+10 SET BARPTOT=BARPTOT+BARBAL
+11 SET BARTOT=BARTOT+BARBAL
+12 SET BARCNT=BARCNT+1
+13 SET BARPCNT=BARPCNT+1
+14 QUIT
+15 ; ********************************************************************
+16 ;
CHKLINE(BARAC) ;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 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+7 SET DIR(0)="E"
WRITE !
DO ^DIR
End DoDot:1
IF 'Y
QUIT 1
+8 DO HEAD
+9 WRITE !?5,"A/R Account: "_BARAC
+10 QUIT 0
+11 ; ********************************************************************
+12 ;
HEAD ;
+1 SET BARPG=BARPG+1
+2 WRITE $$EN^BARVDF("IOF")
+3 WRITE !,$$CJ^XLFSTR("DEBT COLLECTION LOG",IOM)
+4 WRITE !!,"Run Date: ",BARUN
+5 WRITE ?IOM-15,"Page: "_BARPG
+6 WRITE !!,"DATE SENT",?12,"AR BILL",?35,"DOS",?50,"AR BALANCE",?65,"ACTION CODE"
+7 WRITE !,BARDASH
+8 QUIT
+9 ; ********************************************************************
+10 ; ********************************************************************
+11 ;
PRINTP ; EP
+1 ; Print Debt Collection Payment Report
+2 KILL BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD
+3 SET BARHDR="DEBT COLLECTION PAYMENT REPORT"
+4 SET BARPG=0
+5 DO NOW^%DTC
+6 SET Y=%
+7 XECUTE ^DD("DD")
+8 SET BARUN=$PIECE(Y,":",1,2)
+9 SET $PIECE(BARDASH,"-",81)=""
+10 DO HEADP
+11 ;
+12 ; No data
+13 IF '$DATA(^TMP($JOB,"BAR-DLOG"))
Begin DoDot:1
+14 WRITE !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)
+15 DO PAZ^BARRUTL
End DoDot:1
QUIT
+16 ;
+17 SET (BARTOT,BARCNT,BARSTOP)=0
+18 SET BARTOT2=0
+19 SET BARAC=""
+20 FOR
SET BARAC=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC))
IF BARAC=""
QUIT
DO ACCTP
IF BARSTOP
QUIT
+21 IF BARSTOP
QUIT
+22 WRITE !?42,"----------",?69,"----------"
+23 WRITE !?42,$JUSTIFY(BARTOT,10,2)," (",BARCNT,")",?69,$JUSTIFY(BARTOT2,10,2)
+24 DO PAZ^BARRUTL
+25 QUIT
+26 ; ********************************************************************
+27 ;
ACCTP ; EP
+1 WRITE !?5,"A/R Account: ",BARAC
+2 SET BARPTOT=0
SET BARPCNT=0
SET BARPTOT2=0
+3 SET BARDOS=""
+4 FOR
SET BARDOS=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC,BARDOS))
IF BARDOS=""
QUIT
DO DOSP
IF BARSTOP
QUIT
+5 IF BARSTOP
QUIT
+6 WRITE !?42,"----------",?69,"----------"
+7 WRITE !?42,$JUSTIFY(BARPTOT,10,2)," (",BARPCNT,")",?69,$JUSTIFY(BARPTOT2,10,2)
+8 QUIT
+9 ; ********************************************************************
+10 ;
DOSP ;
+1 SET BARIEN=0
+2 FOR
SET BARIEN=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC,BARDOS,BARIEN))
IF '+BARIEN
QUIT
DO BILLP
IF BARSTOP
QUIT
+3 QUIT
+4 ; ********************************************************************
+5 ;
BILLP ;
+1 SET BAREC=^TMP($JOB,"BAR-DLOG",BARAC,BARDOS,BARIEN)
+2 SET BARBL=$PIECE(BAREC,U)
+3 SET BARDATE=$PIECE(BAREC,U,2)
+4 SET BARBAL=$PIECE(BAREC,U,3)
+5 SET BARACT=$PIECE(BAREC,U,4)
+6 SET BARPAID=$PIECE(BAREC,U,5)
+7 SET BARSTOP=$$CHKLINEP(BARAC)
+8 IF BARSTOP
QUIT
+9 ; Date transmitted
WRITE !,$$SDT^BARDUTL(BARDATE)
+10 ; Bill Name
WRITE ?13,$EXTRACT(BARBL,1,15)
+11 ; Date of Service (Begin)
WRITE ?30,$$SDT^BARDUTL(BARDOS)
+12 ; Bill balance from Log
WRITE ?42,$JUSTIFY(BARBAL,10,2)
+13 ; Action code
WRITE ?55,BARACT
+14 ; All payments for bill
IF BARACT="STARTS"
WRITE ?69,$JUSTIFY(BARPAID,10,2)
+15 SET BARPTOT=BARPTOT+BARBAL
+16 SET BARTOT=BARTOT+BARBAL
+17 IF BARACT="STARTS"
SET BARPTOT2=BARPTOT2+BARPAID
+18 IF BARACT="STARTS"
SET BARTOT2=BARTOT2+BARPAID
+19 SET BARCNT=BARCNT+1
+20 SET BARPCNT=BARPCNT+1
+21 QUIT
+22 ; ********************************************************************
+23 ;
CHKLINEP(BARAC) ;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 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+7 SET DIR(0)="E"
WRITE !
DO ^DIR
End DoDot:1
IF 'Y
QUIT 1
+8 DO HEADP
+9 WRITE !?5,"A/R Account: "_BARAC
+10 QUIT 0
+11 ; ********************************************************************
+12 ;
HEADP ;EP
+1 SET BARPG=BARPG+1
+2 WRITE $$EN^BARVDF("IOF")
+3 WRITE !,$$CJ^XLFSTR(BARHDR,IOM)
+4 WRITE !!,"Run Date: ",BARUN
+5 WRITE ?IOM-15,"Page: "_BARPG
+6 WRITE !!,"DATE SENT",?13,"AR BILL",?30,"DOS",?42,"AR BALANCE",?55,"ACTION CODE",?72,"PAYMENT"
+7 WRITE !,BARDASH
+8 QUIT
