Routine: BARCLRG

BARCLRG ; IHS/SD/LSL - COLLECTION REGISTERS RPTS MAY 30,1996 ; 04/11/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,20**;OCT 26, 2005

 ; IHS/SD/LSL - 05/08/2002 - V1.6 Patch 2 - NOIS HQW-0302-100189

 ;     Modified code to use new header template for REPRINT.

 ; IHS/SD/LSL - 10/15/02 - V1.7 - HQW-0302-100169

 ;      Modified so that cannot reprint a batch that has not been finalized,

 ;      and that reprinting the batch won't automatically finalize.

 ; IHS/SD/AML - 12/09/10 - V1.8 P20

 ;      Modified to allow the batch Date Finalized (.25) and User

 ;      Finalized (.26) to be stored when batch is finalized.

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

START ;**EP-Collections report using FM print

DT ;EP - DETAIL REPORT

 W $$EN^BARVDF("IOF")

 D ^BARBAN

 W !!

 S BARSEL="D"

D D

 G:$D(BAREFLG) END

 D PRINT

 D EOP^BARUTL(1)

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

EX ;EP - EXCEPTIONS

 S BARFINS="E"

D E

 G:$D(BAREFLG) END

 D PRINT

 D EOP^BARUTL(1)

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

FL ;EP - FINAL REPORT

 S BARREPRT=0

 S BARSEL="F"

D F

 G:$D(BAREFLG) END

 D PRINT

 D EOP^BARUTL(1)

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

REP ;EP - REPRINT FINAL REPORT

 S BARSEL="F"

 S BARREPRT=1

D R

 G:$D(BAREFLG) END

 D PRINT

 D EOP^BARUTL(1)

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

END Q

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

LOOKUP ;

 ; **Collection Register name lookup

 K DUOUT,DTOUT,BAREFLG

 S DIC="90051.01"

 S DIC(0)="AEMQZ"

 D ^DIC

 K DIC

 S:Y<0 BAREFLG=1

 S:$D(DUOUT) BAREFLG=1

 S:$D(DTOUT) BAREFLG=1

 I $D(BAREFLG) Q

 I Y>0 D

 . S BARBATCH=+Y

 . S BARBEX=$P(Y(0),U)

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

PRINT ;EP **Print

 S DIC="90051.01"

 S L=0

 I $D(BARBEX) D

 . S FR=BARBEX

 . S TO=BARBEX

 S FR=FR_",,"

 S TO=TO_",,"

 D EN1^DIP

 D ^%ZISC,HOME^%ZIS

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

D ;**Detail

 S DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""

 D LOOKUP

 Q:$D(BAREFLG)

D2 ;EP  ;IHS/SD/SDR bar*1.8*4 DD item 4.1.5.1  added line tag

 D DTEND

 S DHD="[BAR CRH DET]"

 S FLDS="[BAR CR DET]"

 S BY="[BAR CRS DT]"

 S DIOEND="I $E(IOST)=""C"" D DTEND^BARCLRG"

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

F ;**Final

 I BARREPRT=0 S DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""

 D LOOKUP

 Q:$D(BAREFLG)

 ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3

 ;get total of items

 S BARITDA=0,BARITTOT=0

 F  S BARITDA=$O(^BARCOL(DUZ(2),BARBATCH,1,BARITDA)) Q:+BARITDA=0  D

 .;no cancelled or rolled up items

 .Q:$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="R"

 .Q:$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="C"

 .S BARITTOT=+$G(BARITTOT)+$P($G(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,1)),U)

 S BARATDN=$P($G(^BAR(90051.02,DUZ(2),$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,2),0)),U,22)

 I $G(BARATDN)=1,(+$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,29)'=(+BARITTOT)) D  Q

 .W !!,"The batch total of $",$FN($P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,29),",",2)," doesn't equal the items total of $",$FN(BARITTOT,",",2),"."

 .W !,"Either add item(s) or edit the batch amount to balance.  Batch can not be"

 .W !,"finalized until these balance."

 .S BAREFLG=1

 .W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR

 I $G(BARATDN)=1,(+$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,29)=(+BARITTOT)) W !!,"The batch total and the items total balance at $",$FN(BARITTOT,",",2)," for TDN ",$P($G(^BARCOL(DUZ(2),BARBATCH,0)),U,28),".",!

 ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3

 I BARREPRT=0 D

 .K DIR S DIR(0)="Y"

 .S DIR("A")="ARE YOU SURE YOU WANT TO FINALIZE THIS BATCH"

 .S DIR("B")="NO"

 .D ^DIR

 .K DIR

 .I Y="0" S BAREFLG=1 Q

 I $G(BAREFLG)=1 Q

 S DHD="[BAR CRH FIN]"

 S:BARREPRT=1 DHD="[BAR CRH RPRNT FIN]"

 S BY="[BAR CRS FIN]"

 S FLDS="[BAR CR FIN]"

 S DIOEND="D FLEND^BARCLRG"

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

R ;**Reprint Final

 S DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)[""POST"""

 D LOOKUP

 Q:$D(BAREFLG)

 S DHD="[BAR CRH RPRNT FIN]"

 S BY="[BAR CRS FIN]"

 S FLDS="[BAR CR FIN]"

 S DIOEND="D FLEND^BARCLRG"

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

E ;**Exceptions

 D LOOKUP

 Q:$D(BAREFLG)

 S DHD="[BAR CRH EXC]"

 S BY="[BAR CRS EXC]"

 S FLDS="[BAR CR EXC]"

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

FLEND ;**End of Final Report -- Summary Page and Postable Batch Status

 D EOP^BARUTL(1)

 I $Y+20>IOSL W $$EN^BARVDF("IOF")

 W !!,"DATE:"

 I BARREPRT=1 W ?25,"COLLECTIONS REPORT -- FINAL (REPRINT)"

 E  W ?25,"COLLECTIONS REPORT -- FINAL"

 W ?70,"SUMMARY"

 W !,$$MDT2^BARDUTL(DT)

 W !!!,"Collections listed above for Batch: "

 W $$VAL^XBDIQ1(90051.01,BARBATCH,.01),!,"totaling: "

 W $J($FN($$GET1^DIQ(90051.01,BARBATCH,15),",",2),10)

 W "  are transmitted herewith for appropriate action."

 W !!,?50,$P(^VA(200,DUZ,0),U)

 W !,?50,$$VAL^XBDIQ1(200,DUZ,29)

 W !,?50,$P(^DIC(4,DUZ(2),0),U)

 W !!!,"RECEIPT FOR $ ________________ IS HEREBY ACKNOWLEDGED."

 W !!!,?55,"___________________",!,?55,"FINANCIAL MANAGEMENT"

 I BARREPRT=0 D

 . S DIE="90051.01"

 . S DA=BARBATCH

 . ;S DR="3///POSTABLE"  ;IHS/SD/AML 12/9/2010 bar*1.8*20 - Populates the Finalized Date & User

 . S DR="3///POSTABLE;25///NOW;26///^S X=DUZ"  ;IHS/SD/AML bar*1.8*20 - Populates the Finalized Date & User

 . S DIDEL=90050

 . D ^DIE

 . K DIDEL

 I BARREPRT=0 D EN^BARCBTR(BARBATCH)

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

DTEND ;

 ;**Detail end -- ask if batch is to be made Postable

 S BARSTAT=$$VAL^XBDIQ1(90051.01,BARBATCH,3)

 I BARSTAT="POSTABLE" W !,"This Batch already in Postable Status!"

 I BARSTAT="REVIEW" W !,"This Batch already in Review Status!"

 I BARSTAT="OPEN" D STATUS

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

STATUS ;

 K DIR

 S DIR(0)="Y"

 S DIR("A")="DO YOU WISH TO PUT THIS BATCH IN REVIEW STATUS"

 S DIR("B")="NO"

 D ^DIR

 K DIR

 I Y="1" D

 .S DIE="90051.01"

 .S DA=BARBATCH

 .S DR="3///REVIEW"

 .S DIDEL=90050

 .D ^DIE

 .K DIDEL

BARCLRG   ; IHS/SD/LSL - COLLECTION REGISTERS RPTS MAY 30,1996 ; 04/11/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,20**;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/LSL - 05/08/2002 - V1.6 Patch 2 - NOIS HQW-0302-100189

 +4       ;     Modified code to use new header template for REPRINT.

 +5       ;

 +6       ; IHS/SD/LSL - 10/15/02 - V1.7 - HQW-0302-100169

 +7       ;      Modified so that cannot reprint a batch that has not been finalized,

 +8       ;      and that reprinting the batch won't automatically finalize.

 +9       ;

 +10      ; IHS/SD/AML - 12/09/10 - V1.8 P20

 +11      ;      Modified to allow the batch Date Finalized (.25) and User

 +12      ;      Finalized (.26) to be stored when batch is finalized.

 +13      ; *********************************************************************

 +14      ;

START     ;**EP-Collections report using FM print

 +1       ;

DT        ;EP - DETAIL REPORT

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

 +2        DO ^BARBAN

 +3        WRITE !!

 +4        SET BARSEL="D"

 +5        DO D

 +6        IF $DATA(BAREFLG)

               GOTO END

 +7        DO PRINT

 +8        DO EOP^BARUTL(1)

 +9        QUIT

 +10      ; *********************************************************************

 +11      ;

EX        ;EP - EXCEPTIONS

 +1        SET BARFINS="E"

 +2        DO E

 +3        IF $DATA(BAREFLG)

               GOTO END

 +4        DO PRINT

 +5        DO EOP^BARUTL(1)

 +6        QUIT

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

 +8       ;

FL        ;EP - FINAL REPORT

 +1        SET BARREPRT=0

 +2        SET BARSEL="F"

 +3        DO F

 +4        IF $DATA(BAREFLG)

               GOTO END

 +5        DO PRINT

 +6        DO EOP^BARUTL(1)

 +7        QUIT

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

 +9       ;

REP       ;EP - REPRINT FINAL REPORT

 +1        SET BARSEL="F"

 +2        SET BARREPRT=1

 +3        DO R

 +4        IF $DATA(BAREFLG)

               GOTO END

 +5        DO PRINT

 +6        DO EOP^BARUTL(1)

 +7        QUIT

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

 +9       ;

END        QUIT

 +1       ; *********************************************************************

 +2       ;

LOOKUP    ;

 +1       ; **Collection Register name lookup

 +2        KILL DUOUT,DTOUT,BAREFLG

 +3        SET DIC="90051.01"

 +4        SET DIC(0)="AEMQZ"

 +5        DO ^DIC

 +6        KILL DIC

 +7        IF Y<0

               SET BAREFLG=1

 +8        IF $DATA(DUOUT)

               SET BAREFLG=1

 +9        IF $DATA(DTOUT)

               SET BAREFLG=1

 +10       IF $DATA(BAREFLG)

               QUIT

 +11       IF Y>0

               Begin DoDot:1

 +12               SET BARBATCH=+Y

 +13               SET BARBEX=$PIECE(Y(0),U)

               End DoDot:1

 +14       QUIT

 +15      ; *********************************************************************

 +16      ;

PRINT     ;EP **Print

 +1       ;

 +2        SET DIC="90051.01"

 +3        SET L=0

 +4        IF $DATA(BARBEX)

               Begin DoDot:1

 +5                SET FR=BARBEX

 +6                SET TO=BARBEX

               End DoDot:1

 +7        SET FR=FR_",,"

 +8        SET TO=TO_",,"

 +9        DO EN1^DIP

 +10       DO ^%ZISC

           DO HOME^%ZIS

 +11       QUIT

 +12      ; *********************************************************************

 +13      ;

D         ;**Detail

 +1        SET DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""

 +2        DO LOOKUP

 +3        IF $DATA(BAREFLG)

               QUIT

D2        ;EP  ;IHS/SD/SDR bar*1.8*4 DD item 4.1.5.1  added line tag

 +1        DO DTEND

 +2        SET DHD="[BAR CRH DET]"

 +3        SET FLDS="[BAR CR DET]"

 +4        SET BY="[BAR CRS DT]"

 +5        SET DIOEND="I $E(IOST)=""C"" D DTEND^BARCLRG"

 +6        QUIT

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

 +8       ;

F         ;**Final

 +1        IF BARREPRT=0

               SET DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)'[""POST"""

 +2        DO LOOKUP

 +3        IF $DATA(BAREFLG)

               QUIT

 +4       ;start new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3

 +5       ;get total of items

 +6        SET BARITDA=0

           SET BARITTOT=0

 +7        FOR

               SET BARITDA=$ORDER(^BARCOL(DUZ(2),BARBATCH,1,BARITDA))

               IF +BARITDA=0

                   QUIT

               Begin DoDot:1

 +8       ;no cancelled or rolled up items

 +9                IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="R"

                       QUIT

 +10               IF $PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,0)),U,17)="C"

                       QUIT

 +11               SET BARITTOT=+$GET(BARITTOT)+$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,1,BARITDA,1)),U)

               End DoDot:1

 +12       SET BARATDN=$PIECE($GET(^BAR(90051.02,DUZ(2),$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,2),0)),U,22)

 +13       IF $GET(BARATDN)=1

               IF (+$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,29)'=(+BARITTOT))

                   Begin DoDot:1

 +14                   WRITE !!,"The batch total of $",$FNUMBER($PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,29),",",2)," doesn't equal the items total of $",$FNUMBER(BARITTOT,",",2),"."

 +15                   WRITE !,"Either add item(s) or edit the batch amount to balance.  Batch can not be"

 +16                   WRITE !,"finalized until these balance."

 +17                   SET BAREFLG=1

 +18                   WRITE !

                       KILL DIR

                       SET DIR(0)="E"

                       SET DIR("A")="Enter RETURN to Continue"

                       DO ^DIR

                       KILL DIR

                   End DoDot:1

                   QUIT

 +19       IF $GET(BARATDN)=1

               IF (+$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,29)=(+BARITTOT))

                   WRITE !!,"The batch total and the items total balance at $",$FNUMBER(BARITTOT,",",2)," for TDN ",$PIECE($GET(^BARCOL(DUZ(2),BARBATCH,0)),U,28),".",!

 +20      ;end new code IHS/SD/SDR bar*1.8*4 DD item 4.1.5.3

 +21       IF BARREPRT=0

               Begin DoDot:1

 +22               KILL DIR

                   SET DIR(0)="Y"

 +23               SET DIR("A")="ARE YOU SURE YOU WANT TO FINALIZE THIS BATCH"

 +24               SET DIR("B")="NO"

 +25               DO ^DIR

 +26               KILL DIR

 +27               IF Y="0"

                       SET BAREFLG=1

                       QUIT

               End DoDot:1

 +28       IF $GET(BAREFLG)=1

               QUIT

 +29       SET DHD="[BAR CRH FIN]"

 +30       IF BARREPRT=1

               SET DHD="[BAR CRH RPRNT FIN]"

 +31       SET BY="[BAR CRS FIN]"

 +32       SET FLDS="[BAR CR FIN]"

 +33       SET DIOEND="D FLEND^BARCLRG"

 +34       QUIT

 +35      ; *********************************************************************

 +36      ;

R         ;**Reprint Final

 +1        SET DIC("S")="I $$VAL^XBDIQ1(90051.01,+Y,3)[""POST"""

 +2        DO LOOKUP

 +3        IF $DATA(BAREFLG)

               QUIT

 +4        SET DHD="[BAR CRH RPRNT FIN]"

 +5        SET BY="[BAR CRS FIN]"

 +6        SET FLDS="[BAR CR FIN]"

 +7        SET DIOEND="D FLEND^BARCLRG"

 +8        QUIT

 +9       ; *********************************************************************

 +10      ;

E         ;**Exceptions

 +1        DO LOOKUP

 +2        IF $DATA(BAREFLG)

               QUIT

 +3        SET DHD="[BAR CRH EXC]"

 +4        SET BY="[BAR CRS EXC]"

 +5        SET FLDS="[BAR CR EXC]"

 +6        QUIT

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

 +8       ;

FLEND     ;**End of Final Report -- Summary Page and Postable Batch Status

 +1        DO EOP^BARUTL(1)

 +2        IF $Y+20>IOSL

               WRITE $$EN^BARVDF("IOF")

 +3        WRITE !!,"DATE:"

 +4        IF BARREPRT=1

               WRITE ?25,"COLLECTIONS REPORT -- FINAL (REPRINT)"

 +5       IF '$TEST

               WRITE ?25,"COLLECTIONS REPORT -- FINAL"

 +6        WRITE ?70,"SUMMARY"

 +7        WRITE !,$$MDT2^BARDUTL(DT)

 +8        WRITE !!!,"Collections listed above for Batch: "

 +9        WRITE $$VAL^XBDIQ1(90051.01,BARBATCH,.01),!,"totaling: "

 +10       WRITE $JUSTIFY($FNUMBER($$GET1^DIQ(90051.01,BARBATCH,15),",",2),10)

 +11       WRITE "  are transmitted herewith for appropriate action."

 +12       WRITE !!,?50,$PIECE(^VA(200,DUZ,0),U)

 +13       WRITE !,?50,$$VAL^XBDIQ1(200,DUZ,29)

 +14       WRITE !,?50,$PIECE(^DIC(4,DUZ(2),0),U)

 +15       WRITE !!!,"RECEIPT FOR $ ________________ IS HEREBY ACKNOWLEDGED."

 +16       WRITE !!!,?55,"___________________",!,?55,"FINANCIAL MANAGEMENT"

 +17       IF BARREPRT=0

               Begin DoDot:1

 +18               SET DIE="90051.01"

 +19               SET DA=BARBATCH

 +20      ;S DR="3///POSTABLE"  ;IHS/SD/AML 12/9/2010 bar*1.8*20 - Populates the Finalized Date & User

 +21      ;IHS/SD/AML bar*1.8*20 - Populates the Finalized Date & User

                   SET DR="3///POSTABLE;25///NOW;26///^S X=DUZ"

 +22               SET DIDEL=90050

 +23               DO ^DIE

 +24               KILL DIDEL

               End DoDot:1

 +25       IF BARREPRT=0

               DO EN^BARCBTR(BARBATCH)

 +26       QUIT

 +27      ; *********************************************************************

 +28      ;

DTEND     ;

 +1       ;**Detail end -- ask if batch is to be made Postable

 +2        SET BARSTAT=$$VAL^XBDIQ1(90051.01,BARBATCH,3)

 +3        IF BARSTAT="POSTABLE"

               WRITE !,"This Batch already in Postable Status!"

 +4        IF BARSTAT="REVIEW"

               WRITE !,"This Batch already in Review Status!"

 +5        IF BARSTAT="OPEN"

               DO STATUS

 +6        QUIT

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

 +8       ;

STATUS    ;

 +1        KILL DIR

 +2        SET DIR(0)="Y"

 +3        SET DIR("A")="DO YOU WISH TO PUT THIS BATCH IN REVIEW STATUS"

 +4        SET DIR("B")="NO"

 +5        DO ^DIR

 +6        KILL DIR

 +7        IF Y="1"

               Begin DoDot:1

 +8                SET DIE="90051.01"

 +9                SET DA=BARBATCH

 +10               SET DR="3///REVIEW"

 +11               SET DIDEL=90050

 +12               DO ^DIE

 +13               KILL DIDEL

               End DoDot:1

 +14       QUIT

BARCLRG.m