BARWRVR.m

BARWRVR ; IHS/SD/LSL - ROLLOVER DETAIL REPORT ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ;

SUM ; EP

 ; summary

 S BARSUM=1

 ;

DET ; EP

 ; detail

 S:'$G(BARSUM) BARSUM=2

 K BARQUIT

 D GETDOS^BARPUTL

 S %ZIS="NQ"

 D ^%ZIS

 Q:POP

 I IO'=IO(0) D  Q

 .S ZTRTN="LOOP^BARWRVR"

 .F I="BARSTART","BAREND","BARSUM" S ZTSAVE(I)=""

 .K ZTSK

 .D ^%ZTLOAD

 .W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!

 .D HOME^%ZIS

 I $D(IO("S")) S IOP=ION D ^%ZIS

 ; -------------------------------

 ;

LOOP ;

 ; loop through "AE" x-ref

 S $P(BAREQ,"=",80)=""

 S BARPG=0

 N I F I=1:1:4 S BARTOT(I)=0

 D HDR

 S BARDATE=BARSTART-.1

 S $P(BAREND,".",2)=9999

 S BAROLD=0

 F  S BARDATE=$O(^BARBL(DUZ(2),"AE",BARDATE)) Q:'BARDATE!(BARDATE>BAREND)!($G(BARQUIT))  D

 .S:BAROLD=0 BAROLD=$P(BARDATE,".",1)

 .I $P(BARDATE,".",1)'=BAROLD,BARSUM=1 D SUMPR

 .S DA=0

 .F  S DA=$O(^BARBL(DUZ(2),"AE",BARDATE,DA)) Q:'DA  D ONE

 I '$G(BARQUIT) D

 .D:BARSUM=1 SUMPR

 .D:$Y+5>IOSL HDR

 .W !!," TOTAL:    ",$J($FN(BARTOT(2),",",2),12)

 .W ?27,"TOTAL BILLS: ",$J(BARTOT(1),5)

 .W !!,"E N D   O F   R E P O R T",!!

 .D EOP^BARUTL(1)

 I $D(IO("S")) D ^%ZISC

 K BARSTART,BAREND,BARDATE,BAR5,BARTOT,BARQUIT,BARSUM,BAROLD

 Q

 ; *********************************************************************

 ;

SUMPR ;

 ; print out one day

 W !,$$SDT^BARDUTL(BAROLD)

 W ?11,$J($FN(BARTOT(4),",",2),12)

 W ?40,$J(BARTOT(3),5)

 S BARTOT(3)=0,BARTOT(4)=0

 S BAROLD=$P(BARDATE,".",1)

 Q

 ; *********************************************************************

 ;

ONE ;

 ; one bill

 S Y=1

 I $Y+5>IOSL D

 .D EOP^BARUTL(0)

 .I '+Y S BARQUIT=1 Q

 .D HDR

 Q:$G(BARQUIT)

 K BAR5

 F K=0,2 S BAR5(K)=^BARBL(DUZ(2),DA,K)

 D DIQ

 S BARTOT(1)=BARTOT(1)+1

 S BARTOT(2)=BARTOT(2)+$P(BAR5(2),"^",9)

 S BARTOT(3)=BARTOT(3)+1

 S BARTOT(4)=BARTOT(4)+$P(BAR5(2),"^",9)

 Q:BARSUM=1

 W !,$$SDT^BARDUTL($P(BAR5(2),"^",10))

 W ?13,$J($FN($P(BAR5(2),"^",9),",",2),10)

 W ?27,$P(BAR5(0),"^",1)

 W ?50,$G(BAR5(90050.01,DA,17.2))

 W ?65,$G(BAR5(90050.01,DA,17.4))

 Q

 ; *********************************************************************

 ;

DIQ ;

 ; get computed fields

 K DIQ

 S DIC="^BARBL(DUZ(2),"

 S DIQ="BAR5("

 S DR="17.2;17.4"

 D EN^DIQ1

 Q

 ; *********************************************************************

 ;

HDR ;

 ; report header

 S BARPG=BARPG+1

 W $$EN^BARVDF("IOF")

 D:BARSUM=1 HDR1

 D:BARSUM=2 HDR2

 W !,BAREQ,!

 Q

 ; *********************************************************************

 ;

HDR1 ;

 ; header for summary report

 W !,$$MDT2^BARDUTL(DT),?30,"ROLLOVER SUMMARY REPORT"

 W ?70,"Page: ",BARPG

 W !,?15,"ROLLOVER"

 W !,"DATE",?17,"AMOUNT",?39,"BILL COUNT"

 Q

 ; *********************************************************************

 ;

HDR2 ;

 ; header for detail report

 W !,$$MDT2^BARDUTL(DT),?30,"ROLLOVER DETAIL REPORT"

 W ?70,"Page: ",BARPG

 W !,?15,"ROLLOVER",?50,"3P BILL",?65,"3P CLAIM"

 W !,"DATE",?17,"AMOUNT",?27,"A/R BILL",?50,"STATUS",?65,"STATUS"

 Q

BARWRVR   ; IHS/SD/LSL - ROLLOVER DETAIL REPORT ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;

SUM       ; EP

 +1       ; summary

 +2        SET BARSUM=1

 +3       ;

DET       ; EP

 +1       ; detail

 +2        IF '$GET(BARSUM)

               SET BARSUM=2

 +3        KILL BARQUIT

 +4        DO GETDOS^BARPUTL

 +5        SET %ZIS="NQ"

 +6        DO ^%ZIS

 +7        IF POP

               QUIT 

 +8        IF IO'=IO(0)

               Begin DoDot:1

 +9                SET ZTRTN="LOOP^BARWRVR"

 +10               FOR I="BARSTART","BAREND","BARSUM"

                       SET ZTSAVE(I)=""

 +11               KILL ZTSK

 +12               DO ^%ZTLOAD

 +13               IF $GET(ZTSK)

                       WRITE !,"Task # ",ZTSK," queued.",!

 +14               DO HOME^%ZIS

               End DoDot:1

               QUIT 

 +15       IF $DATA(IO("S"))

               SET IOP=ION

               DO ^%ZIS

 +16      ; -------------------------------

 +17      ;

LOOP      ;

 +1       ; loop through "AE" x-ref

 +2        SET $PIECE(BAREQ,"=",80)=""

 +3        SET BARPG=0

 +4        NEW I

           FOR I=1:1:4

               SET BARTOT(I)=0

 +5        DO HDR

 +6        SET BARDATE=BARSTART-.1

 +7        SET $PIECE(BAREND,".",2)=9999

 +8        SET BAROLD=0

 +9        FOR 

               SET BARDATE=$ORDER(^BARBL(DUZ(2),"AE",BARDATE))

               IF 'BARDATE!(BARDATE>BAREND)!($GET(BARQUIT))

                   QUIT 

               Begin DoDot:1

 +10               IF BAROLD=0

                       SET BAROLD=$PIECE(BARDATE,".",1)

 +11               IF $PIECE(BARDATE,".",1)'=BAROLD

                       IF BARSUM=1

                           DO SUMPR

 +12               SET DA=0

 +13               FOR 

                       SET DA=$ORDER(^BARBL(DUZ(2),"AE",BARDATE,DA))

                       IF 'DA

                           QUIT 

                       DO ONE

               End DoDot:1

 +14       IF '$GET(BARQUIT)

               Begin DoDot:1

 +15               IF BARSUM=1

                       DO SUMPR

 +16               IF $Y+5>IOSL

                       DO HDR

 +17               WRITE !!," TOTAL:    ",$JUSTIFY($FNUMBER(BARTOT(2),",",2),12)

 +18               WRITE ?27,"TOTAL BILLS: ",$JUSTIFY(BARTOT(1),5)

 +19               WRITE !!,"E N D   O F   R E P O R T",!!

 +20               DO EOP^BARUTL(1)

               End DoDot:1

 +21       IF $DATA(IO("S"))

               DO ^%ZISC

 +22       KILL BARSTART,BAREND,BARDATE,BAR5,BARTOT,BARQUIT,BARSUM,BAROLD

 +23       QUIT 

 +24      ; *********************************************************************

 +25      ;

SUMPR     ;

 +1       ; print out one day

 +2        WRITE !,$$SDT^BARDUTL(BAROLD)

 +3        WRITE ?11,$JUSTIFY($FNUMBER(BARTOT(4),",",2),12)

 +4        WRITE ?40,$JUSTIFY(BARTOT(3),5)

 +5        SET BARTOT(3)=0

           SET BARTOT(4)=0

 +6        SET BAROLD=$PIECE(BARDATE,".",1)

 +7        QUIT 

 +8       ; *********************************************************************

 +9       ;

ONE       ;

 +1       ; one bill

 +2        SET Y=1

 +3        IF $Y+5>IOSL

               Begin DoDot:1

 +4                DO EOP^BARUTL(0)

 +5                IF '+Y

                       SET BARQUIT=1

                       QUIT 

 +6                DO HDR

               End DoDot:1

 +7        IF $GET(BARQUIT)

               QUIT 

 +8        KILL BAR5

 +9        FOR K=0,2

               SET BAR5(K)=^BARBL(DUZ(2),DA,K)

 +10       DO DIQ

 +11       SET BARTOT(1)=BARTOT(1)+1

 +12       SET BARTOT(2)=BARTOT(2)+$PIECE(BAR5(2),"^",9)

 +13       SET BARTOT(3)=BARTOT(3)+1

 +14       SET BARTOT(4)=BARTOT(4)+$PIECE(BAR5(2),"^",9)

 +15       IF BARSUM=1

               QUIT 

 +16       WRITE !,$$SDT^BARDUTL($PIECE(BAR5(2),"^",10))

 +17       WRITE ?13,$JUSTIFY($FNUMBER($PIECE(BAR5(2),"^",9),",",2),10)

 +18       WRITE ?27,$PIECE(BAR5(0),"^",1)

 +19       WRITE ?50,$GET(BAR5(90050.01,DA,17.2))

 +20       WRITE ?65,$GET(BAR5(90050.01,DA,17.4))

 +21       QUIT 

 +22      ; *********************************************************************

 +23      ;

DIQ       ;

 +1       ; get computed fields

 +2        KILL DIQ

 +3        SET DIC="^BARBL(DUZ(2),"

 +4        SET DIQ="BAR5("

 +5        SET DR="17.2;17.4"

 +6        DO EN^DIQ1

 +7        QUIT 

 +8       ; *********************************************************************

 +9       ;

HDR       ;

 +1       ; report header

 +2        SET BARPG=BARPG+1

 +3        WRITE $$EN^BARVDF("IOF")

 +4        IF BARSUM=1

               DO HDR1

 +5        IF BARSUM=2

               DO HDR2

 +6        WRITE !,BAREQ,!

 +7        QUIT 

 +8       ; *********************************************************************

 +9       ;

HDR1      ;

 +1       ; header for summary report

 +2        WRITE !,$$MDT2^BARDUTL(DT),?30,"ROLLOVER SUMMARY REPORT"

 +3        WRITE ?70,"Page: ",BARPG

 +4        WRITE !,?15,"ROLLOVER"

 +5        WRITE !,"DATE",?17,"AMOUNT",?39,"BILL COUNT"

 +6        QUIT 

 +7       ; *********************************************************************

 +8       ;

HDR2      ;

 +1       ; header for detail report

 +2        WRITE !,$$MDT2^BARDUTL(DT),?30,"ROLLOVER DETAIL REPORT"

 +3        WRITE ?70,"Page: ",BARPG

 +4        WRITE !,?15,"ROLLOVER",?50,"3P BILL",?65,"3P CLAIM"

 +5        WRITE !,"DATE",?17,"AMOUNT",?27,"A/R BILL",?50,"STATUS",?65,"STATUS"

 +6        QUIT