Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARUFRPT

BARUFRPT.m

Go to the documentation of this file. 
  1. BARUFRPT ; IHS/SD/TPF - UFMS DS,NS, TRANSACTION REPORTS ;12/15/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,7,10,20,23**;OCT 26, 2005
  1.  Q
  1.  ;THIS ROUTINE IS CALLED BY
  1.  ;BAR UFMS 'NOT SENT' REPORT
  1.  ;AND BAR UFMS DELAYED SEND REPORT
  1.  ;
  1. NOTSENT(XREF) ;EP - XREF=1 "NS" PRINT NOT SENT, XREF=2 "DS" PRINT DELAYED SEND
  1.  N TRDATE,LINE,NOW,DELDATE,DEBIT,CREDIT,BILL,BLLIEN,ENTRYBY,TPBIEN,TRANTYP,ADJCAT
  1.  N REASON  ;BAR*1.8*4 SCR56,58 PER MEETING OF 11/14/2007
  1.  S:$G(XREF)="" XREF=1
  1.  S:XREF=1 XREF="NS"  ;[BAR UFMS 'NOT SENT' REPORT
  1.  S:XREF=2 XREF="DS"  ;[BAR UFMS DELAYED SEND REPORT
  1.  ;
  1. ASKFROM ;EP - ASK FROM DATE
  1.  K %DT
  1.  S %DT="AET"
  1.  S %DT("A")="Enter beginning transaction date: "
  1.  W !
  1.  D ^%DT
  1.  Q:X=""!(X[U)
  1.  I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKFROM
  1.  S BARFROM=Y
  1. ASKTO ;EP - ASK TO DATE
  1.  K %DT
  1.  S %DT="AET"
  1.  S %DT("A")="Enter ending transaction date: "
  1.  W !
  1.  D ^%DT
  1.  G:X=""!(X[U) ASKFROM
  1.  I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKTO
  1.  S BARTO=Y
  1.  I BARTO<BARFROM W !!,"END DATE MUST BE GREATER THAN BEGINING DATE" H 2 G ASKFROM
  1.  ;
  1. ASKDEV ;EP - ASK DEVICE 
  1.  S %ZIS="MQ"
  1.  W !
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D QUE Q
  1.  U IO
  1.  D PRINT
  1.  D ^%ZISC
  1.  Q
  1. QUE ; EP - QUE 'NOT SENT' OR 'DELAY SEND' REPORT
  1.  S ZTRTN="PRINT^BARUFRPT"
  1.  S ZTDESC=$S(XREF="NS":"NOT SENT ",1:"DELAYED SEND ")_"TRANSACTION REPORT"
  1.  S ZTSAVE("XREF")=""
  1.  S ZTSAVE("BARTO")=""
  1.  S ZTSAVE("BARFROM")=""
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
  1.  E  W !!?5,"Report task #: ",$G(ZTSK)
  1.  D HOME^%ZIS
  1.  Q
  1. PRINT ;EP - ENTRY POINT FOR REPORT
  1.  K BAR("CNT")  ;IHS/SD/SDR 1/25/08
  1.  K BAR("AMT")  ;IHS/SD/SDR 1/25/08
  1.  S $P(LINE,"-",81)=""
  1.  D NOW^%DTC
  1.  S Y=% X ^DD("DD") S NOW=Y
  1.  S NOW=Y
  1.  D NOTHDR(NOW)
  1.  D NOTDET
  1.  S ESC=0
  1.  S BARTO=BARTO_"."_999999  ;IM??? FOUND DURING PATCH 4 TESTING
  1.  S TRDATE=BARFROM-.000001
  1.  F  S TRDATE=$O(^BARSESS(DUZ(2),XREF,TRDATE)) Q:'TRDATE!(ESC)!(TRDATE>BARTO)  D
  1.  .S SESSID=$O(^BARSESS(DUZ(2),XREF,TRDATE,""))
  1.  .S UDUZ=$O(^BARSESS(DUZ(2),XREF,TRDATE,SESSID,""))
  1.  .S APPLYTO=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.05)
  1.  .I XREF="DS" D
  1.  ..S BARFILE=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.08,"E")
  1.  ..;IHS_AR_RPMS_RCV_398_113510_20070702_1430
  1.  ..S DELDATE=$P(BARFILE,"_",7)
  1.  ..S DELDATE=$E(DELDATE,5,6)_"/"_$E(DELDATE,7,8)_"/"_$E(DELDATE,1,4)
  1.  ..S DELTIME=$P($P(BARFILE,"_",8),".")
  1.  ..S DELTIME=$E(DELTIME,1,2)_":"_$E(DELTIME,3,4)
  1.  .S CREDIT=$$GET1^DIQ(90050.03,TRDATE_",",2)
  1.  .S DEBIT=$$GET1^DIQ(90050.03,TRDATE_",",3)
  1.  .S BILL=$$GET1^DIQ(90050.03,TRDATE_",",4)
  1.  .S BLLIEN=$$GET1^DIQ(90050.03,TRDATE_",",4,"I")
  1.  .S ENTRYBY=$$GET1^DIQ(90050.03,TRDATE_",",13,"E")
  1.  .S TPBIEN=$$GET1^DIQ(90050.01,BLLIEN_",",17,"I")
  1.  .S TRANTYP=$$GET1^DIQ(90050.03,TRDATE_",",101,"E")
  1.  .S ADJCAT=$$GET1^DIQ(90050.03,TRDATE_",",102,"E")
  1.  .S REASON=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.09,"E")  ;BAR*1.8*4 SCR56,58 PER MEETING OF 11/14/2007
  1.  .S CREDEB=$$GET1^DIQ(90050.03,TRDATE_",",3.5)
  1.  .S:REASON="" REASON="NOT STATED"   ;MRS:BAR*1.8*6 IM29956
  1.  .S BAR("CNT",REASON)=+$G(BAR("CNT",REASON))+1  ;cnt reasons IHS/SD/SDR 1/25/08
  1.  .S BAR("AMT",REASON)=+$G(BAR("AMT",REASON))+CREDEB  ;cnt amt for reason IHS/SD/SDR 1/25/08
  1.  .W !!,BILL
  1.  .S Y=TRDATE X ^DD("DD") S EXDATE=Y
  1.  .W ?18,EXDATE
  1.  .W ?40,APPLYTO
  1.  .W ?60,REASON  ; IHS/SD/PKD BAR*1.8*20 Tab further 12/21/10
  1.  .W !?10,ENTRYBY
  1.  .W ?30,$J(CREDIT,10,2)
  1.  .W ?40,$J(DEBIT,10,2)
  1.  .W ?52,$E(TRANTYP,1,15)
  1.  .W ?70,$E(ADJCAT,1,10)
  1.  .I XREF="DS" D
  1.  ..W !!?10,"SENT ON "_DELDATE_" AT "_DELTIME
  1.  ..W !?10,"IN FILE "_BARFILE
  1.  .I $Y>(IOSL-4) W ! D:$D(IO("S")) NOTHDR(NOW),NOTDET Q:$D(IO("S"))  K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)) ^DIR S ESC=X=U Q:ESC  D NOTHDR(NOW),NOTDET
  1.  ;start new IHS/SD/SDR 1/25/08
  1.  S REASON=""
  1.  W !!,"Count of entries in Not Sent bucket:"
  1.  F  S REASON=$O(BAR("CNT",REASON)) Q:REASON=""  D
  1.  . W !?5,"Error Code# ",REASON," had ",$P($G(BAR("CNT",REASON)),U)," entries for ",$J($G(BAR("AMT",REASON)),".",2)  ;MRS:BAR*1.8*7
  1.  I '$D(ZTQUEUED)&(IO=IO(0)) D
  1.  . K DIR
  1.  . S DIR(0)="E"
  1.  . W !
  1.  . D ^DIR
  1.  W @IOF
  1.  Q:ESC!$D(IO("S"))
  1.  I '$D(ZTQUEUED)&(IO=IO(0)) D
  1.  .K DIR
  1.  .S DIR(0)="E"
  1.  .W !
  1.  .D ^DIR
  1.  Q
  1.  ;
  1. NOTDET ;EP -
  1.  W !!?3,"A/R BILL"
  1.  W ?18,"TRAN. DATE"
  1.  W ?40,"APPLY TO"
  1.  W ?52,"REASON NOT SENT"  ;BAR*1.8*4 SCR56,58 PER MEETING OF 11/14/2007
  1.  W !?10,"ENTRY BY"
  1.  W ?35,"CREDIT"
  1.  W ?45,"DEBIT"
  1.  W ?52,"TRANTYPE"
  1.  W ?70,"ADJCAT"
  1.  W !,LINE
  1.  Q
  1.  ;
  1. NOTHDR(DATE) ;EP -
  1.  W @IOF
  1.  ;W !,$$CJ^XLFSTR("TRANSACTIONS "_$S(XREF="NS":"NOT SENT",1:"SENT BUT DELAYED")_" BECAUSE THE 3P BILL "_$S(XREF="NS":"HAS",1:"HAD")_" NOT BEEN SENT",IOM)
  1.  W !,$$CJ^XLFSTR("TRANSACTIONS "_$S(XREF="NS":"NOT SENT",1:"SENT BUT DELAYED"),IOM)
  1.  W !,$$CJ^XLFSTR("REPORT DATE: "_DATE,IOM)
  1.  W !,$$CJ^XLFSTR("PRINTED BY : "_$P($G(^VA(200,DUZ,0)),U),IOM)
  1.  W !
  1.  Q
  1.  ;
  1. TRANSRPT ; EP - REPORT OF TRANS SENT TO IE SORTED BY ?
  1.  N ARTRAN,UDUZ,SESSID,LINE,DASH,LINE2
  1.  S $P(DASH,"-",81)=""
  1. ASKFR ;EP - ASK FROM DATE
  1.  K DIR
  1.  S DIR(0)="DO^::EXT"
  1.  S DIR("A")="From Transaction Date"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="")
  1.  S FROM=Y
  1.  S Y=FROM X ^DD("DD") S EXFROM=Y
  1. ASKENDY ;EP - ASK TO DATE
  1.  K DIR
  1.  S DIR(0)="DO^::EXT"
  1.  S DIR("A")="To Transaction Date"
  1.  D ^DIR
  1.  G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="") ASKFR
  1.  S TO=Y
  1.  I TO<FROM W !,"BEGIN DATE CAN NOT BE GREATER THAN END DATE!" H 3 G ASKFR
  1.  S Y=TO X ^DD("DD") S EXTO=Y
  1.  D NOW^%DTC
  1.  S Y=% X ^DD("DD") S NOW=Y
  1.  S NOW=Y
  1.  S ESC=0
  1.  D TRANHDR(NOW)
  1.  D TRANDET
  1.  S UDUZ=0
  1.  F  S UDUZ=$O(^BARSESS(DUZ(2),UDUZ)) Q:'UDUZ!(ESC)  D
  1.  .W !,$E($P($G(^VA(200,UDUZ,0)),U),1,15)
  1.  .S SESSID=0
  1.  .F LINE=1:1 S SESSID=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID)) Q:'SESSID!(ESC)  D
  1.  ..S Y=SESSID X ^DD("DD") S EXSESSID=Y
  1.  ..W:LINE'=1 !
  1.  ..W ?18,EXSESSID
  1.  ..S ARTRAN=FROM-.000001
  1.  ..F LINE2=1:1 S ARTRAN=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,ARTRAN)) Q:'ARTRAN!(ARTRAN>TO)!(ESC)  D
  1.  ...W:LINE2'=1 !
  1.  ...W ?40,ARTRAN
  1.  ...W:LINE2'=1&('$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,ARTRAN))) !
  1.  ...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 TRANHDR(NOW),TRANDET
  1.  Q:ESC!$D(IO("S"))
  1.  I '$D(ZTQUEUED) D
  1.  .K DIR
  1.  .S DIR(0)="E"
  1.  .W !
  1.  .D ^DIR
  1.  Q
  1. TRANHDR(DATE) ;EP -
  1.  W @IOF
  1.  W !,$$CJ^XLFSTR("TRANSACTION REPORT",IOM)
  1.  W !,$$CJ^XLFSTR("REPORT DATE: "_DATE,IOM)
  1.  W !,$$CJ^XLFSTR("PRINTED BY : "_$P($G(^VA(200,DUZ,0)),U),IOM)
  1.  W !,$$CJ^XLFSTR("DATE RANGE FROM : "_EXFROM_" TO "_EXTO,IOM)
  1.  Q
  1. TRANDET ;EP -
  1.  W !!!,"CASHIER"
  1.  W ?18,"SESSION ID"
  1.  W ?40,"TRANSACTION DATE/TIME"
  1.  W !,DASH
  1.  Q
  1.  ;
  1. BATCH ;EP - BATCH REPORT
  1.  N START,END,EXSTART,EXEND,DASH
  1.  S $P(DASH,"-",81)=""
  1. ASKSTART ;EP -
  1.  N LIMIT
  1.  S LIMIT=$$GETDISLM^BARUFUT1("I")
  1.  K DIR
  1.  S DIR(0)="DO^::EXT"
  1.  S DIR("?",1)="Enter a beginning date range for listing files."
  1.  S DIR("?",2)="A file can be identified by the date/time the session or sessions"
  1.  S DIR("?",3)="were sent or transmitted. Since several sessions can be sent"
  1.  S DIR("?",4)="at the same time they are grouped by the transmission date/time"
  1.  S DIR("?",5)="This date/time can identify the file, e.g. 3071001.120101"
  1.  S DIR("A")="Select beginning export file date"
  1.  W !!
  1.  D ^DIR
  1.  Q:$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!(Y="")
  1.  S START=Y
  1. ASKEND ;EP -
  1.  K DIR
  1.  S DIR(0)="DO^::EXT"
  1.  S DIR("A")="Select ending export file date"
  1.  W !!
  1.  D ^DIR
  1.  G:$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!(Y=0) ASKSTART
  1.  S END=Y
  1.  ;
  1.  I END<START W !,"End date cannot become before the Beginning Date" H 2 G ASKSTART
  1.  ;
  1. ASKTYP ;EP -
  1.  K DIR
  1.  S DIR(0)="S^SS:FILE TOTALS BY SESSION;SC:FILE TOTALS BY CASHIER;SF:FILE TOTALS"
  1.  S DIR(0)=DIR(0)_";D:DETAIL;F:FILE DATE & FILE NAMES"
  1.  S DIR(0)=DIR(0)_";G:GRAND TOTAL ALL FILES BY TRANSMISSION DATE"
  1.  S DIR("B")="GRAND TOTAL ALL FILES BY TRANSMISSION DATE"
  1.  D ^DIR
  1.  G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(Y="") ASKEND
  1.  D ASKDEV^BARUFRP1(START,END,Y)
  1.  I '$G(ESC) D
  1.  .K DIR
  1.  .S DIR(0)="E"
  1.  .D ^DIR
  1.  D ^BARBAN
  1.  G BATCH
  1.  Q
  1.  ;
  1. BATHDR(DATE,RPTTYP) ;EP -
  1.  S PAGE=$G(PAGE)+1
  1.  W @IOF
  1.  S X=$S(RPTTYP="D":"DETAIL",RPTTYP="G":"GRAND TOTAL ALL FILES",RPTTYP="SS":"FILE TOTALS BY SESSION",RPTTYP="SC":"FILE TOTALS BY CASHIER",RPTTYP="SF":"FILE TOTALS",1:"")_" REPORT"
  1.  I RPTTYP="F" S X="FILE DATES & FILE NAME REPORT"
  1.  S X=$J("",IOM-$L(X)\2-$X)_X
  1.  W !,X
  1.  W ?70,"PAGE ",PAGE
  1.  W !,$$CJ^XLFSTR("REPORT DATE: "_DATE,IOM)
  1.  W !,$$CJ^XLFSTR("PRINTED BY : "_$P($G(^VA(200,DUZ,0)),U),IOM)
  1.  W !,$$CJ^XLFSTR("DATE RANGE FROM : "_EXSTART_" TO "_EXEND,IOM)
  1.  I PAGE>1 W !,DASH Q  ;ONLY PRINT LIST ONCE ;MRS:BAR*1.8*10 H1087
  1.  ;start new BARLOC
  1.  I RPTTYP="G" D
  1.  .;N BARST,BARHEND,UDUZ,BARSESID,BARREC,IENS,BARFILEN  ;MRS:BAR*1.8*10 H1197
  1.  .N BARST,BARHEND,UDUZ,BARSESID,BARREC,IENS,BARFILEN,BARSESXM  ;PKD:BAR*1.8*20 H13149
  1.  .K BARFLST  ;IHS/SD/SDR 8/8/08
  1.  .S BARHEND=$S(END'[("."):END_".999999",1:END)
  1.  .S BARST=START-.000001
  1.  .F  S BARST=$O(^BARSESS(DUZ(2),"F",BARST)) Q:'BARST!(ESC)!(BARST>BARHEND)  D
  1.  ..S UDUZ=""
  1.  ..F  S UDUZ=$O(^BARSESS(DUZ(2),"F",BARST,UDUZ)) Q:'UDUZ!(ESC)  D
  1.  ...S BARSESID=""
  1.  ...F  S BARSESID=$O(^BARSESS(DUZ(2),"F",BARST,UDUZ,BARSESID)) Q:'BARSESID!(ESC)  D
  1.  ....S BARREC=0
  1.  ....F  S BARREC=$O(^BARSESS(DUZ(2),UDUZ,11,BARSESID,21,BARREC)) Q:'BARREC!(ESC)  D
  1.  .....S IENS=BARREC_","_BARSESID_","_UDUZ_","
  1.  ..... ; IHS/SD/PKD 11/26/10 1.8*20 HEAT 13149
  1.  ..... ; Exclude Date on Header if EXPORT date.time is outside range 
  1.  .....S BARSESXM=$$GET1^DIQ(90057.210101,IENS,.01,"I")
  1.  .....S BARFILEN=$$GET1^DIQ(90057.210101,IENS,.02,"E")
  1.  .....Q:BARFILEN=""!(BARSESXM>BARHEND)!(BARSESXM<START)
  1.  .....; End H13149
  1.  .....S BARFLST(BARFILEN)=""
  1.  .S BARFILEN=""
  1.  .;Begin modifications ;MRS:BAR*1.8*10 H1197
  1.  .;F  S BARFILEN=$O(BARFLST(BARFILEN)) Q:BARFILEN=""  W !,$$CJ^XLFSTR("FILE: "_BARFILEN,IOM)
  1.  .F  S BARFILEN=$O(BARFLST(BARFILEN)) Q:BARFILEN=""  D  Q:$G(ESC)
  1.  ..W !,$$CJ^XLFSTR("FILE: "_BARFILEN,IOM)
  1.  ..I $Y>(IOSL-4) D EOP^BARUTL(1) S ESC=$G(DIRUT)=U W @IOF
  1.  ;end new BARLOC;MRS:BAR*1.8*10 H1197
  1.  W !,DASH
  1.  Q
  1. BATDET(BATCH) ;EP - 
  1.  W !?3,"A/R BILL"
  1.  W ?25,"TRANSACTION DATE/TIME"
  1.  W !?10,"CASHIER"
  1.  W ?35,"CREDIT - DEBIT"
  1.  W ?52,"TRAN TYPE"
  1.  W ?70,"ADJ CAT"
  1.  W !,DASH
  1.  W:$G(BATCH)'="" !,"BATCH: ",BATCH
  1.  Q
  1. SUMINIT ;EP - SUMMARY INITIALIZE COUNTERS
  1.  N BARCAT,BARALLC,BARTYP  ;MRS:BAR*1.8*10 IM30577
  1.  F BARCAT="ADJ","AAA PAYMENT","ZZZ REFUND","RRR RCODE","AAZERO","ADJZERO" D
  1.  .F BARALLC="MEDICARE","MEDICAID","PRIVATE INSURANCE","OTHER","VETERAN" D  ;P.OTT
  1.  ..F BARTYP="ALL","NS","TR","DS","ZP","ZA" D
  1.  ...S TOTALS(BARCAT,BARALLC,BARTYP,"CNT")=0
  1.  ...S TOTALS(BARCAT,BARALLC,BARTYP)=0
  1.  Q
  1.  ;
  1. COUNT(TOTALS) ;EP - INCREMENT COUNTERS
  1.  I TRANTYP="PAYMENT",(AMT=0) S CAT="AAZERO" D TOT(CAT,AMT,.TOTALS)
  1.  I TRANTYP="PAYMENT" S CAT="AAA "_TRANTYP D TOT(CAT,AMT,.TOTALS) Q
  1.  I TRANTYP="REFUND" S CAT="ZZZ "_TRANTYP D TOT(CAT,AMT,.TOTALS) Q
  1.  I TRANTYP["ADJUST",(AMT=0) S CAT="ADJZERO" D TOT(CAT,AMT,.TOTALS)
  1.  I TRANTYP="" S CAT="ADJ" D TOT(CAT,AMT,.TOTALS) Q
  1.  I TRANTYP="REMARK CODE" S CAT="RRR RCODE" D TOT(CAT,AMT,.TOTALS) Q
  1.  S CAT="ADJ" D TOT(CAT,AMT,.TOTALS) Q
  1.  Q
  1.  ;
  1. TOT(CAT,AMT,TOTALS) ;
  1.  D TOT^BARUFRP3  ;split due to routine size
  1.  Q
  1.  ;
  1. LIST(TOTALS) ;EP - DISPLAY CALCULATED TOTALS
  1.  N CATEGORY,ADJCAT,ADJCNT,ADJAMT
  1.  S (CATEGORY,SUBHDR)=""
  1.  ;start new BARLOC
  1.  D SETVAR^BARUFRP3  ;set up vars for printing
  1.  F  S CATEGORY=$O(TOTALS(CATEGORY)) Q:CATEGORY=""  D
  1.  .I $P(CATEGORY," ")'=SUBHDR D
  1.  ..W !!?2,"Cashiering Function"
  1.  ..W !,?3,"- "_$S($P(CATEGORY," ")="AAA":"Payments",$P(CATEGORY," ")="ZZZ":"Refunds",$P(CATEGORY," ")="RRR":"Remark Codes",CATEGORY="AAZERO":"Zero Pay",CATEGORY="ADJZERO":"Zero Adjustments",1:"Adjustments")
  1.  .S BARALLC=""
  1.  .F  S BARALLC=$O(TOTALS(CATEGORY,BARALLC)) Q:BARALLC=""  D
  1.  ..I $P(CATEGORY," ",2)="PAYMENT" D
  1.  ...S BARAPCNT=BARAPCNT+TOTALS(CATEGORY,BARALLC,"ALL","CNT")
  1.  ...S BARAPAMT=BARAPAMT+TOTALS(CATEGORY,BARALLC,"ALL")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"DS","CNT"))'="" D
  1.  ....S BARDPCNT=BARDPCNT+TOTALS(CATEGORY,BARALLC,"DS","CNT")
  1.  ....S BARDPAMT=BARDPAMT+TOTALS(CATEGORY,BARALLC,"DS")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"NS","CNT"))'="" D
  1.  ....S BARNPCNT=BARNPCNT+TOTALS(CATEGORY,BARALLC,"NS","CNT")
  1.  ....S BARNPAMT=BARNPAMT+TOTALS(CATEGORY,BARALLC,"NS")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"TR","CNT"))'="" D
  1.  ....S BARTPCNT=BARTPCNT+TOTALS(CATEGORY,BARALLC,"TR","CNT")
  1.  ....S BARTPAMT=BARTPAMT+TOTALS(CATEGORY,BARALLC,"TR")
  1.  ..I CATEGORY="AAZERO" D
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"ZP","CNT"))'="" D
  1.  ....S BARZPCNT=BARZPCNT+TOTALS(CATEGORY,BARALLC,"ZP","CNT")
  1.  ....S BARZPAMT=BARZPAMT+TOTALS(CATEGORY,BARALLC,"ZP")
  1.  ..I CATEGORY="ADJZERO" D
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"ZA","CNT"))'="" D
  1.  ....S BARZACNT=BARZACNT+TOTALS(CATEGORY,BARALLC,"ZA","CNT")
  1.  ....S BARZAAMT=BARZAAMT+TOTALS(CATEGORY,BARALLC,"ZA")
  1.  ..I $P(CATEGORY," ")="ADJ" D
  1.  ...S ADJACNT=ADJACNT+TOTALS(CATEGORY,BARALLC,"ALL","CNT")
  1.  ...S ADJAAMT=ADJAAMT+TOTALS(CATEGORY,BARALLC,"ALL")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"NS","CNT"))'="" D
  1.  ....S ADJNCNT=ADJNCNT+TOTALS(CATEGORY,BARALLC,"NS","CNT")
  1.  ....S ADJNAMT=ADJNAMT+TOTALS(CATEGORY,BARALLC,"NS")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"TR","CNT"))'="" D
  1.  ....S ADJTCNT=ADJTCNT+TOTALS(CATEGORY,BARALLC,"TR","CNT")
  1.  ....S ADJTAMT=ADJTAMT+TOTALS(CATEGORY,BARALLC,"TR")
  1.  ..I $P(CATEGORY," ",2)="REFUND" D
  1.  ...S REFACNT=REFACNT+TOTALS(CATEGORY,BARALLC,"ALL","CNT")
  1.  ...S REFAAMT=REFAAMT+TOTALS(CATEGORY,BARALLC,"ALL")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"NS","CNT"))'="" D
  1.  ....S REFNCNT=REFNCNT+TOTALS(CATEGORY,BARALLC,"NS","CNT")
  1.  ....S REFNAMT=REFNAMT+TOTALS(CATEGORY,BARALLC,"NS")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"TR","CNT"))'="" D
  1.  ....S REFTCNT=REFTCNT+TOTALS(CATEGORY,BARALLC,"TR","CNT")
  1.  ....S REFTAMT=REFTAMT+TOTALS(CATEGORY,BARALLC,"TR")
  1.  ..I $P(CATEGORY," ",2)="RCODE" D
  1.  ...S BARRCCNT=BARRCCNT+TOTALS(CATEGORY,BARALLC,"ALL","CNT")
  1.  ...S BARRCAMT=BARRCAMT+TOTALS(CATEGORY,BARALLC,"ALL")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"NS","CNT"))'="" D
  1.  ....S BARCNCNT=BARCNCNT+TOTALS(CATEGORY,BARALLC,"NS","CNT")
  1.  ....S BARCNAMT=BARCNAMT+TOTALS(CATEGORY,BARALLC,"NS")
  1.  ...I $G(TOTALS(CATEGORY,BARALLC,"TR","CNT"))'="" D
  1.  ....S BARCTCNT=BARCTCNT+TOTALS(CATEGORY,BARALLC,"TR","CNT")
  1.  ....S BARCTAMT=BARCTAMT+TOTALS(CATEGORY,BARALLC,"TR")
  1.  ..S SUBHDR=$P(CATEGORY," ")
  1.  ..D WRITEDET^BARUFRP3
  1.  .D WRITETOT^BARUFRP3
  1.  W !?46,"TOTALS SENT: ",$J(BARTPCNT+ADJTCNT-BARZPCNT,6),?66,"$"_$J((BARTPAMT-ADJTAMT-REFTAMT),10,2)
  1.  W !
  1.  Q