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