BARUFSUP.m

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

 ;

FOOTER ;EP -PRINT GRAND TOTS

 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"))_")"