BARUFSUP ; IHS/SD/TPF - SUPERVISORY FUNCTIONS FOR UFMS ; 04/09/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,17,21,22,23**;OCT 26, 2005;Build 38
;HEAT # 62222 MAR 2012 P.OTTIS: ADDED CALL $$GETDAY0^BARUFUT1
;HEAT # 71924 JUN 2012 P.OTTIS: in UUE replaced PRINT^TIMTEST with PRINT^BARUFSUP
;AUG 2013 P.OTTIS NOHEAT CHOCKTAW REQUEST: LIMIT DISPLAY FOR NON-IHS P.OTT
Q
;
VIEW ;EP - VIEW UFMS SESSIONS
D INIT
D SHOW("") ;SHOW SESSIONS
Q
;
VIEWHDR(STATUS) ;EP - HEADER FOR VIEWING SESSIONS
W !?6,"SESSION ID",?20,"CASHIER"
W ?36,"DATE "_$S(STATUS="ALL STATUSES":"STATUS CHANGED",STATUS="OPEN":"OPENED",1:STATUS)
W ?62,$S(STATUS="ALL STATUSES":"STATUS",1:""),?73,"ERA\PST"
W !,DASH
Q
;
ALLSTAT(LIST,STATUS) ;EP - CHANGE STATUS OF ALL SESSIONS IN ARRAY 'LIST' TO STATUS
N UDUZ,SESSID,RC,ERASTAT,POSTING
I STATUS="RT"!(STATUS="T") D Q
.D EXPORTSM(.LIST,0) ;EXPORT SUMMARY
.S UDUZ="" D TRANSMIT^BARUFUT(UDUZ,.LIST,STATUS) ;IF 'T' OR 'RT' THEN TRANSMIT
.D EXPORTSM(.LIST,1)
S REC=""
F S REC=$O(LIST(REC)) Q:'REC D
.S UDUZ=$P(LIST(REC),U)
.S SESSID=$P(LIST(REC),U,2)
.S ERASTAT=$P(LIST(REC),U,3)
.I '$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,0)),(STATUS="RC") D Q
..W !!,"CANNOT RECONCILE SESSION ",SESSID
..W !,"THE SESSION HAS NO POSTING ACTIVITY"
..D ASKFORRT^BARUFUT
.I ERASTAT="YES",(STATUS="RC") D Q
..W !!,"CANNOT RECONCILE SESSION ",SESSID
..W !,"THE CASHIER IS ERA POSTING"
..D ASKFORRT^BARUFUT
.;
.S POSTING=$$STILPOST^BARUFUT1(UDUZ)
.I +POSTING=1,(STATUS="RC") D Q ;IS USER STILL LOGGED ON OR POSTING?
..W !!,"CANNOT RECONCILE SESSION ",SESSID
..W !,"THE CASHIER IS ",$P(POSTING,U,2)
..D ASKFORRT^BARUFUT
.I +POSTING=2,(STATUS="RC") D Q:'$G(Y)!($D(DTOUT))!($D(DUOUT))
..W !!,"RECONCILING SESSION ",SESSID
..W !,"THE CASHIER IS ",$P(POSTING,U,2)
..K DIR
..S DIR(0)="Y"
..S DIR("B")="Y"
..S DIR("A")="Continue Anyway?"
..D ^DIR
.S RC=$$SETSESS^BARUFUT(UDUZ,SESSID,STATUS)
Q
;
RESEND ;EP - RESEND A FILE
N NOSEND
S NOSEND=0 ; ALLOW SENDING OF FILE
D RESENDF^BARUFUT1(NOSEND)
Q
LISTDIR ;EP - LIST UFMS DIRECTORY
N NOSEND
S NOSEND=1
D RESENDF^BARUFUT1(NOSEND)
Q
;
INIT ;EP - INIT COMMON VARIABLES
S $P(DASH,"-",81)=""
Q
;
SHOW(STATUS) ;EP - GENERIC SESSION LISTER
AGAIN ;EP -
D ^BARBAN
S:$G(STATUS)="" STATUS="OPEN"
W !!,"UFMS DISPLAY DATE LIMIT: ",$S($$GETDISLM^BARUFUT1("E")'="":$$GETDISLM^BARUFUT1("E"),1:"NONE SET")
W " ("_$$GET1^DIQ(90052.06,DUZ(2)_",",1504,"I")_")"
W !!,"The following SESSIONS are currently ",STATUS," =>"
D VIEWHDR(STATUS)
I STATUS'="ALL STATUSES",('$D(^BARSESS(DUZ(2),"C",STATUS))) D G ASKSTAT
.W !!!,"THERE ARE NO "_STATUS_" CASHIER SESSIONS"
.D ASKFORRT^BARUFUT
I '$D(^BARSESS(DUZ(2),"C")),(STATUS="ALL STATUSES") D G ASKSTAT
.W !!!,"THERE ARE NO CASHIER SESSIONS WITH A STATUS"
.D ASKFORRT^BARUFUT
S UDUZ=""
K LIST
I STATUS="ALL STATUSES" D G ASK
.S LINE=0
.S TSTATUS=""
.F S TSTATUS=$O(^BARSESS(DUZ(2),"C",TSTATUS)) Q:TSTATUS="" D
..F S UDUZ=$O(^BARSESS(DUZ(2),"C",TSTATUS,UDUZ)) Q:'UDUZ D LOOP(UDUZ,TSTATUS,.LINE,.LIST,STATUS)
S LINE=0 F S UDUZ=$O(^BARSESS(DUZ(2),"C",STATUS,UDUZ)) Q:'UDUZ D LOOP(UDUZ,STATUS,.LINE,.LIST,STATUS)
;
I LINE=0 D G ASKSTAT
.W !!!,"THERE ARE NO "_STATUS_" CASHIER SESSIONS"
;
ASK ;EP - ASK FOR ACTION
W !,$G(DASH)
W !
K DIR
S (OPTIONST,VALIDCHK)=""
S DIR("?")="Enter a session number"
I STATUS'="ALL STATUSES" D
.S OPTIONST=$S(STATUS'="TRANSMITTED"&(STATUS'="RETRANSMITTED"):" or ",1:"")
.S OPTIONST=OPTIONST_$S(STATUS="OPEN":"RC/Reconcile",STATUS="RECONCILED":"RV/Review/approve",STATUS="REVIEWED/APPROVED":"T/Transmit",1:"")_$S(STATUS'="TRANSMITTED"&(STATUS'="RETRANSMITTED"):" all listed sessions",1:"")
.S DIR("?")="Enter a session number or an action."
S VALIDCHK="I CHOICE'="_$S(STATUS="OPEN":"""RC""",STATUS="RECONCILED":"""RV""",STATUS="REVIEWED/APPROVED":"""T""",1:"")
S VALIDCHK="I CHOICE'?1"_$S(STATUS="OPEN":"""RC""",STATUS="RECONCILED":"""RV""",STATUS="REVIEWED/APPROVED":"""T""",1:"")_".E"
S VALIDCHK=VALIDCHK_",(CHOICE'?1"_$S(STATUS="OPEN":"""RC""",STATUS="RECONCILED":"""RV""",STATUS="REVIEWED/APPROVED":"""T""",1:"")_"""1@"".E)"
S DIR("A")="Select Session Number to View"_OPTIONST
S DIR("?")=DIR("?")_", or press return to choose a different status and/or Quit"
S DIR(0)="FO"
S DIR("?")=DIR("?")_" (Note: You can also choose a range from the displayed list. Separate the range from the Action by an @ sign e.g. T@1,3,5,10-15"
S DIR("A")=DIR("A")_" or Q/Quit"
W !,"Press <RETURN> to change statuses being displayed or,"
D ^DIR
Q:($D(DTOUT))!($D(DUOUT))
Q:(U_"Q"_U_"q"_U)[(U_Y_U)
G ASKSTAT:Y=""
I +Y=Y D G AGAIN
.S CHOICE=+Y
.I '$D(LIST(CHOICE)) W !,"Invalid choice!" H 3 Q
.S UDUZ=$P(LIST(CHOICE),U)
.S SESSID=$P(LIST(CHOICE),U,2)
.S ERASTAT=$P(LIST(CHOICE),U,3)
.D DISPLAYT^BARUFLOG(UDUZ,SESSID,"VIEW",ERASTAT)
;
S CHOICE=$$UPC^BARUTL(Y)
I CHOICE'="",((STATUS="ALL STATUSES")!(STATUS="TRANSMITTED")) D G AGAIN ;
.W !,"INVALID CHOICE!" H 3
I CHOICE'="",(STATUS'="ALL STATUSES") D G AGAIN
.I $E(CHOICE,1,2)="RT" W !,"INVALID CHOICE!" H 3 Q ;BEGIN
.X VALIDCHK I $T W !,"INVALID CHOICE!" H 3 Q
.S RANGE=$P(CHOICE,"@",2)
.S:RANGE'="" RANGE=$$RANGE^BARUFUT1(RANGE)
.D:RANGE'="" EXCLLST^BARUFUT1(RANGE,.LIST)
.S CHOICE=$P(CHOICE,"@")
.D ALLSTAT(.LIST,CHOICE) ;CHANGE ALL THE STATUSES WITHIN THE 'LIST' ARRAY
;
ASKSTAT ;EP - ASK STATUS TO VIEW
N CNTS
K STATCNTS
D CNTSTATS^BARUFUT1(.STATCNTS)
K DIR
S DIR("A")="View which session status"
S DIR(0)="SO^O:OPEN" I $G(STATCNTS("OPEN"))'="" S DIR(0)=DIR(0)_" ("_$G(STATCNTS("OPEN"))_")"
S DIR(0)=DIR(0)_";RC:RECONCILED" I $G(STATCNTS("RECONCILED"))'="" S DIR(0)=DIR(0)_" ("_$G(STATCNTS("RECONCILED"))_")"
S DIR(0)=DIR(0)_";RV:REVIEWED/APPROVED" I $G(STATCNTS("REVIEWED/APPROVED"))'="" S DIR(0)=DIR(0)_" ("_$G(STATCNTS("REVIEWED/APPROVED"))_")"
S DIR(0)=DIR(0)_";T:TRANSMITTED" I $G(STATCNTS("TRANSMITTED"))'="" S DIR(0)=DIR(0)_" ("_$G(STATCNTS("TRANSMITTED"))_")"
S DIR(0)=DIR(0)_";RT:RETRANSMITTED" I $G(STATCNTS("RETRANSMITTED"))'="" S DIR(0)=DIR(0)_" ("_$G(STATCNTS("RETRANSMITTED"))_")"
S DIR(0)=DIR(0)_";ALL:ALL STATUSES" I $G(STATCNTS("ALL STATUSES"))'="" S DIR(0)=DIR(0)_" ("_$G(STATCNTS("ALL STATUSES"))_")"
S DIR(0)=DIR(0)_";Q:QUIT"
K STATCNTS
D ^DIR
G:Y="" AGAIN
I $D(DIRUT)!($D(DTOUT))!($D(DIRUT))!(Y="Q") Q
I Y(0)'[("ALL") S STATUS=$P(Y(0)," ")
E S STATUS=$P(Y(0)," ",1,2)
G AGAIN
Q
;FUNCT ADDED FOR CHOCKTAW
GETDTLIM() ;GET 'UFMS DISPLAY DATE LIMIT'
N DISLIM
S DISLIM=$$GET1^DIQ(90052.06,DUZ(2)_",",1504,"I")
I DISLIM'="" S X=DISLIM,%DT="" D ^%DT S DISLIM=Y
Q DISLIM
;
LOOP(UDUZ,STAT,LINE,LIST,PRTSTAT) ;EP - GET DATA FROM SESSION LEVEL
N SESSID,CNT,ERASTAT,RTCOUNT,CURSTAT,DAYZERO,DAYDISP,BARTMP ;HEAT # 62222 MAR 2012 P.OTTIS
S DAYDISP=$$GETDISLM^BARUFUT1("I") ;START DISPLAY FROM THIS DATE UNLESS
S DAYZERO=$$GETDAY0^BARUFUT1("I") ;ANY NOT TRANSMITTED SESSIONS ARE FOUND IN THE HISTORY (=OPEN)
; ;HISTORY BEGINS ON DAYZERO
S SESSID=DAYDISP I DAYZERO]"" I DAYZERO<DAYDISP S SESSID=DAYZERO ;START WITH LOWEST DAY
;NOHEAT CHOCKTAW REQUEST: LIMIT DISPLAY FOR NON-IHS P.OTT
S BARTMP=$$GETDTLIM()
;;;W !,"ORIG SESSID=",SESSID
I '$$IHS^BARUFUT(DUZ(2)),BARTMP S SESSID=BARTMP ;;;W !,"THIS IS A NON-IHS FACILITY SESSID=",SESSID
;<-- END OF NEW CODE P.OTT
S SESSID=SESSID-0.01
;
F CNT=1:1 S SESSID=$O(^BARSESS(DUZ(2),"C",STAT,UDUZ,SESSID)) Q:SESSID="" D
.S IENS=SESSID_","_UDUZ_"," ;bar*1.8*21 SDR
.I ($P($$GET1^DIQ(90057.11,IENS,.03,"I"),".")<3081001) Q ;don't display sessions prior to 10/1/08 ;bar*1.8*22 IHS/SD/AML NOHEAT
.S LINE=LINE+1
.S CURSTAT=$$GET1^DIQ(90057.11,IENS,.02,"E")
.S STATDATE=$$GET1^DIQ(90057.11,IENS,.03,"E")
.S ERASTAT=$E($$GET1^DIQ(90057.11,IENS,.04,"E"))
.S POSTING=$$STILPOST^BARUFUT1(UDUZ)
.S Y=STATDATE X ^DD("DD") S STATDATE=Y
.S CASHIER=$P($G(^VA(200,UDUZ,0)),U)
.I STAT="RETRANSMITTED" S RTCOUNT=$$RTCOUNT^BARUFUT1(UDUZ,SESSID)
.S LIST(LINE)=UDUZ_U_SESSID_U_ERASTAT
.I $P(SESSID,".")=$$GETDISLM^BARUFUT1("I"),(CURSTAT="OPEN") D EN^XBVIDEO("RVN")
.W !,LINE,"."
.W ?3,SESSID,?18,$E(CASHIER,1,17),?36,STATDATE
.D EN^XBVIDEO("RVF")
.W:STAT="RETRANSMITTED" "(",RTCOUNT,")"
.W ?58,$S(PRTSTAT="ALL STATUSES":$E(STAT,1,14),1:""),?72,$S(+POSTING&(STAT="OPEN"):"*",1:""),?75,ERASTAT,?76,"\",?77,$S(+POSTING=1&(CURSTAT="OPEN"):"Y",1:"")
Q
;
;PRINT = 1 THEN ASK FOR DEVICE
EXPORTSM(LIST,PRINT) ;EXPORT SUMMARY
Q:'$D(LIST) ;LLIST(REC)=CASHIER DUZ_^_SESSION ID
I '$G(PRINT) D PRINT Q
K DIR
W !!
S DIR(0)="Y"
S DIR("A")="Print Summary Screen"
S DIR("B")="Y"
D ^DIR
Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y=0)
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^TIMTEST"
S ZTRTN="PRINT^BARUFSUP" ;"PRINT^TIMTEST" ;P.OTT #71924
S ZTDESC="EXPORT SUMMARY REPORT"
I $D(LIST)=1 S TMP=LIST N LIST S LIST(1)=TMP
S REC="" F S REC=$O(LIST(REC)) Q:'REC S ZTSAVE("LIST("_REC_")")=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
E W !!?5,"Report task #: ",$G(ZTSK)
D HOME^%ZIS
Q
;
PRINT ;
N REC,UDUZ,SESSID,EQUALS,EXPDATE,PAGE
S $P(EQUALS,"=",81)=""
S $P(DASHES,"-",81)=""
S PAGE=1
N GTOTALS,TOTALS
S GTOTALS("PAYMENT","CNT")=0
S GTOTALS("PAYMENT")=0
S GTOTALS("CREDITS")=0
S GTOTALS("CREDITS","CNT")=0
S GTOTALS("DEBITS")=0
S GTOTALS("DEBITS","CNT")=0
S GTOTALS("REFUND","CNT")=0
S GTOTALS("REFUND")=0
D NOW^%DTC S Y=% X ^DD("DD") S EXPDATE=Y
D EXPHDR
I $D(LIST)=1 S TMP=LIST N LIST S LIST(1)=TMP
S REC=""
F S REC=$O(LIST(REC)) Q:'REC D
.S UDUZ=$P(LIST(REC),U)
.S SESSID=$P(LIST(REC),U,2)
.D GETTOTS(UDUZ,SESSID)
D FOOTER
Q
;
GETTOTS(UDUZ,SESSID) ;EP - DISPLAY EXPORT SUMMARIES
;SESSID - CASHIER SESSION
N BARTR,ARCREDIT,ARDEBIT,TRANTYPE,AMT,IENS,CAT
;LOOP THROUGH USERS SESSION ENTRIES
S TOTALS("AAA PAYMENT")=0
S TOTALS("AAA PAYMENT","CNT")=0
S TOTALS("ADJ CO-PAY")=0
S TOTALS("ADJ CO-PAY","CNT")=0
S TOTALS("ADJ DEDUCTIBLE")=0
S TOTALS("ADJ DEDUCTIBLE","CNT")=0
S TOTALS("ADJ NON PAYMENT")=0
S TOTALS("ADJ NON PAYMENT","CNT")=0
S TOTALS("ADJ WRITE OFF")=0
S TOTALS("ADJ WRITE OFF","CNT")=0
S TOTALS("ADJ PENALTY")=0
S TOTALS("ADJ PENALTY","CNT")=0
S TOTALS("ADJ GROUPER ALLOWANCE")=0
S TOTALS("ADJ GROUPER ALLOWANCE","CNT")=0
S TOTALS("ADJ PAYMENT CREDIT")=0
S TOTALS("ADJ PAYMENT CREDIT","CNT")=0
S TOTALS("ZZZ REFUND")=0
S TOTALS("ZZZ REFUND","CNT")=0
S TOTALS("CREDITS")=0
S TOTALS("CREDITS","CNT")=0
S TOTALS("DEBITS")=0
S TOTALS("DEBITS","CNT")=0
S TOTALCNT=0
;
S BARTR=0
F S BARTR=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTR)) Q:'BARTR D Q:$G(ESC)
.S (ARCREDIT,ARDEBIT)=0
.S IENS=BARTR_","
.S ARBILL=$$GET1^DIQ(90050.03,IENS,4,"E") ;A/R TRANS, BILL (A/R)
.Q:ARBILL=""
.S ARCREDIT=$$GET1^DIQ(90050.03,IENS,2,"E") ;A/R TRANS, CREDIT
.S ARDEBIT=$$GET1^DIQ(90050.03,IENS,3,"E") ;A/R TRANS, DEBIT
.S AMT=ARCREDIT-ARDEBIT
.S TRANTYPE=$$GET1^DIQ(90050.03,IENS,101,"E") ;A/R TRANS, ADJ TYPE
.S ADJCAT=$$GET1^DIQ(90050.03,IENS,102,"E") ;A/R TRANS, ADJ CATEGORY
.I TRANTYPE="PAYMENT" S CAT="AAA "_TRANTYPE D TOT(CAT,AMT,.TOTALS) Q
.S CAT=ADJCAT
.I CAT="REFUND" S CAT="ZZZ "_CAT D TOT(CAT,AMT,.TOTALS) Q
.I CAT="" S CAT="ADJ UNDEF" D TOT(CAT,AMT,.TOTALS) Q
.S CAT="ADJ "_CAT D TOT(CAT,AMT,.TOTALS) Q
D LIST(.TOTALS)
S GTOTALS("PAYMENT","CNT")=GTOTALS("PAYMENT","CNT")+TOTALS("AAA PAYMENT","CNT")
S GTOTALS("PAYMENT")=GTOTALS("PAYMENT")+TOTALS("AAA PAYMENT")
S GTOTALS("CREDITS")=GTOTALS("CREDITS")+TOTALS("CREDITS")
S GTOTALS("CREDITS","CNT")=GTOTALS("CREDITS","CNT")+TOTALS("CREDITS","CNT")
S GTOTALS("DEBITS")=GTOTALS("DEBITS")+TOTALS("DEBITS")
S GTOTALS("DEBITS","CNT")=GTOTALS("DEBITS","CNT")+TOTALS("DEBITS","CNT")
S GTOTALS("REFUND")=GTOTALS("REFUND")+TOTALS("ZZZ REFUND")
S GTOTALS("REFUND","CNT")=GTOTALS("REFUND","CNT")+TOTALS("ZZZ REFUND","CNT")
Q
;
TOT(CAT,AMT,TOTALS) ;
S TOTALS(CAT)=$G(TOTALS(CAT))+AMT
S TOTALS(CAT,"CNT")=$G(TOTALS(CAT,"CNT"))+1
S TOTALCNT=TOTALCNT+$G(TOTALS(CAT,"CNT"))
I CAT[("ADJ") D
.S TOTALS("CREDITS")=TOTALS("CREDITS")+ARCREDIT
.S TOTALS("DEBITS")=TOTALS("DEBITS")+ARDEBIT
.I ARCREDIT S TOTALS("CREDITS","CNT")=TOTALS("CREDITS","CNT")+1
.E S TOTALS("DEBITS","CNT")=TOTALS("DEBITS","CNT")+1
;W !,CAT,?20,AMT,?35,ARCREDIT,?45,ARDEBIT ;TESTING ONLY
Q
;
LIST(TOTALS) ;EP - DISPLAY CALCULATED TOTS
N CATEGORY,ADJCAT,ADJCNT,ADJAMT
W !,SESSID
W ?16,$E($P(^VA(200,UDUZ,0),U),1,7)
W ?28,TOTALS("AAA PAYMENT","CNT")
W ?29,$J(TOTALS("AAA PAYMENT"),10,2)
W ?41,TOTALS("CREDITS","CNT")
W ?42,$J(TOTALS("CREDITS"),10,2)
W ?54,TOTALS("DEBITS","CNT")
W ?56,$J(-TOTALS("DEBITS"),10,2)
W ?68,TOTALS("ZZZ REFUND","CNT")
W ?70,$J(TOTALS("ZZZ REFUND"),10,2)
Q
;IF THE SESSION HAS BEEN TRANSMITTED SHOW THE FILE
I $D(^BARSESS(DUZ(2),UDUZ,11,SESSID,21)) D
.W !,"TRANSMITTED ON: "
.N TRANREC,TRANTIME,IENS,TRANFILE,TRANBY,CNT
.S TRANREC=0
.F CNT=1:1 S TRANREC=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,TRANREC)) Q:'TRANREC D
..S IENS=TRANREC_","_SESSID_","_UDUZ_","
..S TRANTIME=$$GET1^DIQ(90057.210101,IENS,.01,"E")
..S TRANFILE=$$GET1^DIQ(90057.210101,IENS,.02,"E")
..S TRANBY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
..W:CNT'=1 !
..W ?16,TRANTIME," BY ",TRANBY
..W !?16,TRANFILE
;
EXPHDR ;EP -DISPLAY HDR
W @IOF
W !,EQUALS
W !,"Export Summary Print",?45,EXPDATE,?70,"Page ",PAGE
W !,"A/R Location: ",$P(^DIC(4,DUZ(2),0),U)
W !,EQUALS
W !,"Please ensure the following information is correct:"
W !!
W !,"SESSION ID",?16,"CASHIER",?30,"PAYMENTS",?50,"ADJUSTMENTS",?70,"REFUNDS"
W !,?45,"CREDITS DEBITS"
S PAGE=PAGE+1
Q
;
W !,DASHES
W !,"TOTALS:"
W ?28,GTOTALS("PAYMENT","CNT")
W ?29,$J(GTOTALS("PAYMENT"),10,2)
W ?41,GTOTALS("CREDITS","CNT")
W ?42,$J(GTOTALS("CREDITS"),10,2)
W ?54,GTOTALS("DEBITS","CNT")
W ?56,$J(-GTOTALS("DEBITS"),10,2)
W ?68,GTOTALS("REFUND","CNT")
W ?70,$J(GTOTALS("REFUND"),10,2)
Q
BARUFSUP ; IHS/SD/TPF - SUPERVISORY FUNCTIONS FOR UFMS ; 04/09/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,17,21,22,23**;OCT 26, 2005;Build 38
+2 ;HEAT # 62222 MAR 2012 P.OTTIS: ADDED CALL $$GETDAY0^BARUFUT1
+3 ;HEAT # 71924 JUN 2012 P.OTTIS: in UUE replaced PRINT^TIMTEST with PRINT^BARUFSUP
+4 ;AUG 2013 P.OTTIS NOHEAT CHOCKTAW REQUEST: LIMIT DISPLAY FOR NON-IHS P.OTT
+5 QUIT
+6 ;
VIEW ;EP - VIEW UFMS SESSIONS
+1 DO INIT
+2 ;SHOW SESSIONS
DO SHOW("")
+3 QUIT
+4 ;
VIEWHDR(STATUS) ;EP - HEADER FOR VIEWING SESSIONS
+1 WRITE !?6,"SESSION ID",?20,"CASHIER"
+2 WRITE ?36,"DATE "_$SELECT(STATUS="ALL STATUSES":"STATUS CHANGED",STATUS="OPEN":"OPENED",1:STATUS)
+3 WRITE ?62,$SELECT(STATUS="ALL STATUSES":"STATUS",1:""),?73,"ERA\PST"
+4 WRITE !,DASH
+5 QUIT
+6 ;
ALLSTAT(LIST,STATUS) ;EP - CHANGE STATUS OF ALL SESSIONS IN ARRAY 'LIST' TO STATUS
+1 NEW UDUZ,SESSID,RC,ERASTAT,POSTING
+2 IF STATUS="RT"!(STATUS="T")
Begin DoDot:1
+3 ;EXPORT SUMMARY
DO EXPORTSM(.LIST,0)
+4 ;IF 'T' OR 'RT' THEN TRANSMIT
SET UDUZ=""
DO TRANSMIT^BARUFUT(UDUZ,.LIST,STATUS)
+5 DO EXPORTSM(.LIST,1)
End DoDot:1
QUIT
+6 SET REC=""
+7 FOR
SET REC=$ORDER(LIST(REC))
IF 'REC
QUIT
Begin DoDot:1
+8 SET UDUZ=$PIECE(LIST(REC),U)
+9 SET SESSID=$PIECE(LIST(REC),U,2)
+10 SET ERASTAT=$PIECE(LIST(REC),U,3)
+11 IF '$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,0))
IF (STATUS="RC")
Begin DoDot:2
+12 WRITE !!,"CANNOT RECONCILE SESSION ",SESSID
+13 WRITE !,"THE SESSION HAS NO POSTING ACTIVITY"
+14 DO ASKFORRT^BARUFUT
End DoDot:2
QUIT
+15 IF ERASTAT="YES"
IF (STATUS="RC")
Begin DoDot:2
+16 WRITE !!,"CANNOT RECONCILE SESSION ",SESSID
+17 WRITE !,"THE CASHIER IS ERA POSTING"
+18 DO ASKFORRT^BARUFUT
End DoDot:2
QUIT
+19 ;
+20 SET POSTING=$$STILPOST^BARUFUT1(UDUZ)
+21 ;IS USER STILL LOGGED ON OR POSTING?
IF +POSTING=1
IF (STATUS="RC")
Begin DoDot:2
+22 WRITE !!,"CANNOT RECONCILE SESSION ",SESSID
+23 WRITE !,"THE CASHIER IS ",$PIECE(POSTING,U,2)
+24 DO ASKFORRT^BARUFUT
End DoDot:2
QUIT
+25 IF +POSTING=2
IF (STATUS="RC")
Begin DoDot:2
+26 WRITE !!,"RECONCILING SESSION ",SESSID
+27 WRITE !,"THE CASHIER IS ",$PIECE(POSTING,U,2)
+28 KILL DIR
+29 SET DIR(0)="Y"
+30 SET DIR("B")="Y"
+31 SET DIR("A")="Continue Anyway?"
+32 DO ^DIR
End DoDot:2
IF '$GET(Y)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+33 SET RC=$$SETSESS^BARUFUT(UDUZ,SESSID,STATUS)
End DoDot:1
+34 QUIT
+35 ;
RESEND ;EP - RESEND A FILE
+1 NEW NOSEND
+2 ; ALLOW SENDING OF FILE
SET NOSEND=0
+3 DO RESENDF^BARUFUT1(NOSEND)
+4 QUIT
LISTDIR ;EP - LIST UFMS DIRECTORY
+1 NEW NOSEND
+2 SET NOSEND=1
+3 DO RESENDF^BARUFUT1(NOSEND)
+4 QUIT
+5 ;
INIT ;EP - INIT COMMON VARIABLES
+1 SET $PIECE(DASH,"-",81)=""
+2 QUIT
+3 ;
SHOW(STATUS) ;EP - GENERIC SESSION LISTER
AGAIN ;EP -
+1 DO ^BARBAN
+2 IF $GET(STATUS)=""
SET STATUS="OPEN"
+3 WRITE !!,"UFMS DISPLAY DATE LIMIT: ",$SELECT($$GETDISLM^BARUFUT1("E")'="":$$GETDISLM^BARUFUT1("E"),1:"NONE SET")
+4 WRITE " ("_$$GET1^DIQ(90052.06,DUZ(2)_",",1504,"I")_")"
+5 WRITE !!,"The following SESSIONS are currently ",STATUS," =>"
+6 DO VIEWHDR(STATUS)
+7 IF STATUS'="ALL STATUSES"
IF ('$DATA(^BARSESS(DUZ(2),"C",STATUS)))
Begin DoDot:1
+8 WRITE !!!,"THERE ARE NO "_STATUS_" CASHIER SESSIONS"
+9 DO ASKFORRT^BARUFUT
End DoDot:1
GOTO ASKSTAT
+10 IF '$DATA(^BARSESS(DUZ(2),"C"))
IF (STATUS="ALL STATUSES")
Begin DoDot:1
+11 WRITE !!!,"THERE ARE NO CASHIER SESSIONS WITH A STATUS"
+12 DO ASKFORRT^BARUFUT
End DoDot:1
GOTO ASKSTAT
+13 SET UDUZ=""
+14 KILL LIST
+15 IF STATUS="ALL STATUSES"
Begin DoDot:1
+16 SET LINE=0
+17 SET TSTATUS=""
+18 FOR
SET TSTATUS=$ORDER(^BARSESS(DUZ(2),"C",TSTATUS))
IF TSTATUS=""
QUIT
Begin DoDot:2
+19 FOR
SET UDUZ=$ORDER(^BARSESS(DUZ(2),"C",TSTATUS,UDUZ))
IF 'UDUZ
QUIT
DO LOOP(UDUZ,TSTATUS,.LINE,.LIST,STATUS)
End DoDot:2
End DoDot:1
GOTO ASK
+20 SET LINE=0
FOR
SET UDUZ=$ORDER(^BARSESS(DUZ(2),"C",STATUS,UDUZ))
IF 'UDUZ
QUIT
DO LOOP(UDUZ,STATUS,.LINE,.LIST,STATUS)
+21 ;
+22 IF LINE=0
Begin DoDot:1
+23 WRITE !!!,"THERE ARE NO "_STATUS_" CASHIER SESSIONS"
End DoDot:1
GOTO ASKSTAT
+24 ;
ASK ;EP - ASK FOR ACTION
+1 WRITE !,$GET(DASH)
+2 WRITE !
+3 KILL DIR
+4 SET (OPTIONST,VALIDCHK)=""
+5 SET DIR("?")="Enter a session number"
+6 IF STATUS'="ALL STATUSES"
Begin DoDot:1
+7 SET OPTIONST=$SELECT(STATUS'="TRANSMITTED"&(STATUS'="RETRANSMITTED"):" or ",1:"")
+8 SET OPTIONST=OPTIONST_$SELECT(STATUS="OPEN":"RC/Reconcile",STATUS="RECONCILED":"RV/Review/approve",STATUS="REVIEWED/APPROVED":"T/Transmit",1:"")_$SELECT(STATUS'="TRANSMITTED"&(STATUS'="RETRANSMITTED"):" all listed sessions",1:"")
+9 SET DIR("?")="Enter a session number or an action."
End DoDot:1
+10 SET VALIDCHK="I CHOICE'="_$SELECT(STATUS="OPEN":"""RC""",STATUS="RECONCILED":"""RV""",STATUS="REVIEWED/APPROVED":"""T""",1:"")
+11 SET VALIDCHK="I CHOICE'?1"_$SELECT(STATUS="OPEN":"""RC""",STATUS="RECONCILED":"""RV""",STATUS="REVIEWED/APPROVED":"""T""",1:"")_".E"
+12 SET VALIDCHK=VALIDCHK_",(CHOICE'?1"_$SELECT(STATUS="OPEN":"""RC""",STATUS="RECONCILED":"""RV""",STATUS="REVIEWED/APPROVED":"""T""",1:"")_"""1@"".E)"
+13 SET DIR("A")="Select Session Number to View"_OPTIONST
+14 SET DIR("?")=DIR("?")_", or press return to choose a different status and/or Quit"
+15 SET DIR(0)="FO"
+16 SET DIR("?")=DIR("?")_" (Note: You can also choose a range from the displayed list. Separate the range from the Action by an @ sign e.g. T@1,3,5,10-15"
+17 SET DIR("A")=DIR("A")_" or Q/Quit"
+18 WRITE !,"Press <RETURN> to change statuses being displayed or,"
+19 DO ^DIR
+20 IF ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+21 IF (U_"Q"_U_"q"_U)[(U_Y_U)
QUIT
+22 IF Y=""
GOTO ASKSTAT
+23 IF +Y=Y
Begin DoDot:1
+24 SET CHOICE=+Y
+25 IF '$DATA(LIST(CHOICE))
WRITE !,"Invalid choice!"
HANG 3
QUIT
+26 SET UDUZ=$PIECE(LIST(CHOICE),U)
+27 SET SESSID=$PIECE(LIST(CHOICE),U,2)
+28 SET ERASTAT=$PIECE(LIST(CHOICE),U,3)
+29 DO DISPLAYT^BARUFLOG(UDUZ,SESSID,"VIEW",ERASTAT)
End DoDot:1
GOTO AGAIN
+30 ;
+31 SET CHOICE=$$UPC^BARUTL(Y)
+32 ;
IF CHOICE'=""
IF ((STATUS="ALL STATUSES")!(STATUS="TRANSMITTED"))
Begin DoDot:1
+33 WRITE !,"INVALID CHOICE!"
HANG 3
End DoDot:1
GOTO AGAIN
+34 IF CHOICE'=""
IF (STATUS'="ALL STATUSES")
Begin DoDot:1
+35 ;BEGIN
IF $EXTRACT(CHOICE,1,2)="RT"
WRITE !,"INVALID CHOICE!"
HANG 3
QUIT
+36 XECUTE VALIDCHK
IF $TEST
WRITE !,"INVALID CHOICE!"
HANG 3
QUIT
+37 SET RANGE=$PIECE(CHOICE,"@",2)
+38 IF RANGE'=""
SET RANGE=$$RANGE^BARUFUT1(RANGE)
+39 IF RANGE'=""
DO EXCLLST^BARUFUT1(RANGE,.LIST)
+40 SET CHOICE=$PIECE(CHOICE,"@")
+41 ;CHANGE ALL THE STATUSES WITHIN THE 'LIST' ARRAY
DO ALLSTAT(.LIST,CHOICE)
End DoDot:1
GOTO AGAIN
+42 ;
ASKSTAT ;EP - ASK STATUS TO VIEW
+1 NEW CNTS
+2 KILL STATCNTS
+3 DO CNTSTATS^BARUFUT1(.STATCNTS)
+4 KILL DIR
+5 SET DIR("A")="View which session status"
+6 SET DIR(0)="SO^O:OPEN"
IF $GET(STATCNTS("OPEN"))'=""
SET DIR(0)=DIR(0)_" ("_$GET(STATCNTS("OPEN"))_")"
+7 SET DIR(0)=DIR(0)_";RC:RECONCILED"
IF $GET(STATCNTS("RECONCILED"))'=""
SET DIR(0)=DIR(0)_" ("_$GET(STATCNTS("RECONCILED"))_")"
+8 SET DIR(0)=DIR(0)_";RV:REVIEWED/APPROVED"
IF $GET(STATCNTS("REVIEWED/APPROVED"))'=""
SET DIR(0)=DIR(0)_" ("_$GET(STATCNTS("REVIEWED/APPROVED"))_")"
+9 SET DIR(0)=DIR(0)_";T:TRANSMITTED"
IF $GET(STATCNTS("TRANSMITTED"))'=""
SET DIR(0)=DIR(0)_" ("_$GET(STATCNTS("TRANSMITTED"))_")"
+10 SET DIR(0)=DIR(0)_";RT:RETRANSMITTED"
IF $GET(STATCNTS("RETRANSMITTED"))'=""
SET DIR(0)=DIR(0)_" ("_$GET(STATCNTS("RETRANSMITTED"))_")"
+11 SET DIR(0)=DIR(0)_";ALL:ALL STATUSES"
IF $GET(STATCNTS("ALL STATUSES"))'=""
SET DIR(0)=DIR(0)_" ("_$GET(STATCNTS("ALL STATUSES"))_")"
+12 SET DIR(0)=DIR(0)_";Q:QUIT"
+13 KILL STATCNTS
+14 DO ^DIR
+15 IF Y=""
GOTO AGAIN
+16 IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DIRUT))!(Y="Q")
QUIT
+17 IF Y(0)'[("ALL")
SET STATUS=$PIECE(Y(0)," ")
+18 IF '$TEST
SET STATUS=$PIECE(Y(0)," ",1,2)
+19 GOTO AGAIN
+20 QUIT
+21 ;FUNCT ADDED FOR CHOCKTAW
GETDTLIM() ;GET 'UFMS DISPLAY DATE LIMIT'
+1 NEW DISLIM
+2 SET DISLIM=$$GET1^DIQ(90052.06,DUZ(2)_",",1504,"I")
+3 IF DISLIM'=""
SET X=DISLIM
SET %DT=""
DO ^%DT
SET DISLIM=Y
+4 QUIT DISLIM
+5 ;
LOOP(UDUZ,STAT,LINE,LIST,PRTSTAT) ;EP - GET DATA FROM SESSION LEVEL
+1 ;HEAT # 62222 MAR 2012 P.OTTIS
NEW SESSID,CNT,ERASTAT,RTCOUNT,CURSTAT,DAYZERO,DAYDISP,BARTMP
+2 ;START DISPLAY FROM THIS DATE UNLESS
SET DAYDISP=$$GETDISLM^BARUFUT1("I")
+3 ;ANY NOT TRANSMITTED SESSIONS ARE FOUND IN THE HISTORY (=OPEN)
SET DAYZERO=$$GETDAY0^BARUFUT1("I")
+4 ; ;HISTORY BEGINS ON DAYZERO
+5 ;START WITH LOWEST DAY
SET SESSID=DAYDISP
IF DAYZERO]""
IF DAYZERO<DAYDISP
SET SESSID=DAYZERO
+6 ;NOHEAT CHOCKTAW REQUEST: LIMIT DISPLAY FOR NON-IHS P.OTT
+7 SET BARTMP=$$GETDTLIM()
+8 ;;;W !,"ORIG SESSID=",SESSID
+9 ;;;W !,"THIS IS A NON-IHS FACILITY SESSID=",SESSID
IF '$$IHS^BARUFUT(DUZ(2))
IF BARTMP
SET SESSID=BARTMP
+10 ;<-- END OF NEW CODE P.OTT
+11 SET SESSID=SESSID-0.01
+12 ;
+13 FOR CNT=1:1
SET SESSID=$ORDER(^BARSESS(DUZ(2),"C",STAT,UDUZ,SESSID))
IF SESSID=""
QUIT
Begin DoDot:1
+14 ;bar*1.8*21 SDR
SET IENS=SESSID_","_UDUZ_","
+15 ;don't display sessions prior to 10/1/08 ;bar*1.8*22 IHS/SD/AML NOHEAT
IF ($PIECE($$GET1^DIQ(90057.11,IENS,.03,"I"),".")<3081001)
QUIT
+16 SET LINE=LINE+1
+17 SET CURSTAT=$$GET1^DIQ(90057.11,IENS,.02,"E")
+18 SET STATDATE=$$GET1^DIQ(90057.11,IENS,.03,"E")
+19 SET ERASTAT=$EXTRACT($$GET1^DIQ(90057.11,IENS,.04,"E"))
+20 SET POSTING=$$STILPOST^BARUFUT1(UDUZ)
+21 SET Y=STATDATE
XECUTE ^DD("DD")
SET STATDATE=Y
+22 SET CASHIER=$PIECE($GET(^VA(200,UDUZ,0)),U)
+23 IF STAT="RETRANSMITTED"
SET RTCOUNT=$$RTCOUNT^BARUFUT1(UDUZ,SESSID)
+24 SET LIST(LINE)=UDUZ_U_SESSID_U_ERASTAT
+25 IF $PIECE(SESSID,".")=$$GETDISLM^BARUFUT1("I")
IF (CURSTAT="OPEN")
DO EN^XBVIDEO("RVN")
+26 WRITE !,LINE,"."
+27 WRITE ?3,SESSID,?18,$EXTRACT(CASHIER,1,17),?36,STATDATE
+28 DO EN^XBVIDEO("RVF")
+29 IF STAT="RETRANSMITTED"
WRITE "(",RTCOUNT,")"
+30 WRITE ?58,$SELECT(PRTSTAT="ALL STATUSES":$EXTRACT(STAT,1,14),1:""),?72,$SELECT(+POSTING&(STAT="OPEN"):"*",1:""),?75,ERASTAT,?76,"\",?77,$SELECT(+POSTING=1&(CURSTAT="OPEN"):"Y",1:"")
End DoDot:1
+31 QUIT
+32 ;
+33 ;PRINT = 1 THEN ASK FOR DEVICE
EXPORTSM(LIST,PRINT) ;EXPORT SUMMARY
+1 ;LLIST(REC)=CASHIER DUZ_^_SESSION ID
IF '$DATA(LIST)
QUIT
+2 IF '$GET(PRINT)
DO PRINT
QUIT
+3 KILL DIR
+4 WRITE !!
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Print Summary Screen"
+7 SET DIR("B")="Y"
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y=0)
QUIT
+10 SET %ZIS="MQ"
+11 WRITE !!
+12 DO ^%ZIS
+13 IF POP
QUIT
+14 IF $DATA(IO("Q"))
DO QUE
QUIT
+15 USE IO
+16 DO PRINT
+17 DO ^%ZISC
+18 QUIT
QUE ; EP - QUE 'NOT SENT' OR 'DELAY SEND' REPORT
+1 ;;;S ZTRTN="PRINT^TIMTEST"
+2 ;"PRINT^TIMTEST" ;P.OTT #71924
SET ZTRTN="PRINT^BARUFSUP"
+3 SET ZTDESC="EXPORT SUMMARY REPORT"
+4 IF $DATA(LIST)=1
SET TMP=LIST
NEW LIST
SET LIST(1)=TMP
+5 SET REC=""
FOR
SET REC=$ORDER(LIST(REC))
IF 'REC
QUIT
SET ZTSAVE("LIST("_REC_")")=""
+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
+11 ;
PRINT ;
+1 NEW REC,UDUZ,SESSID,EQUALS,EXPDATE,PAGE
+2 SET $PIECE(EQUALS,"=",81)=""
+3 SET $PIECE(DASHES,"-",81)=""
+4 SET PAGE=1
+5 NEW GTOTALS,TOTALS
+6 SET GTOTALS("PAYMENT","CNT")=0
+7 SET GTOTALS("PAYMENT")=0
+8 SET GTOTALS("CREDITS")=0
+9 SET GTOTALS("CREDITS","CNT")=0
+10 SET GTOTALS("DEBITS")=0
+11 SET GTOTALS("DEBITS","CNT")=0
+12 SET GTOTALS("REFUND","CNT")=0
+13 SET GTOTALS("REFUND")=0
+14 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET EXPDATE=Y
+15 DO EXPHDR
+16 IF $DATA(LIST)=1
SET TMP=LIST
NEW LIST
SET LIST(1)=TMP
+17 SET REC=""
+18 FOR
SET REC=$ORDER(LIST(REC))
IF 'REC
QUIT
Begin DoDot:1
+19 SET UDUZ=$PIECE(LIST(REC),U)
+20 SET SESSID=$PIECE(LIST(REC),U,2)
+21 DO GETTOTS(UDUZ,SESSID)
End DoDot:1
+22 DO FOOTER
+23 QUIT
+24 ;
GETTOTS(UDUZ,SESSID) ;EP - DISPLAY EXPORT SUMMARIES
+1 ;SESSID - CASHIER SESSION
+2 NEW BARTR,ARCREDIT,ARDEBIT,TRANTYPE,AMT,IENS,CAT
+3 ;LOOP THROUGH USERS SESSION ENTRIES
+4 SET TOTALS("AAA PAYMENT")=0
+5 SET TOTALS("AAA PAYMENT","CNT")=0
+6 SET TOTALS("ADJ CO-PAY")=0
+7 SET TOTALS("ADJ CO-PAY","CNT")=0
+8 SET TOTALS("ADJ DEDUCTIBLE")=0
+9 SET TOTALS("ADJ DEDUCTIBLE","CNT")=0
+10 SET TOTALS("ADJ NON PAYMENT")=0
+11 SET TOTALS("ADJ NON PAYMENT","CNT")=0
+12 SET TOTALS("ADJ WRITE OFF")=0
+13 SET TOTALS("ADJ WRITE OFF","CNT")=0
+14 SET TOTALS("ADJ PENALTY")=0
+15 SET TOTALS("ADJ PENALTY","CNT")=0
+16 SET TOTALS("ADJ GROUPER ALLOWANCE")=0
+17 SET TOTALS("ADJ GROUPER ALLOWANCE","CNT")=0
+18 SET TOTALS("ADJ PAYMENT CREDIT")=0
+19 SET TOTALS("ADJ PAYMENT CREDIT","CNT")=0
+20 SET TOTALS("ZZZ REFUND")=0
+21 SET TOTALS("ZZZ REFUND","CNT")=0
+22 SET TOTALS("CREDITS")=0
+23 SET TOTALS("CREDITS","CNT")=0
+24 SET TOTALS("DEBITS")=0
+25 SET TOTALS("DEBITS","CNT")=0
+26 SET TOTALCNT=0
+27 ;
+28 SET BARTR=0
+29 FOR
SET BARTR=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTR))
IF 'BARTR
QUIT
Begin DoDot:1
+30 SET (ARCREDIT,ARDEBIT)=0
+31 SET IENS=BARTR_","
+32 ;A/R TRANS, BILL (A/R)
SET ARBILL=$$GET1^DIQ(90050.03,IENS,4,"E")
+33 IF ARBILL=""
QUIT
+34 ;A/R TRANS, CREDIT
SET ARCREDIT=$$GET1^DIQ(90050.03,IENS,2,"E")
+35 ;A/R TRANS, DEBIT
SET ARDEBIT=$$GET1^DIQ(90050.03,IENS,3,"E")
+36 SET AMT=ARCREDIT-ARDEBIT
+37 ;A/R TRANS, ADJ TYPE
SET TRANTYPE=$$GET1^DIQ(90050.03,IENS,101,"E")
+38 ;A/R TRANS, ADJ CATEGORY
SET ADJCAT=$$GET1^DIQ(90050.03,IENS,102,"E")
+39 IF TRANTYPE="PAYMENT"
SET CAT="AAA "_TRANTYPE
DO TOT(CAT,AMT,.TOTALS)
QUIT
+40 SET CAT=ADJCAT
+41 IF CAT="REFUND"
SET CAT="ZZZ "_CAT
DO TOT(CAT,AMT,.TOTALS)
QUIT
+42 IF CAT=""
SET CAT="ADJ UNDEF"
DO TOT(CAT,AMT,.TOTALS)
QUIT
+43 SET CAT="ADJ "_CAT
DO TOT(CAT,AMT,.TOTALS)
QUIT
End DoDot:1
IF $GET(ESC)
QUIT
+44 DO LIST(.TOTALS)
+45 SET GTOTALS("PAYMENT","CNT")=GTOTALS("PAYMENT","CNT")+TOTALS("AAA PAYMENT","CNT")
+46 SET GTOTALS("PAYMENT")=GTOTALS("PAYMENT")+TOTALS("AAA PAYMENT")
+47 SET GTOTALS("CREDITS")=GTOTALS("CREDITS")+TOTALS("CREDITS")
+48 SET GTOTALS("CREDITS","CNT")=GTOTALS("CREDITS","CNT")+TOTALS("CREDITS","CNT")
+49 SET GTOTALS("DEBITS")=GTOTALS("DEBITS")+TOTALS("DEBITS")
+50 SET GTOTALS("DEBITS","CNT")=GTOTALS("DEBITS","CNT")+TOTALS("DEBITS","CNT")
+51 SET GTOTALS("REFUND")=GTOTALS("REFUND")+TOTALS("ZZZ REFUND")
+52 SET GTOTALS("REFUND","CNT")=GTOTALS("REFUND","CNT")+TOTALS("ZZZ REFUND","CNT")
+53 QUIT
+54 ;
TOT(CAT,AMT,TOTALS) ;
+1 SET TOTALS(CAT)=$GET(TOTALS(CAT))+AMT
+2 SET TOTALS(CAT,"CNT")=$GET(TOTALS(CAT,"CNT"))+1
+3 SET TOTALCNT=TOTALCNT+$GET(TOTALS(CAT,"CNT"))
+4 IF CAT[("ADJ")
Begin DoDot:1
+5 SET TOTALS("CREDITS")=TOTALS("CREDITS")+ARCREDIT
+6 SET TOTALS("DEBITS")=TOTALS("DEBITS")+ARDEBIT
+7 IF ARCREDIT
SET TOTALS("CREDITS","CNT")=TOTALS("CREDITS","CNT")+1
+8 IF '$TEST
SET TOTALS("DEBITS","CNT")=TOTALS("DEBITS","CNT")+1
End DoDot:1
+9 ;W !,CAT,?20,AMT,?35,ARCREDIT,?45,ARDEBIT ;TESTING ONLY
+10 QUIT
+11 ;
LIST(TOTALS) ;EP - DISPLAY CALCULATED TOTS
+1 NEW CATEGORY,ADJCAT,ADJCNT,ADJAMT
+2 WRITE !,SESSID
+3 WRITE ?16,$EXTRACT($PIECE(^VA(200,UDUZ,0),U),1,7)
+4 WRITE ?28,TOTALS("AAA PAYMENT","CNT")
+5 WRITE ?29,$JUSTIFY(TOTALS("AAA PAYMENT"),10,2)
+6 WRITE ?41,TOTALS("CREDITS","CNT")
+7 WRITE ?42,$JUSTIFY(TOTALS("CREDITS"),10,2)
+8 WRITE ?54,TOTALS("DEBITS","CNT")
+9 WRITE ?56,$JUSTIFY(-TOTALS("DEBITS"),10,2)
+10 WRITE ?68,TOTALS("ZZZ REFUND","CNT")
+11 WRITE ?70,$JUSTIFY(TOTALS("ZZZ REFUND"),10,2)
+12 QUIT
+13 ;IF THE SESSION HAS BEEN TRANSMITTED SHOW THE FILE
+14 IF $DATA(^BARSESS(DUZ(2),UDUZ,11,SESSID,21))
Begin DoDot:1
+15 WRITE !,"TRANSMITTED ON: "
+16 NEW TRANREC,TRANTIME,IENS,TRANFILE,TRANBY,CNT
+17 SET TRANREC=0
+18 FOR CNT=1:1
SET TRANREC=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,TRANREC))
IF 'TRANREC
QUIT
Begin DoDot:2
+19 SET IENS=TRANREC_","_SESSID_","_UDUZ_","
+20 SET TRANTIME=$$GET1^DIQ(90057.210101,IENS,.01,"E")
+21 SET TRANFILE=$$GET1^DIQ(90057.210101,IENS,.02,"E")
+22 SET TRANBY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
+23 IF CNT'=1
WRITE !
+24 WRITE ?16,TRANTIME," BY ",TRANBY
+25 WRITE !?16,TRANFILE
End DoDot:2
End DoDot:1
+26 ;
EXPHDR ;EP -DISPLAY HDR
+1 WRITE @IOF
+2 WRITE !,EQUALS
+3 WRITE !,"Export Summary Print",?45,EXPDATE,?70,"Page ",PAGE
+4 WRITE !,"A/R Location: ",$PIECE(^DIC(4,DUZ(2),0),U)
+5 WRITE !,EQUALS
+6 WRITE !,"Please ensure the following information is correct:"
+7 WRITE !!
+8 WRITE !,"SESSION ID",?16,"CASHIER",?30,"PAYMENTS",?50,"ADJUSTMENTS",?70,"REFUNDS"
+9 WRITE !,?45,"CREDITS DEBITS"
+10 SET PAGE=PAGE+1
+11 QUIT
+12 ;
+1 WRITE !,DASHES
+2 WRITE !,"TOTALS:"
+3 WRITE ?28,GTOTALS("PAYMENT","CNT")
+4 WRITE ?29,$JUSTIFY(GTOTALS("PAYMENT"),10,2)
+5 WRITE ?41,GTOTALS("CREDITS","CNT")
+6 WRITE ?42,$JUSTIFY(GTOTALS("CREDITS"),10,2)
+7 WRITE ?54,GTOTALS("DEBITS","CNT")
+8 WRITE ?56,$JUSTIFY(-GTOTALS("DEBITS"),10,2)
+9 WRITE ?68,GTOTALS("REFUND","CNT")
+10 WRITE ?70,$JUSTIFY(GTOTALS("REFUND"),10,2)
+11 QUIT
