BARDLOG.m

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