BARRADJ0.m

BARRADJ0 ; IHS/SD/POT - TRANSACTION/ADJUSTMENT REPORT - OVERFLOW CODE; 08/20/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69

 ;NEW ROUTINE: OVERFLOW CODE FROM BARRADJ

 ;IHS/SD/POT 01/15/14 HEAT124730 ADDING DOS TO TEXT DELIM REPORT 

 ;           

 Q

CLEANUP ;  Cleanup TSR vars

 K ^TMP($J,"BAR-"_BAR("SUBR"))

 K ^TMP($J,"BAR-TSR")

 K ^TMP($J,"BAR-TSRS")

 K ^TMP($J,"BAR-TSRS-INS")

 K ADJTBTOT,ADJTTTOT,ARBTOT,ARTTOT

 K BAR,BARBILL,BARBILLO,BARDASH,BARDLMTD,BARDUZ2,BAREQUAL,BARHLD,BARI,BARP

 K BARPREV,BARTEXT,BARTR,BARY,BILL

 K CNT,DEBUG,DIROUT,DTOUT,DUOUT,FILL,GRANBILL,GRANTRAN,INSURER

 K OFFSET,SORTBTOT,SORTTTOT,SUBS,SUBTOT,SUMMARY,TOTBILLS,TRANBTOT,TRANTTOT,TT

 K VLOCBTOT,VLOCTTOT,ZTDESC,ZTRTN,ZTSAVE

 Q

FOOTER ;

 Q:$G(BAR("F1"))

 I $D(BAR("UN-ALLOCATED")) D

 .S X=""

 .K BAR("DUZ")

 .S X=$O(BAR("UN-ALLOCATED",X))

 .S BAR("DUZ")=$P(BAR("UN-ALLOCATED",X),U,2)

 .S BAR("COL")="W !!?10,""** Unallocated for Collection Batch "",$P($G(^BARCOL(BAR(""DUZ""),BARTR(""B""),0)),U),"" **"",!!"

 .D PAZ^BARRUTL

 .D HDB^BARRADJ2

 .S BAR("UN")=""

 .F  S BAR("UN")=$O(BAR("UN-ALLOCATED",BAR("UN"))) Q:'BAR("UN")  D

 ..W !?15,"ITEM",?30,$J(BAR("UN"),3),?40,$J($FN($P(BAR("UN-ALLOCATED",BAR("UN")),U),",",2),10)

 ..S BAR("UNT")=$G(BAR("UNT"))+$P(BAR("UN-ALLOCATED",BAR("UN")),U)

 .W !?40,"----------"

 .W !?40,$J($FN(BAR("UNT"),",",2),10)

 I $D(BAR("ST")) D

 .;IHS/SD/AR 1.8*19

 .K BAR("ST")

 .W !!!!?16,"*****  R E P O R T  C O M P L E T E  *****"

 .D PAZ^BARRUTL

 Q

BARRADJ0  ; IHS/SD/POT - TRANSACTION/ADJUSTMENT REPORT - OVERFLOW CODE; 08/20/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69

 +2       ;NEW ROUTINE: OVERFLOW CODE FROM BARRADJ

 +3       ;IHS/SD/POT 01/15/14 HEAT124730 ADDING DOS TO TEXT DELIM REPORT 

 +4       ;           

 +5        QUIT 

CLEANUP   ;  Cleanup TSR vars

 +1        KILL ^TMP($JOB,"BAR-"_BAR("SUBR"))

 +2        KILL ^TMP($JOB,"BAR-TSR")

 +3        KILL ^TMP($JOB,"BAR-TSRS")

 +4        KILL ^TMP($JOB,"BAR-TSRS-INS")

 +5        KILL ADJTBTOT,ADJTTTOT,ARBTOT,ARTTOT

 +6        KILL BAR,BARBILL,BARBILLO,BARDASH,BARDLMTD,BARDUZ2,BAREQUAL,BARHLD,BARI,BARP

 +7        KILL BARPREV,BARTEXT,BARTR,BARY,BILL

 +8        KILL CNT,DEBUG,DIROUT,DTOUT,DUOUT,FILL,GRANBILL,GRANTRAN,INSURER

 +9        KILL OFFSET,SORTBTOT,SORTTTOT,SUBS,SUBTOT,SUMMARY,TOTBILLS,TRANBTOT,TRANTTOT,TT

 +10       KILL VLOCBTOT,VLOCTTOT,ZTDESC,ZTRTN,ZTSAVE

 +11       QUIT 

FOOTER    ;

 +1        IF $GET(BAR("F1"))

               QUIT 

 +2        IF $DATA(BAR("UN-ALLOCATED"))

               Begin DoDot:1

 +3                SET X=""

 +4                KILL BAR("DUZ")

 +5                SET X=$ORDER(BAR("UN-ALLOCATED",X))

 +6                SET BAR("DUZ")=$PIECE(BAR("UN-ALLOCATED",X),U,2)

 +7                SET BAR("COL")="W !!?10,""** Unallocated for Collection Batch "",$P($G(^BARCOL(BAR(""DUZ""),BARTR(""B""),0)),U),"" **"",!!"

 +8                DO PAZ^BARRUTL

 +9                DO HDB^BARRADJ2

 +10               SET BAR("UN")=""

 +11               FOR 

                       SET BAR("UN")=$ORDER(BAR("UN-ALLOCATED",BAR("UN")))

                       IF 'BAR("UN")

                           QUIT 

                       Begin DoDot:2

 +12                       WRITE !?15,"ITEM",?30,$JUSTIFY(BAR("UN"),3),?40,$JUSTIFY($FNUMBER($PIECE(BAR("UN-ALLOCATED",BAR("UN")),U),",",2),10)

 +13                       SET BAR("UNT")=$GET(BAR("UNT"))+$PIECE(BAR("UN-ALLOCATED",BAR("UN")),U)

                       End DoDot:2

 +14               WRITE !?40,"----------"

 +15               WRITE !?40,$JUSTIFY($FNUMBER(BAR("UNT"),",",2),10)

               End DoDot:1

 +16       IF $DATA(BAR("ST"))

               Begin DoDot:1

 +17      ;IHS/SD/AR 1.8*19

 +18               KILL BAR("ST")

 +19               WRITE !!!!?16,"*****  R E P O R T  C O M P L E T E  *****"

 +20               DO PAZ^BARRUTL

               End DoDot:1

 +21       QUIT