BARRTBS1.m

BARRTBS1 ; IHS/SD/TPF - TREASURY DEPOSIT/BATCH STATISTICAL LISTING RPT ;08/20/2008

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

 ; IHS/SD/PKD 1.8*19 7/30/10  Cut and copied from BARRTBSL which became too large for SAC 

 ;

PRINT ;EP - PRINT REPORT

 N BAREQUAL,SORTSUB,BATCHNM,BARITMDA,DATA,ITEMTDN

 ;COLLECTION BATCH COLUMN TOTALS

 S (BAT1TOT,BAT2TOT,BAT3TOT,BAT4TOT,BAT5TOT,BAT6TOT,BAT7TOT)=0

 ;ALLOWANCE OR TDN COLUMN TOTALS

 S (ALORTDN1,ALORTDN2,ALORTDN3,ALORTDN4,ALORTDN5,ALORTDN6,ALORTDN7)=0

 ;COLUMN GRAND TOTAL

 S (GRND1TOT,GRND2TOT,GRND3TOT,GRND4TOT,GRND5TOT,GRND6TOT,GRND7TOT)=0

 ;

 S Y=BARFROM X ^DD("DD") S EXFROM=Y

 S Y=BARTO X ^DD("DD") S EXTO=Y

 S $P(BAREQUAL,"=",IOM+1)=""

 D NOW^%DTC

 S Y=% X ^DD("DD") S NOW=Y

 S NOW=Y

 S PAGE=0,ESC=0

 D TOPHDR

 S SORTSUB=""  ;THIS SUBSCRIPT COULD BE TDN/IPAC OR ALLOWANCE CATEGORY

 F  S SORTSUB=$O(^XTMP("BARRTBSL",$J,SORTSUB)) Q:SORTSUB=""!ESC  D

 .I $Y>(IOSL-11) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR S ESC=X=U Q:ESC  D TOPHDR

 .W !!,$S(SORTTYP="TDN":"TDN/IPAC: ",1:"ALLOWANCE CATEGORY: ")

 .W SORTSUB

 .S (ALORTDN1,ALORTDN2,ALORTDN3,ALORTDN4,ALORTDN5,ALORTDN6,ALORTDN7)=0

 .S BATCHNM=""

 .F  S BATCHNM=$O(^XTMP("BARRTBSL",$J,SORTSUB,BATCHNM)) Q:BATCHNM=""!ESC  D

 ..S (BAT1TOT,BAT2TOT,BAT3TOT,BAT4TOT,BAT5TOT,BAT6TOT,BAT7TOT)=0

 ..S BARITMDA=""

 ..F CNT=1:1 S BARITMDA=$O(^XTMP("BARRTBSL",$J,SORTSUB,BATCHNM,BARITMDA)) Q:BARITMDA=""!ESC  D

 ...S DATA=$G(^XTMP("BARRTBSL",$J,SORTSUB,BATCHNM,BARITMDA))

 ...I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR S ESC=X=U Q:ESC  D TOPHDR

 ...I CNT=1 D  Q:ESC

 ....I $Y>(IOSL-7) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR S ESC=X=U Q:ESC  D TOPHDR

 ....W !,"COLLECTION ID: "_$P(DATA,U)

 ....W !,$P(BATCHNM,"-",2,999)_"-"_" "_$P(DATA,U,10)

 ....I $P(DATA,U,2)["~" W ?20,"TDN: ",$TR($P(DATA,U,2),"~")

 ...W !,"ITEM "_BARITMDA_": ",$TR($P(DATA,U,2),"~")

 ...W !,$J($P(DATA,U,3),10,2)

 ...W ?12,$J($P(DATA,U,4),10,2)

 ...W ?24,$J($P(DATA,U,5),10,2)

 ...W ?34,$J($P(DATA,U,6),10,2)

 ...W ?46,$J($P(DATA,U,7),10,2)

 ...W ?58,$J($P(DATA,U,8),10,2)

 ...W ?70,$J($P(DATA,U,9),10,2)

 ...S BAT1TOT=BAT1TOT+$P(DATA,U,3)

 ...S BAT2TOT=BAT2TOT+$P(DATA,U,4)

 ...S BAT3TOT=BAT3TOT+$P(DATA,U,5)

 ...S BAT4TOT=BAT4TOT+$P(DATA,U,6)

 ...S BAT5TOT=BAT5TOT+$P(DATA,U,7)

 ...S BAT6TOT=BAT6TOT+$P(DATA,U,8)

 ...S BAT7TOT=BAT7TOT+$P(DATA,U,9)

 ...S ALORTDN1=ALORTDN1+$P(DATA,U,3)

 ...S ALORTDN2=ALORTDN2+$P(DATA,U,4)

 ...S ALORTDN3=ALORTDN3+$P(DATA,U,5)

 ...S ALORTDN4=ALORTDN4+$P(DATA,U,6)

 ...S ALORTDN5=ALORTDN5+$P(DATA,U,7)

 ...S ALORTDN6=ALORTDN6+$P(DATA,U,8)

 ...S ALORTDN7=ALORTDN7+$P(DATA,U,9)

 ..Q:ESC

 ..W !,"BATCH TOTAL:"

 ..W !,"----------",?12,"----------",?24,"----------",?34,"----------",?46,"----------",?58,"----------",?70,"----------"

 ..W !,$J(BAT1TOT,10,2),?12,$J(BAT2TOT,10,2),?24,$J(BAT3TOT,10,2),$J(BAT4TOT,10,2),?46,$J(BAT5TOT,10,2),?58,$J(BAT6TOT,10,2),?70,$J(BAT7TOT,10,2)

 ..W !!

 .Q:ESC

 .W !,$S(SORTTYP="ALLOW":"ALLOWANCE",1:"TDN")," TOTAL: "

 .W !,"----------",?12,"----------",?24,"----------",?34,"----------",?46,"----------",?58,"----------",?70,"----------"

 .W !,$J(ALORTDN1,10,2),?12,$J(ALORTDN2,10,2),?24,$J(ALORTDN3,10,2),?34,$J(ALORTDN4,10,2),?46,$J(ALORTDN5,10,2),?58,$J(ALORTDN6,10,2),?70,$J(ALORTDN7,10,2)

 .W !!

 .S GRND1TOT=GRND1TOT+ALORTDN1

 .S GRND2TOT=GRND2TOT+ALORTDN2

 .S GRND3TOT=GRND3TOT+ALORTDN3

 .S GRND4TOT=GRND4TOT+ALORTDN4

 .S GRND5TOT=GRND5TOT+ALORTDN5

 .S GRND6TOT=GRND6TOT+ALORTDN6

 .S GRND7TOT=GRND7TOT+ALORTDN7

 Q:ESC

 W !,"GRAND TOTALS: "

 W !,"==========",?12,"==========",?24,"==========",?34,"==========",?46,"==========",?58,"==========",?70,"=========="

 W !,$J(GRND1TOT,10,2),?12,$J(GRND2TOT,10,2),?24,$J(GRND3TOT,10,2),?34,$J(GRND4TOT,10,2),?46,$J(GRND5TOT,10,2),?58,$J(GRND6TOT,10,2),?70,$J(GRND7TOT,10,2)

 W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR W @IOF

 Q

PRINTNI ;EP - PRINT REPORT

 N BAREQUAL,SORTSUB,SORTSUB2,BATCHNM,BARITMDA,DATA,ITEMTDN

 ;COLLECTION BATCH COLUMN TOTALS

 S (BAT1TOT,BAT2TOT,BAT3TOT,BAT4TOT,BAT5TOT,BAT6TOT,BAT7TOT)=0

 ;TDN COLUMN TOTALS

 S (TDN1,TDN2,TDN3,TDN4,TDN5,TDN6,TDN7)=0

 ;ALLOWANCE COLUMN TOTALS

 S (AL1,AL2,AL3,AL4,AL5,AL6,AL7)=0

 ;COLUMN GRAND TOTAL

 S (GRND1TOT,GRND2TOT,GRND3TOT,GRND4TOT,GRND5TOT,GRND6TOT,GRND7TOT)=0

 ;

 S Y=BARFROM X ^DD("DD") S EXFROM=Y

 S Y=BARTO X ^DD("DD") S EXTO=Y

 S $P(BAREQUAL,"=",IOM+1)=""

 D NOW^%DTC

 S Y=% X ^DD("DD") S NOW=Y

 S NOW=Y

 S PAGE=0,ESC=0

 D TOPHDR

 S SORTSUB="",SORTSUB2="",BATDNDT=""  ;THIS SUBSCRIPT COULD BE TDN/IPAC OR ALLOWANCE CATEGORY

 F  S SORTSUB=$O(^XTMP("BARRTBSL",$J,SORTSUB)) Q:SORTSUB=""!ESC  D

 .I $Y>(IOSL-11) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR S ESC=X=U Q:ESC  D TOPHDR

 .W !!,$S(BARSORT=4:"TDN/IPAC: ",1:"ALLOWANCE CATEGORY: ")

 .W SORTSUB

 .I BARSORT=3  S (AL1,AL2,AL3,AL4,AL5,AL6,AL7)=0

 .I BARSORT=4  S (TDN1,TDN2,TDN3,TDN4,TDN5,TDN6,TDN7)=0

 .S SORTNUM=0

 .F  S SORTSUB2=$O(^XTMP("BARRTBSL",$J,SORTSUB,SORTSUB2)) Q:SORTSUB2=""!ESC  D

 ..F  S BATDNDT=$O(^XTMP("BARRTBSL",$J,SORTSUB,SORTSUB2,BATDNDT)) Q:BATDNDT=""!ESC  D

 ...I (SORTNUM=0)&(BARSORT=4)  W " TDN DATE: ",BATDNDT

 ...S SORTNUM=1

 ...W !,$S(BARSORT=3:"TDN/IPAC: ",1:"ALLOWANCE CATEGORY: ")

 ...W SORTSUB2

 ...I BARSORT=4  S (AL1,AL2,AL3,AL4,AL5,AL6,AL7)=0

 ...I BARSORT=3  D

 ....S (TDN1,TDN2,TDN3,TDN4,TDN5,TDN6,TDN7)=0

 ....W " TDN DATE: ",BATDNDT

 ...S BATCHNM=""

 ...F  S BATCHNM=$O(^XTMP("BARRTBSL",$J,SORTSUB,SORTSUB2,BATDNDT,BATCHNM)) Q:BATCHNM=""!ESC  D

 ....S (BAT1TOT,BAT2TOT,BAT3TOT,BAT4TOT,BAT5TOT,BAT6TOT,BAT7TOT)=0

 ....S BARITMDA=""

 ....F CNT=1:1 S BARITMDA=$O(^XTMP("BARRTBSL",$J,SORTSUB,SORTSUB2,BATDNDT,BATCHNM,BARITMDA)) Q:BARITMDA=""!ESC  D

 .....S DATA=$G(^XTMP("BARRTBSL",$J,SORTSUB,SORTSUB2,BATDNDT,BATCHNM,BARITMDA))

 .....I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR S ESC=X=U Q:ESC  D TOPHDR

 .....I CNT=1 D  Q:ESC

 ......I $Y>(IOSL-7) W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR S ESC=X=U Q:ESC  D TOPHDR

 ......W !,$P(DATA,U)_"-"_$P(BATCHNM,"-",2,999)_"-"_" "_$P(DATA,U,10)

 .....S BAT1TOT=BAT1TOT+$P(DATA,U,3)

 .....S BAT2TOT=BAT2TOT+$P(DATA,U,4)

 .....S BAT3TOT=BAT3TOT+$P(DATA,U,5)

 .....S BAT4TOT=BAT4TOT+$P(DATA,U,6)

 .....S BAT5TOT=BAT5TOT+$P(DATA,U,7)

 .....S BAT6TOT=BAT6TOT+$P(DATA,U,8)

 .....S BAT7TOT=BAT7TOT+$P(DATA,U,9)

 .....S TDN1=TDN1+$P(DATA,U,3)

 .....S TDN2=TDN2+$P(DATA,U,4)

 .....S TDN3=TDN3+$P(DATA,U,5)

 .....S TDN4=TDN4+$P(DATA,U,6)

 .....S TDN5=TDN5+$P(DATA,U,7)

 .....S TDN6=TDN6+$P(DATA,U,8)

 .....S TDN7=TDN7+$P(DATA,U,9)

 .....S AL1=AL1+$P(DATA,U,3)

 .....S AL2=AL2+$P(DATA,U,4)

 .....S AL3=AL3+$P(DATA,U,5)

 .....S AL4=AL4+$P(DATA,U,6)

 .....S AL5=AL5+$P(DATA,U,7)

 .....S AL6=AL6+$P(DATA,U,8)

 .....S AL7=AL7+$P(DATA,U,9)

 ....Q:ESC

 ....W !,"----------",?12,"----------",?24,"----------",?34,"----------",?46,"----------",?58,"----------",?70,"----------"

 ....W !,$J(BAT1TOT,10,2),?12,$J(BAT2TOT,10,2),?24,$J(BAT3TOT,10,2),$J(BAT4TOT,10,2),?46,$J(BAT5TOT,10,2),?58,$J(BAT6TOT,10,2),?70,$J(BAT7TOT,10,2)

 ....W !!

 ...Q:ESC

 ..W !,$S(BARSORT=3:"TDN",1:"ALLOWANCE")," TOTAL: "

 ..W !,"----------",?12,"----------",?24,"----------",?34,"----------",?46,"----------",?58,"----------",?70,"----------"

 ..I BARSORT=4  D

 ...W !,$J(AL1,10,2),?12,$J(AL2,10,2),?24,$J(AL3,10,2),?34,$J(AL4,10,2),?46,$J(AL5,10,2),?58,$J(AL6,10,2),?70,$J(AL7,10,2)

 ..I BARSORT=3  D

 ...W !,$J(TDN1,10,2),?12,$J(TDN2,10,2),?24,$J(TDN3,10,2),?34,$J(TDN4,10,2),?46,$J(TDN5,10,2),?58,$J(TDN6,10,2),?70,$J(TDN7,10,2)

 ..W !!

 .Q:ESC

 .W !,$S(BARSORT=3:"ALLOWANCE",1:"TDN")," TOTAL: "

 .W !,"----------",?12,"----------",?24,"----------",?34,"----------",?46,"----------",?58,"----------",?70,"----------"

 .I BARSORT=3  D

 ..W !,$J(AL1,10,2),?12,$J(AL2,10,2),?24,$J(AL3,10,2),?34,$J(AL4,10,2),?46,$J(AL5,10,2),?58,$J(AL6,10,2),?70,$J(AL7,10,2)

 .I BARSORT=4  D

 ..W !,$J(TDN1,10,2),?12,$J(TDN2,10,2),?24,$J(TDN3,10,2),?34,$J(TDN4,10,2),?46,$J(TDN5,10,2),?58,$J(TDN6,10,2),?70,$J(TDN7,10,2)

 .W !!

 .I BARSORT=3  D

 ..S GRND1TOT=GRND1TOT+AL1

 ..S GRND2TOT=GRND2TOT+AL2

 ..S GRND3TOT=GRND3TOT+AL3

 ..S GRND4TOT=GRND4TOT+AL4

 ..S GRND5TOT=GRND5TOT+AL5

 ..S GRND6TOT=GRND6TOT+AL6

 ..S GRND7TOT=GRND7TOT+AL7

 .I BARSORT=4  D

 ..S GRND1TOT=GRND1TOT+TDN1

 ..S GRND2TOT=GRND2TOT+TDN2

 ..S GRND3TOT=GRND3TOT+TDN3

 ..S GRND4TOT=GRND4TOT+TDN4

 ..S GRND5TOT=GRND5TOT+TDN5

 ..S GRND6TOT=GRND6TOT+TDN6

 ..S GRND7TOT=GRND7TOT+TDN7

 Q:ESC

 W !,"GRAND TOTALS: "

 W !,"==========",?12,"==========",?24,"==========",?34,"==========",?46,"==========",?58,"==========",?70,"=========="

 W !,$J(GRND1TOT,10,2),?12,$J(GRND2TOT,10,2),?24,$J(GRND3TOT,10,2),?34,$J(GRND4TOT,10,2),?46,$J(GRND5TOT,10,2),?58,$J(GRND6TOT,10,2),?70,$J(GRND7TOT,10,2)

 W ! K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)&'$D(IO("S"))) ^DIR W @IOF

 Q

 ;

TOPHDR ;EP - TOP HEADER

 W @IOF

 S PAGE=PAGE+1

 W !,"DATE: ",NOW W ?IOM-10,"PAGE ",PAGE

 W !,$$CJ^XLFSTR("TREASURY DEPOSIT/BATCH STATISTICS FOR",IOM)

 W !,$$CJ^XLFSTR($P(^DIC(4,DUZ(2),0),"^"),IOM)

 W !,$$CJ^XLFSTR("FROM "_EXFROM_" TO "_EXTO,IOM)

 W !,$$CJ^XLFSTR("SORTED BY "_$S(SORTTYP="TDN":"TREASURY DEPOSIT NUMBER/IPAC",1:"ALLOWANCE CATEGORY"),IOM)

 I SORTTYP="ALLOW" D

 .S STR="ALLOWANCES CHOSEN: "

 .I $D(ALLOW)=10 D

 ..S AL="" F  S AL=$O(ALLOW(AL)) Q:AL=""  S STR=STR_AL_","

 ..S STR=$E(STR,1,$L(STR)-1)

 .E  S STR=STR_"ALL"

 .W !,$$CJ^XLFSTR(STR,IOM)

 W !

 D ITEMHDR

 Q

ITEMHDR ;EP - ITEM HEADER

 ;W !,"BATCH DATE"

 ;IHS/SD/AR PATCH 19 06/04/2010

 I (BARSORT=1)!(BARSORT=2)  D

 . W !?3,"ITEM"

 . W ?13,"COLLECTIONS"

 . W ?30,"UNALLOCATED"

 . W ?49,"REFUNDED"

 . W ?62,"ITEM"

 . ;W !,"-SEQ-BS"

 . W !?3,"TOTAL"

 . W ?13,"PROCESSED"

 . W ?29,"TRUE      TOTAL"

 . W ?49,"FROM ITEM"

 . W ?62,"TRANSFER"

 . W ?73,"BALANCE"

 I (BARSORT=3)!(BARSORT=4)  D

 . W !?3,"BATCH"

 . W ?13,"COLLECTIONS"

 . W ?30,"UNALLOCATED"

 . W ?49,"REFUNDED"

 . W ?62,"BATCH"

 . ;W !,"-SEQ-BS"

 . W !?3,"TOTAL"

 . W ?13,"PROCESSED"

 . W ?29,"TRUE      TOTAL"

 . W ?49,"FROM BATCH"

 . W ?62,"TRANSFER"

 . W ?73,"BALANCE"

 W !,BAREQUAL

 Q

 ;

DATACHEK ;EP- FOR TESTING ONLY

 ;ITMPSTOT_U_U_ITMUNALL_U_ITMREFUN_U_ITMPSBAL_U_ITMTOTTR

 S (GRND1TOT,GRND2TOT,GRND3TOT,GRND4TOT,GRND5TOT,GRND6TOT,GRND7TOT,GRND8TOT,GRND9TOT,GRND0TOT,GRND11TT)=0

 S DATETIME=""

 F  S DATETIME=$O(^BARCOL(DUZ(2),"C",DATETIME)) Q:'DATETIME  D

 .S BARCOLDA=""

 .F  S BARCOLDA=$O(^BARCOL(DUZ(2),"C",DATETIME,BARCOLDA)) Q:'BARCOLDA  D

 ..S COLIENS=BARCOLDA_","

 ..S BARITMDA=0

 ..F  S BARITMDA=$O(^BARCOL(DUZ(2),BARCOLDA,1,BARITMDA)) Q:'BARITMDA  D

 ...S ITEMIENS=BARITMDA_","_BARCOLDA_","

 ...S ITMPSTOT=$$GET1^DIQ(90051.1101,ITEMIENS,18,"E")  ;ITEM POSTING TOTAL ;1ST COLUMN

 ...S ITMUNALL=$$GET1^DIQ(90051.1101,ITEMIENS,105,"E")  ;ITEM UN-ALLOCATED  ;3RD COLUMN

 ...S ITMREFUN=$$GET1^DIQ(90051.1101,ITEMIENS,106,"E")  ;ITEM REFUNDED      ;4TH COLUMN

 ...S ITMPSBAL=$$GET1^DIQ(90051.1101,ITEMIENS,19,"E")  ;ITEM POSTING BALANCE ;5TH COLUMN

 ...S ITMTOTTR=$$GET1^DIQ(90051.1101,ITEMIENS,22,"E")  ;ITEM TOTAL TRANSFER  ;6TH COLUMN

 ...;

 ...;NOT PULLED YET

 ...S ITMREIMB=$$GET1^DIQ(90051.1101,ITEMIENS,21,"E")  ;ITEM TOTAL REIMBURSEMENT

 ...S ITMCRDEB=$$GET1^DIQ(90051.1101,ITEMIENS,102.5,"E") ;CREDIT-DEBIT

 ...S ITMPOST=$$GET1^DIQ(90051.1101,ITEMIENS,23,"E")  ;ITEM POSTABLE AMOUNT

 ...S SUBEOB=$$GET1^DIQ(90051.1101,ITEMIENS,202,"E")  ;SUB EOB TOTAL

 ...S EOBBAL=$$GET1^DIQ(90051.1101,ITEMIENS,202.5,"E")  ;SUB EOB BALANCE

 ...S GRND1TOT=GRND1TOT+ITMPSTOT

 ...;SECOND NOT PULLED

 ...S GRND3TOT=GRND3TOT+ITMUNALL

 ...S GRND4TOT=GRND4TOT+ITMREFUN

 ...S GRND5TOT=GRND5TOT+ITMPSBAL

 ...S GRND6TOT=GRND6TOT+ITMTOTTR

 ...;

 ...S GRND7TOT=GRND7TOT+ITMREIMB

 ...S GRND8TOT=GRND8TOT+ITMCRDEB

 ...S GRND9TOT=GRND9TOT+ITMPOST

 ...S GRND0TOT=GRND0TOT+SUBEOB

 ...S GRND11TT=GRND11TT+EOBBAL

 W !!,"ITEM POSTING TOTAL (1): ",GRND1TOT

 W !,"ITEM UN-ALLOCATED (3): ",GRND3TOT

 W !,"ITEM REFUNDED (4): ",GRND4TOT

 W !,"ITEM POSTING BALANCE (5): ",GRND5TOT

 W !,"ITEM TOTAL TRANSFER (6): ",GRND6TOT

 ;

 W !,"ITEM TOTAL REIMBURSEMENT: ",GRND7TOT

 W !,"CREDIT-DEBIT :",GRND8TOT

 W !,"ITEM POSTABLE AMOUNT: ",GRND9TOT

 W !,"SUB EOB TOTAL: ",GRND0TOT

 W !,"SUB EOB BALANCE: ",GRND11TT

 Q

BARRTBS1  ; IHS/SD/TPF - TREASURY DEPOSIT/BATCH STATISTICAL LISTING RPT ;08/20/2008

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

 +2       ; IHS/SD/PKD 1.8*19 7/30/10  Cut and copied from BARRTBSL which became too large for SAC 

 +3       ;

PRINT     ;EP - PRINT REPORT

 +1        NEW BAREQUAL,SORTSUB,BATCHNM,BARITMDA,DATA,ITEMTDN

 +2       ;COLLECTION BATCH COLUMN TOTALS

 +3        SET (BAT1TOT,BAT2TOT,BAT3TOT,BAT4TOT,BAT5TOT,BAT6TOT,BAT7TOT)=0

 +4       ;ALLOWANCE OR TDN COLUMN TOTALS

 +5        SET (ALORTDN1,ALORTDN2,ALORTDN3,ALORTDN4,ALORTDN5,ALORTDN6,ALORTDN7)=0

 +6       ;COLUMN GRAND TOTAL

 +7        SET (GRND1TOT,GRND2TOT,GRND3TOT,GRND4TOT,GRND5TOT,GRND6TOT,GRND7TOT)=0

 +8       ;

 +9        SET Y=BARFROM

           XECUTE ^DD("DD")

           SET EXFROM=Y

 +10       SET Y=BARTO

           XECUTE ^DD("DD")

           SET EXTO=Y

 +11       SET $PIECE(BAREQUAL,"=",IOM+1)=""

 +12       DO NOW^%DTC

 +13       SET Y=%

           XECUTE ^DD("DD")

           SET NOW=Y

 +14       SET NOW=Y

 +15       SET PAGE=0

           SET ESC=0

 +16       DO TOPHDR

 +17      ;THIS SUBSCRIPT COULD BE TDN/IPAC OR ALLOWANCE CATEGORY

           SET SORTSUB=""

 +18       FOR 

               SET SORTSUB=$ORDER(^XTMP("BARRTBSL",$JOB,SORTSUB))

               IF SORTSUB=""!ESC

                   QUIT 

               Begin DoDot:1

 +19               IF $Y>(IOSL-11)

                       WRITE !

                       KILL DIR

                       SET DIR(0)="E"

                       IF '$DATA(ZTQUEUED)&(IO=IO(0)&'$DATA(IO("S")))

                           DO ^DIR

                       SET ESC=X=U

                       IF ESC

                           QUIT 

                       DO TOPHDR

 +20               WRITE !!,$SELECT(SORTTYP="TDN":"TDN/IPAC: ",1:"ALLOWANCE CATEGORY: ")

 +21               WRITE SORTSUB

 +22               SET (ALORTDN1,ALORTDN2,ALORTDN3,ALORTDN4,ALORTDN5,ALORTDN6,ALORTDN7)=0

 +23               SET BATCHNM=""

 +24               FOR 

                       SET BATCHNM=$ORDER(^XTMP("BARRTBSL",$JOB,SORTSUB,BATCHNM))

                       IF BATCHNM=""!ESC

                           QUIT 

                       Begin DoDot:2

 +25                       SET (BAT1TOT,BAT2TOT,BAT3TOT,BAT4TOT,BAT5TOT,BAT6TOT,BAT7TOT)=0

 +26                       SET BARITMDA=""

 +27                       FOR CNT=1:1

                               SET BARITMDA=$ORDER(^XTMP("BARRTBSL",$JOB,SORTSUB,BATCHNM,BARITMDA))

                               IF BARITMDA=""!ESC

                                   QUIT 

                               Begin DoDot:3

 +28                               SET DATA=$GET(^XTMP("BARRTBSL",$JOB,SORTSUB,BATCHNM,BARITMDA))

 +29                               IF $Y>(IOSL-4)

                                       WRITE !

                                       KILL DIR

                                       SET DIR(0)="E"

                                       IF '$DATA(ZTQUEUED)&(IO=IO(0)&'$DATA(IO("S")))

                                           DO ^DIR

                                       SET ESC=X=U

                                       IF ESC

                                           QUIT 

                                       DO TOPHDR

 +30                               IF CNT=1

                                       Begin DoDot:4

 +31                                       IF $Y>(IOSL-7)

                                               WRITE !

                                               KILL DIR

                                               SET DIR(0)="E"

                                               IF '$DATA(ZTQUEUED)&(IO=IO(0)&'$DATA(IO("S")))

                                                   DO ^DIR

                                               SET ESC=X=U

                                               IF ESC

                                                   QUIT 

                                               DO TOPHDR

 +32                                       WRITE !,"COLLECTION ID: "_$PIECE(DATA,U)

 +33                                       WRITE !,$PIECE(BATCHNM,"-",2,999)_"-"_" "_$PIECE(DATA,U,10)

 +34                                       IF $PIECE(DATA,U,2)["~"

                                               WRITE ?20,"TDN: ",$TRANSLATE($PIECE(DATA,U,2),"~")

                                       End DoDot:4

                                       IF ESC

                                           QUIT 

 +35                               WRITE !,"ITEM "_BARITMDA_": ",$TRANSLATE($PIECE(DATA,U,2),"~")

 +36                               WRITE !,$JUSTIFY($PIECE(DATA,U,3),10,2)

 +37                               WRITE ?12,$JUSTIFY($PIECE(DATA,U,4),10,2)

 +38                               WRITE ?24,$JUSTIFY($PIECE(DATA,U,5),10,2)

 +39                               WRITE ?34,$JUSTIFY($PIECE(DATA,U,6),10,2)

 +40                               WRITE ?46,$JUSTIFY($PIECE(DATA,U,7),10,2)

 +41                               WRITE ?58,$JUSTIFY($PIECE(DATA,U,8),10,2)

 +42                               WRITE ?70,$JUSTIFY($PIECE(DATA,U,9),10,2)

 +43                               SET BAT1TOT=BAT1TOT+$PIECE(DATA,U,3)

 +44                               SET BAT2TOT=BAT2TOT+$PIECE(DATA,U,4)

 +45                               SET BAT3TOT=BAT3TOT+$PIECE(DATA,U,5)

 +46                               SET BAT4TOT=BAT4TOT+$PIECE(DATA,U,6)

 +47                               SET BAT5TOT=BAT5TOT+$PIECE(DATA,U,7)

 +48                               SET BAT6TOT=BAT6TOT+$PIECE(DATA,U,8)

 +49                               SET BAT7TOT=BAT7TOT+$PIECE(DATA,U,9)

 +50                               SET ALORTDN1=ALORTDN1+$PIECE(DATA,U,3)

 +51                               SET ALORTDN2=ALORTDN2+$PIECE(DATA,U,4)

 +52                               SET ALORTDN3=ALORTDN3+$PIECE(DATA,U,5)

 +53                               SET ALORTDN4=ALORTDN4+$PIECE(DATA,U,6)

 +54                               SET ALORTDN5=ALORTDN5+$PIECE(DATA,U,7)

 +55                               SET ALORTDN6=ALORTDN6+$PIECE(DATA,U,8)

 +56                               SET ALORTDN7=ALORTDN7+$PIECE(DATA,U,9)

                               End DoDot:3

 +57                       IF ESC

                               QUIT 

 +58                       WRITE !,"BATCH TOTAL:"

 +59                       WRITE !,"----------",?12,"----------",?24,"----------",?34,"----------",?46,"----------",?58,"----------",?70,"----------"

 +60                       WRITE !,$JUSTIFY(BAT1TOT,10,2),?12,$JUSTIFY(BAT2TOT,10,2),?24,$JUSTIFY(BAT3TOT,10,2),$JUSTIFY(BAT4TOT,10,2),?46,$JUSTIFY(BAT5TOT,10,2),?58,$JUSTIFY(BAT6TOT,10,2),?70,$JUSTIFY(BAT7TOT,10,2)

 +61                       WRITE !!

                       End DoDot:2

 +62               IF ESC

                       QUIT 

 +63               WRITE !,$SELECT(SORTTYP="ALLOW":"ALLOWANCE",1:"TDN")," TOTAL: "

 +64               WRITE !,"----------",?12,"----------",?24,"----------",?34,"----------",?46,"----------",?58,"----------",?70,"----------"

 +65               WRITE !,$JUSTIFY(ALORTDN1,10,2),?12,$JUSTIFY(ALORTDN2,10,2),?24,$JUSTIFY(ALORTDN3,10,2),?34,$JUSTIFY(ALORTDN4,10,2),?46,$JUSTIFY(ALORTDN5,10,2),?58,$JUSTIFY(ALORTDN6,10,2),?70,$JUSTIFY(ALORTDN7,10,2)

 +66               WRITE !!

 +67               SET GRND1TOT=GRND1TOT+ALORTDN1

 +68               SET GRND2TOT=GRND2TOT+ALORTDN2

 +69               SET GRND3TOT=GRND3TOT+ALORTDN3

 +70               SET GRND4TOT=GRND4TOT+ALORTDN4

 +71               SET GRND5TOT=GRND5TOT+ALORTDN5

 +72               SET GRND6TOT=GRND6TOT+ALORTDN6

 +73               SET GRND7TOT=GRND7TOT+ALORTDN7

               End DoDot:1

 +74       IF ESC

               QUIT 

 +75       WRITE !,"GRAND TOTALS: "

 +76       WRITE !,"==========",?12,"==========",?24,"==========",?34,"==========",?46,"==========",?58,"==========",?70,"=========="

 +77       WRITE !,$JUSTIFY(GRND1TOT,10,2),?12,$JUSTIFY(GRND2TOT,10,2),?24,$JUSTIFY(GRND3TOT,10,2),?34,$JUSTIFY(GRND4TOT,10,2),?46,$JUSTIFY(GRND5TOT,10,2),?58,$JUSTIFY(GRND6TOT,10,2),?70,$JUSTIFY(GRND7TOT,10,2)

 +78       WRITE !

           KILL DIR

           SET DIR(0)="E"

           IF '$DATA(ZTQUEUED)&(IO=IO(0)&'$DATA(IO("S")))

               DO ^DIR

           WRITE @IOF

 +79       QUIT 

PRINTNI   ;EP - PRINT REPORT

 +1        NEW BAREQUAL,SORTSUB,SORTSUB2,BATCHNM,BARITMDA,DATA,ITEMTDN

 +2       ;COLLECTION BATCH COLUMN TOTALS

 +3        SET (BAT1TOT,BAT2TOT,BAT3TOT,BAT4TOT,BAT5TOT,BAT6TOT,BAT7TOT)=0

 +4       ;TDN COLUMN TOTALS

 +5        SET (TDN1,TDN2,TDN3,TDN4,TDN5,TDN6,TDN7)=0

 +6       ;ALLOWANCE COLUMN TOTALS

 +7        SET (AL1,AL2,AL3,AL4,AL5,AL6,AL7)=0

 +8       ;COLUMN GRAND TOTAL

 +9        SET (GRND1TOT,GRND2TOT,GRND3TOT,GRND4TOT,GRND5TOT,GRND6TOT,GRND7TOT)=0

 +10      ;

 +11       SET Y=BARFROM

           XECUTE ^DD("DD")

           SET EXFROM=Y

 +12       SET Y=BARTO

           XECUTE ^DD("DD")

           SET EXTO=Y

 +13       SET $PIECE(BAREQUAL,"=",IOM+1)=""

 +14       DO NOW^%DTC

 +15       SET Y=%

           XECUTE ^DD("DD")

           SET NOW=Y

 +16       SET NOW=Y

 +17       SET PAGE=0

           SET ESC=0

 +18       DO TOPHDR

 +19      ;THIS SUBSCRIPT COULD BE TDN/IPAC OR ALLOWANCE CATEGORY

           SET SORTSUB=""

           SET SORTSUB2=""

           SET BATDNDT=""

 +20       FOR 

               SET SORTSUB=$ORDER(^XTMP("BARRTBSL",$JOB,SORTSUB))

               IF SORTSUB=""!ESC

                   QUIT 

               Begin DoDot:1

 +21               IF $Y>(IOSL-11)

                       WRITE !

                       KILL DIR

                       SET DIR(0)="E"

                       IF '$DATA(ZTQUEUED)&(IO=IO(0)&'$DATA(IO("S")))

                           DO ^DIR

                       SET ESC=X=U

                       IF ESC

                           QUIT 

                       DO TOPHDR

 +22               WRITE !!,$SELECT(BARSORT=4:"TDN/IPAC: ",1:"ALLOWANCE CATEGORY: ")

 +23               WRITE SORTSUB

 +24               IF BARSORT=3

                       SET (AL1,AL2,AL3,AL4,AL5,AL6,AL7)=0

 +25               IF BARSORT=4

                       SET (TDN1,TDN2,TDN3,TDN4,TDN5,TDN6,TDN7)=0

 +26               SET SORTNUM=0

 +27               FOR 

                       SET SORTSUB2=$ORDER(^XTMP("BARRTBSL",$JOB,SORTSUB,SORTSUB2))

                       IF SORTSUB2=""!ESC

                           QUIT 

                       Begin DoDot:2

 +28                       FOR 

                               SET BATDNDT=$ORDER(^XTMP("BARRTBSL",$JOB,SORTSUB,SORTSUB2,BATDNDT))

                               IF BATDNDT=""!ESC

                                   QUIT 

                               Begin DoDot:3