BARUFUT ; IHS/SD/TPF - UTILITIES FOR UFMS ; 09/19/2007
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,7,13,21,22,23,24,26**;OCT 26, 2005;Build 17
;OCT 2012 P.OTTIS NOHEAT: ALLOW RE-CONNECT TO LAST OPEN SESSION AFTER LOG-OFF / OR
; SWITCHING FALICITIES
;HEAT147572 P.OTT ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS
;IHS/SD/SDR 1.8*26 HEAT170856 Made correction to cancelled bills check
Q
;
NOTLOGIN() ;EP - DISPLAY NOT LOGGED IN MESSAGE
NEW BARTMP ;P.OTT
S BARTMP=$$OPENSTAT^BARUFUT(DUZ) I BARTMP]"" S UFMSESID=BARTMP Q 0
;SET UFMSESID=0 FOR TRIBAL SITES WITH SESSION TURNED OFF
I $$GET1^DIQ(90052.06,DUZ(2)_",",1503,"I") S UFMSESID=0 Q 0 ;BAR*1.8*4 IM26090
Q:($$CURSTAT(DUZ,+$G(UFMSESID),"E")="OPEN") 0 ;bar*1.8*21 SDR
I $$CURSTAT(DUZ,+$G(UFMSESID),"E")="CLOSED" D
.W !!,"YOUR SESSION HAS BEEN CLOSED"
I $$CURSTAT(DUZ,+$G(UFMSESID),"E")="" D
.W !!!,"* * YOU DO NOT HAVE AN OPEN SESSION UNDER DIVISION "_$P(^DIC(4,DUZ(2),0),U)_"."
.W !,"YOU MUST SIGN IN UNDER "_$P(^DIC(4,DUZ(2),0),U)_" TO BE ABLE"
.W !," TO PERFORM POSTING/COLLECTION FUNCTIONS UNDER THIS FACILITY* *"
W !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM POSTING/COLLECTION FUNCTIONS! * *"
D ASKFORRT
Q 1
;
GETSESID(UDUZ) ;EP - CREATE SESSION ID
N SESSID
I '$D(^BARSESS(DUZ(2),0)) D
.S ^BARSESS(DUZ(2),0)="A/R UFMS CASHIER SESSION LOG^90057P^^0"
I '$D(^BARSESS(DUZ(2),UDUZ)) D Q:Y<0 0
.K DIC,DIE,DR,DA,DIR
.S X="`"_UDUZ
.S DIC(0)="L"
.S DIC="^BARSESS(DUZ(2),"
.D ^DIC
K DIC,DIE,DR,DA,DIR
D NOW^%DTC
S SESSID=%
S DA(1)=UDUZ
S X=SESSID
S DIC(0)="L"
S DIC("P")=$P(^DD(90057,1101,0),U,2)
S DIC="^BARSESS(DUZ(2),"_DA(1)_",11,"
D ^DIC
Q:Y<0 0
S X=$$SETSESS(UDUZ,$P(Y,U,2),"O") Q:X=0 0 ;set this session to OPEN STATUS
;S CURDUZ2=DUZ(2) ;SET A CURRENT DUZ(2) USE LATER TO SEE IF IT CHANGED. BAR*1.8*21 HEAT43337
Q SESSID
;
OPENSTAT(UDUZ) ;EP - RETURN **LAST** SESSION DATE THAT IS OPEN
N SESSID
S SESSID=$O(^BARSESS(DUZ(2),"C","OPEN",UDUZ,""),-1) ;P.OTT (ADDED -1: REVERSE LOOKUP)
Q SESSID
;
CURSTAT(UDUZ,SESSID,FLAGS) ;EP - RETURN CURRENT STATUS
N DATETIME,STATUS
S:$G(FLAGS)="" FLAGS="E"
S STATUS=$$GET1^DIQ(90057.11,SESSID_","_UDUZ_",",.02,FLAGS) ;RETURN LAST SESSION STATUS
Q STATUS
;
OUTORREC(SESSID) ;EP - ASK USER IF THEY WANT TO LOG OUT OR RECONCILE TRUE=LOGOUT
I SESSID D ;Add check for status MRS:BAR*1.8*4
.S STATUS=$$CURSTAT(DUZ,SESSID,.FLAGS)
.I STATUS["TRANSMITTED" S SESSID=0
Q:'SESSID 0 ;IF SESSID=0 THEN MODE IS PROGRAMMER SESSION LOGGING BYPASS
N ANSWER
W !!!,"You are still logged in to"
W !,"'Cashiering Mode' function with session id ",$G(SESSID),!
K DIR
S DIR(0)="YO"
S DIR("A")="Do you wish to sign out of 'Cashiering Mode' and reconcile for the day?"
S DIR("B")="NO"
D ^DIR
S ANSWER=Y
I 'ANSWER D Q 'ANSWER
.S X=$$DELFLG^BARUFUT1(DUZ,UFMSESID)
Q 0
;
FINDTRAN(TPBIEN,TRARRAY) ;EP - GIVEN A 3PBIEN FROM THE UFMS ERROR REPORT
S TPBBILL=$P($G(^ABMDBILL(DUZ(2),TPBIEN,0)),U)
S ARBILL=$O(^BARBL(DUZ(2),"B",TPBBILL))
S ARBILIEN=$O(^BARBL(DUZ(2),"B",ARBILL,""))
S TRIEN=""
F CNT=1:1 S TRIEN=$O(^BARTR(DUZ(2),"AC",ARBILIEN,TRIEN)) Q:'TRIEN D
.S TRARRAY(CNT)=TRIEN
Q
;
ASKACT(UDUZ,SESSID,ACTION,MODE,ERASTAT) ;EP - ASK FOR AN ACTION TO TAKE. CALLED FROM BARUFLOG. ONLY ONE SESSION
ASKACT1 ;EP -
N CURSTAT
S CURSTAT=$$CURSTAT(UDUZ,SESSID,"E")
K DIR
K X,Y ;IHS/SD/SDR 5/6/09 HEAT3915 BAR*1.8*13
I CURSTAT="OPEN" D
.S DIR("A",1)="RC/Reconcile V/iew Transactions S/Status History"
.S DIR("A")="Enter Action"
.S VALIDCHK="I (U_""RC""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
I CURSTAT="OPEN",(ERASTAT="YES") D
.S DIR("A",1)="V/iew Transactions S/Status History"
.S DIR("A")="Enter Action"
.S VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
I CURSTAT="OPEN",('$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,0))),(MODE="VIEW") D
.S DIR("A",1)="There is no posting activity. You may delete this session or leave it open. "
.S DIR("A",2)="If you leave it open the cashier will be reassigned this session when they"
.S DIR("A",3)="log back in."
.I $$STILPOST^BARUFUT1(UDUZ) D
..S DIR("A",4)="Before deleting the session BE CAREFUL! It appears the cashier is STILL"
..S DIR("A",5)="LOGGED IN and may still be posting"
.S DIR("A")="D/Delete"
.S VALIDCHK="I (U_""D""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
I CURSTAT="RECONCILED" D
.S DIR("A",1)="RV/Review/Approve V/iew Transactions S/Status History"
.S DIR("A")="Enter Action"
.S VALIDCHK="I (U_""RV""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
I CURSTAT="REVIEWED/APPROVED" D
.S DIR("A",1)="T/Transmit V/iew Transactions S/Status History"
.S DIR("A")="Enter Action"
.S VALIDCHK="I (U_""T""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
;BAR*1.8*4 ITEM 2 SCR58 DISABLE RETRANSMIT
I CURSTAT="TRANSMITTED" D
.;S DIR("A",1)="RT/Retransmit V/iew Transactions S/Status History"
.S DIR("A",1)="V/iew Transactions S/Status History"
.S DIR("A")="Enter Action"
.;S VALIDCHK="I (U_""RT""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
.S VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
I CURSTAT="RETRANSMITTED" D
.;S DIR("A",1)="RT/Retransmit V/iew Transactions S/Status History"
.S DIR("A",1)="V/iew Transactions S/Status History"
.S DIR("A")="Enter Action"
.;S VALIDCHK="I (U_""RT""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
.S VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
;END BAR*1.8*4 ITEM 2 SCR58
I MODE="CASHIER" D
.I CURSTAT="OPEN" D
..S DIR("A",1)="RC/Reconcile V/iew Transactions S/Status History"
..S VALIDCHK="I (U_""RC""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
..I '$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,0)) D
...S DIR("A",1)="D/elete Session"
...S VALIDCHK="I (U_""D""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
.E D
..S DIR("A",1)="V/iew Transactions S/Status History"
..S VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
.S DIR("A")="Enter Action"
;IF MODE="OUT" THEN THIS WAS CALLED FROM THE SIGN OUT AND THE CASHIER IS
;IN THE PROCESS OF SIGNING OUT. JUST DISPLAY THE COUNTS AND LEAVE.
I MODE="OUT" Q
I MODE="NEW" D ASKFORRT^BARUFUT Q
S DIR(0)="FO"
D ^DIR
S Y=$$UPC^BARUTL(Y)
S ACTION=Y
I $D(DIRUT)!($D(DTOUT))!($D(DIRUT))!(Y="")!(Y="Q") Q
X VALIDCHK
;IHS/SD/TPF BAR*1.8*21 IN HOUSE TESING
S POSTING=$$STILPOST^BARUFUT1(UDUZ)
I +POSTING=1,(ACTION="RC") D Q ;IS THE USER STILL LOGGED ON OR POSTING?
.W !!,"CANNOT RECONCILE SESSION ",SESSID
.W !,"THE CASHIER IS ",$P(POSTING,U,2)
.D ASKFORRT^BARUFUT
;END BAR*1.8*21
I ACTION="D" D DELETE^BARUFUT1(UDUZ,SESSID) Q
I ACTION'="T",(ACTION'="RT"),(ACTION'="V"),(ACTION'="S") D SETSESS(UDUZ,SESSID,ACTION) Q
I ACTION="V" D VIEWTRAN^BARUFUT0(UDUZ,SESSID,ERASTAT) Q
I ACTION="S" D VIEWSTAT^BARUFUT0(UDUZ,SESSID) Q
;D TRANSMIT(UDUZ,SESSID,ACTION) ;IF 'T' OR 'RT' THEN TRANSMIT ;MRS:BAR*1.8*7 IM30562
;I ACTION="T" D TRANSMIT(UDUZ,SESSID,ACTION) ;MAKE SURE IT IS "T" ;MRS:BAR*1.8*7 IM30562
;BEGIN BAR*1.8*17 IHS/SD/TPF PRINT EXPORT SUMMARY
I ACTION="T" D
.D EXPORTSM^BARUFSUP(LIST(CHOICE),0) ;EXPORT SUMMARY
.D TRANSMIT(UDUZ,SESSID,ACTION) ;MAKE SURE IT IS "T" ;MRS:BAR*1.8*7 IM30562
.D EXPORTSM^BARUFSUP(LIST(CHOICE),1)
.;END BAR*1.8*17
Q
;
ASKFORRT ;EP - ASK FOR <RETURN>
W !
K DIR S DIR(0)="E" D ^DIR K DIR
Q
;
SELTRAN(UDUZ,SESSID) ;EP - SELECT AND TRANSMIT ONE OR MORE TRANSACTIONS FROM A SESSION
Q ;DISABLED MRS:BAR*1.8*7 IM30715
N CHOICE,SELECT,TRDATE,LINE,PIECE,BARNOW
K TRANS
D TRANHDR^BARUFUT0(UDUZ,SESSID)
S TRDATE=0
F LINE=1:1 S TRDATE=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE)) Q:'TRDATE D
.S CREDIT=$$GET1^DIQ(90050.03,TRDATE_",",2)
.S DEBIT=$$GET1^DIQ(90050.03,TRDATE_",",3)
.S TRANTYP=$$GET1^DIQ(90050.03,TRDATE_",",101,"E")
.S ADJCAT=$$GET1^DIQ(90050.03,TRDATE_",",102,"E")
.S TRANS(LINE)=TRDATE
.I $Y>(IOSL-5) D ASKFORRT D TRANHDR^BARUFUT0(UDUZ,SESSID) Q
.W !,LINE,"."
.W ?4,DATE,?25,$J(CREDIT,8,2),?35,$J(DEBIT,8,2),?50,TRANTYP,?65,ADJCAT
S LINE=LINE-1
K DIR
S DIR(0)="LO^1:"_LINE
S DIR("A")="Select Transactions to Transmit"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))
Q:(Y="")
S SELECT=Y
D EXCLLST^BARUFUT1(","_SELECT,.TRANS)
;SEND MULTIPLE TRANSACTIONS IN ONE FILE
;D ONETRAN^BARUFEX(.TRANS) ;MRS:BAR*1.8*4 SCR80 4.1.1
D ONETRAN^BARUFEX(.TRANS,SESSID) ;MRS:BAR*1.8*4 SCR80 4.1.1
;SET SINGLE A/R TRANSACTION AS BEING SENT
D NOW^%DTC
S BARNOW=%
F PIECE=1:1 S CHOICE=$P(SELECT,",",PIECE) Q:CHOICE="" D
.K DIR,DIC,DIE,DR,DA
.S DA(2)=UDUZ,DA(1)=SESSID,DA=TRANS(CHOICE)
.S DR=".02///^S X=1;.03////^S X=DUZ;.04///^S X=BARNOW"
.S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
.D ^DIE
Q 1
;
TRANSMIT(UDUZ,SESSID,ACTION) ;EP - TRANSMIT/RETRANSMIT SESSION
N BARFILE
I $D(SESSID)'=1 G CONT
S CURSTAT=$$CURSTAT(UDUZ,SESSID,"E")
W !,"CURRENT STATUS OF SESSION ID: ",CURSTAT
;I CURSTAT'="REVIEWED/APPROVED",(CURSTAT'="TRANSMITTED"),(CURSTAT'="RETRANSMITTED") D Q ;MRS:BAR*1.8*6 IM29616
;.W !!,"SESSION STATUS MUST BE REVIEWED/APPROVED, TRANSMITTED" ;MRS:BAR*1.8*6 IM29616
;.W !,"OR RETRANSMITTED TO BE ABLE TO TRANSMIT THE SESSION!" ;MRS:BAR*1.8*6 IM29616
I CURSTAT'="REVIEWED/APPROVED" D Q ;MRS:BAR*1.8*6 IM29616
.W !!,"SESSION STATUS MUST BE REVIEWED/APPROVED" ;MRS:BAR*1.8*6 IM29616
.W !,"TO BE ABLE TO TRANSMIT THE SESSION!" ;MRS:BAR*1.8*6 IM29616
.H 2
CONT ;EP - SEND THE SESSION TO THE EXTRACTER
S BARFILE=$$PULLSESS^BARUFEX(UDUZ,.SESSID)
;I +BARFILE=0 W !,"NO TRANSACTIONS SENT FROM SESSION!" H 3 Q
I +BARFILE=0 W !,"NO TRANSACTIONS SENT FROM SESSION!" D Q
.K DIR
.S DIR(0)="E"
.D ^DIR
.;BEGIN MOD TO UNLOCK SESSIONS;MRS:BAR*1.8*7 IM30562
.S REC=""
.F S REC=$O(SESSID(REC)) Q:'REC D
..S UDUZ=$P(SESSID(REC),U)
..S SESSID=$P(SESSID(REC),U,2)
..LOCK -^BARSESS(DUZ(2),UDUZ,11,SESSID)
.;END MOD TO UNLOCK SESSION;MRS:BAR*1.8*7 IM30562
I +BARFILE S BARFILE=$P(BARFILE,U,2)
S RETCODE=$$SETTRANS^BARUFUT0(UDUZ,.SESSID,BARFILE)
K DIR
S DIR(0)="E"
D ^DIR
Q
;
SETSESS(UDUZ,SESSID,BARSTAT) ;EP - SET SESSION STATUS 'BARSTAT'
Q:$G(BARSTAT)=""
S STATCHG=$$ADDSTAT(UDUZ,SESSID) ;CREATE A NEW STATUS CHANGE DATE/TIME
I +STATCHG<1 D Q 0
.W !!,"UNABLE TO MAKE A CHANGE IN STATUS FOR SESSION ID ",SESSID
.K DIR
.S DIR(0)="E"
.D ^DIR
K DIC,DIE,DR,DA,DIR
S DA(2)=UDUZ
S DA(1)=SESSID
S DA=$P(STATCHG,U)
S DR=".02///^S X=BARSTAT;.03////^S X=DUZ"
S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",1,"
D ^DIE
K DIC,DIE,DR,DA,DIR
I $G(MODE)="CASHIER" K UFMSESID
Q 1
;
ADDSTAT(UDUZ,SESSID) ; EP - ;CREATE A NEW STATUS CHANGE DATE/TIME
K DIC,DIE,DR,DA,DIR
D NOW^%DTC
S X=%
S DA(2)=UDUZ
S DA(1)=SESSID
S DIC("P")=$P(^DD(90057.11,110101,0),U,2)
S DIC="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",1,"
S DIC(0)="L"
D ^DIC
Q:Y<0 0
Q Y
;
TRANTRIG(UDUZ,SESSID,BARTRAN) ;EP - CREATE TRANSACTION ENTRY IN SESSION
Q:'SESSID 0 ;WHEN SESSID=0 THE MODE IS PROGRAMMER SESSION LOGGIN BYPASS
I $$CURSTAT(UDUZ,SESSID,"E")'="OPEN" Q 0 ;IHS/SD/PKD 1.8*21 Check current session status
N RET,ASUFAC,DUZ2HOLD
K DIC,DIE,DR,DA,DIR
S DA(2)=UDUZ
S DA(1)=SESSID
S X=BARTRAN
S DIC("P")=$P(^DD(90057.11,110102,0),U,2)
S DIC="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
S DIC(0)="L"
D ^DIC
K DIC,DIE,DR,DA,DIR
Q:Y<0 0
S RET=+Y
;PLACE THE ASUFACASUFAC3PIEN IN ITS FIELD
S ASUFAC=$$ASUFAC^BARUFUT1(DUZ(2),RET)
S DA(2)=UDUZ
S DA(1)=SESSID
S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
S DA=RET
S DR=".05///^S X=ASUFAC"
D ^DIE
;LETS SEE IF 3P CAN PROVIDE AN 'INVOICE #'
N IENS,ARBILLIN,TPBIEN,TPBDUZ2,UFMSSUFC
S IENS=BARTRAN_","
S ARBILLIN=$$GET1^DIQ(90050.03,IENS,4,"I") ;A/R TRANSACTIONS, BILL (A/R) PTR
S TPBIEN=$$GET1^DIQ(90050.01,ARBILLIN_",",17,"I") ;A/R BILL, 3P IEN (DA)
;BAR*1.8*4 IM26555,IM26610 ET AL
S TPBDUZ2=$$GET1^DIQ(90050.01,ARBILLIN_",",22,"I") ;A/R BILL, 3P DUZ(2)
Q:'TPBDUZ2 0
Q:'TPBIEN 0
;END BAR*1.8*4
S UFMSSUFC=0
I $L($T(TRANSMIT^ABMUEAPI)) S UFMSSUFC=$$TRANSMIT^ABMUEAPI(TPBDUZ2,TPBIEN)
;Q:UFMSSUFC=0 RET
Q:UFMSSUFC=0!(UFMSSUFC=-1) RET ;BAR*1.8*4 FOUND DURING TESTING
;IF 3P GIVES US AN INVOICE, USE IT INSTEAD OF THE ONE FROM A/R
K DIC,DIE,DR,DA,DIR
S DA(2)=UDUZ
S DA(1)=SESSID
S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
S DA=RET
S DR=".05///^S X=UFMSSUFC"
D ^DIE
K DIC,DIE,DR,DA,DIR
Q RET
;
IHS(DUZ2) ;EP - RETURN TRUE IF IHS AFFILIATION
N REC,AFFIL
S REC=$O(^AUTTLOC(DUZ2,11,""),-1)
S AFFIL=$$GET1^DIQ(9999999.0611,REC_","_DUZ2_",",.03,"I")
Q AFFIL=1 ;1 MEANS IHS
;NEW CODE :HEAT147572
IHSNEGB(DUZ2) ;EP - CHECK IF ERA POSTING NB IS ALLOWED (1)
;RETURNS 1 IF:
; (1) AFFILIATION=IHS
; (2) AFFILIATION'=IHS AND FLAG 1402 (20;5) ALLOW ERA POSTING NEG BAL = "N"
;FLAG: 1402 ERA POSTING: ALLOW POSTING OF NEGATIVE BALANCES N - follow Fed rules
I $$IHS(DUZ2) Q 1 ;FED
;I $P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,5)="" Q 0 ;IF NO FLAG SET ;bar*1.8*26 IHS/SD/SDR HEAT170856
I $P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,5)="" Q 1 ;IF NO FLAG SET ;bar*1.8*26 IHS/SD/SDR HEAT170856
Q '($P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,5)="Y") ;P.OTT ;2/4/2014
;;NEW CODE :HEAT147572
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
IHSCANCB(DUZ2) ;EP - CHECK IF ERA POSTING CANCELLED BILLS IS ALLOWED (1)
;Q $P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,6)="Y" ;P.OTT ;bar*1.8*26 IHS/SD/SDR HEAT170856
I $$IHS(DUZ2) Q 0 ;bar*1.8*26 IHS/SD/SDR HEAT170856
I $P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,6)="" Q 0 ;bar*1.8*26 IHS/SD/SDR HEAT170856
Q ($P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,6)="Y") ;P.OTT ;bar*1.8*26 IHS/SD/SDR HEAT170856
;END OF NEW CODE :HEAT147572
NOTOPEN(DUZ,UFMSESID) ;EP - IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490 EXIT CASHIER IF SESSION NOT OPEN
;IF STATUS CHANGES WHILE CASHIER IS POSTING KICK CASHIER OUT
;BAROPEN not New'd - used in calling routine. want to finish filing if started
Q:$G(UFMSESID)="" 1 ;UFMSESID NOT DEFINED THEN SESSION IS NOT OPEN
;W !!,"FOR TESTING ONLY: CHECKING SESSION STATUS"
;I $$CURSTAT(DUZ,UFMSESID,"E")'="OPEN" D Q 1 ;bar*1.8*21 SDR
I $$CURSTAT(DUZ,UFMSESID,"E")'="",$$CURSTAT(DUZ,UFMSESID,"E")'="OPEN" D Q 1 ;bar*1.8*21 SDR
.W !!,"**Your cashiering session is no longer in an OPEN status.**"
.W !,"Please open a new cashiering session to continue Posting.",!
.D CANCEL^BARPST3 ;Kill the scratch global
.S X=$$DELFLG^BARUFUT1(DUZ,UFMSESID) ;
.S UFMSESID="" ;CLEAR SESSION ID
.D ASKFORRT^BARUFUT
Q 0
BARUFUT ; IHS/SD/TPF - UTILITIES FOR UFMS ; 09/19/2007
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,6,7,13,21,22,23,24,26**;OCT 26, 2005;Build 17
+2 ;OCT 2012 P.OTTIS NOHEAT: ALLOW RE-CONNECT TO LAST OPEN SESSION AFTER LOG-OFF / OR
+3 ; SWITCHING FALICITIES
+4 ;HEAT147572 P.OTT ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS
+5 ;IHS/SD/SDR 1.8*26 HEAT170856 Made correction to cancelled bills check
+6 QUIT
+7 ;
NOTLOGIN() ;EP - DISPLAY NOT LOGGED IN MESSAGE
+1 ;P.OTT
NEW BARTMP
+2 SET BARTMP=$$OPENSTAT^BARUFUT(DUZ)
IF BARTMP]""
SET UFMSESID=BARTMP
QUIT 0
+3 ;SET UFMSESID=0 FOR TRIBAL SITES WITH SESSION TURNED OFF
+4 ;BAR*1.8*4 IM26090
IF $$GET1^DIQ(90052.06,DUZ(2)_",",1503,"I")
SET UFMSESID=0
QUIT 0
+5 ;bar*1.8*21 SDR
IF ($$CURSTAT(DUZ,+$GET(UFMSESID),"E")="OPEN")
QUIT 0
+6 IF $$CURSTAT(DUZ,+$GET(UFMSESID),"E")="CLOSED"
Begin DoDot:1
+7 WRITE !!,"YOUR SESSION HAS BEEN CLOSED"
End DoDot:1
+8 IF $$CURSTAT(DUZ,+$GET(UFMSESID),"E")=""
Begin DoDot:1
+9 WRITE !!!,"* * YOU DO NOT HAVE AN OPEN SESSION UNDER DIVISION "_$PIECE(^DIC(4,DUZ(2),0),U)_"."
+10 WRITE !,"YOU MUST SIGN IN UNDER "_$PIECE(^DIC(4,DUZ(2),0),U)_" TO BE ABLE"
+11 WRITE !," TO PERFORM POSTING/COLLECTION FUNCTIONS UNDER THIS FACILITY* *"
End DoDot:1
+12 WRITE !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM POSTING/COLLECTION FUNCTIONS! * *"
+13 DO ASKFORRT
+14 QUIT 1
+15 ;
GETSESID(UDUZ) ;EP - CREATE SESSION ID
+1 NEW SESSID
+2 IF '$DATA(^BARSESS(DUZ(2),0))
Begin DoDot:1
+3 SET ^BARSESS(DUZ(2),0)="A/R UFMS CASHIER SESSION LOG^90057P^^0"
End DoDot:1
+4 IF '$DATA(^BARSESS(DUZ(2),UDUZ))
Begin DoDot:1
+5 KILL DIC,DIE,DR,DA,DIR
+6 SET X="`"_UDUZ
+7 SET DIC(0)="L"
+8 SET DIC="^BARSESS(DUZ(2),"
+9 DO ^DIC
End DoDot:1
IF Y<0
QUIT 0
+10 KILL DIC,DIE,DR,DA,DIR
+11 DO NOW^%DTC
+12 SET SESSID=%
+13 SET DA(1)=UDUZ
+14 SET X=SESSID
+15 SET DIC(0)="L"
+16 SET DIC("P")=$PIECE(^DD(90057,1101,0),U,2)
+17 SET DIC="^BARSESS(DUZ(2),"_DA(1)_",11,"
+18 DO ^DIC
+19 IF Y<0
QUIT 0
+20 ;set this session to OPEN STATUS
SET X=$$SETSESS(UDUZ,$PIECE(Y,U,2),"O")
IF X=0
QUIT 0
+21 ;S CURDUZ2=DUZ(2) ;SET A CURRENT DUZ(2) USE LATER TO SEE IF IT CHANGED. BAR*1.8*21 HEAT43337
+22 QUIT SESSID
+23 ;
OPENSTAT(UDUZ) ;EP - RETURN **LAST** SESSION DATE THAT IS OPEN
+1 NEW SESSID
+2 ;P.OTT (ADDED -1: REVERSE LOOKUP)
SET SESSID=$ORDER(^BARSESS(DUZ(2),"C","OPEN",UDUZ,""),-1)
+3 QUIT SESSID
+4 ;
CURSTAT(UDUZ,SESSID,FLAGS) ;EP - RETURN CURRENT STATUS
+1 NEW DATETIME,STATUS
+2 IF $GET(FLAGS)=""
SET FLAGS="E"
+3 ;RETURN LAST SESSION STATUS
SET STATUS=$$GET1^DIQ(90057.11,SESSID_","_UDUZ_",",.02,FLAGS)
+4 QUIT STATUS
+5 ;
OUTORREC(SESSID) ;EP - ASK USER IF THEY WANT TO LOG OUT OR RECONCILE TRUE=LOGOUT
+1 ;Add check for status MRS:BAR*1.8*4
IF SESSID
Begin DoDot:1
+2 SET STATUS=$$CURSTAT(DUZ,SESSID,.FLAGS)
+3 IF STATUS["TRANSMITTED"
SET SESSID=0
End DoDot:1
+4 ;IF SESSID=0 THEN MODE IS PROGRAMMER SESSION LOGGING BYPASS
IF 'SESSID
QUIT 0
+5 NEW ANSWER
+6 WRITE !!!,"You are still logged in to"
+7 WRITE !,"'Cashiering Mode' function with session id ",$GET(SESSID),!
+8 KILL DIR
+9 SET DIR(0)="YO"
+10 SET DIR("A")="Do you wish to sign out of 'Cashiering Mode' and reconcile for the day?"
+11 SET DIR("B")="NO"
+12 DO ^DIR
+13 SET ANSWER=Y
+14 IF 'ANSWER
Begin DoDot:1
+15 SET X=$$DELFLG^BARUFUT1(DUZ,UFMSESID)
End DoDot:1
QUIT 'ANSWER
+16 QUIT 0
+17 ;
FINDTRAN(TPBIEN,TRARRAY) ;EP - GIVEN A 3PBIEN FROM THE UFMS ERROR REPORT
+1 SET TPBBILL=$PIECE($GET(^ABMDBILL(DUZ(2),TPBIEN,0)),U)
+2 SET ARBILL=$ORDER(^BARBL(DUZ(2),"B",TPBBILL))
+3 SET ARBILIEN=$ORDER(^BARBL(DUZ(2),"B",ARBILL,""))
+4 SET TRIEN=""
+5 FOR CNT=1:1
SET TRIEN=$ORDER(^BARTR(DUZ(2),"AC",ARBILIEN,TRIEN))
IF 'TRIEN
QUIT
Begin DoDot:1
+6 SET TRARRAY(CNT)=TRIEN
End DoDot:1
+7 QUIT
+8 ;
ASKACT(UDUZ,SESSID,ACTION,MODE,ERASTAT) ;EP - ASK FOR AN ACTION TO TAKE. CALLED FROM BARUFLOG. ONLY ONE SESSION
ASKACT1 ;EP -
+1 NEW CURSTAT
+2 SET CURSTAT=$$CURSTAT(UDUZ,SESSID,"E")
+3 KILL DIR
+4 ;IHS/SD/SDR 5/6/09 HEAT3915 BAR*1.8*13
KILL X,Y
+5 IF CURSTAT="OPEN"
Begin DoDot:1
+6 SET DIR("A",1)="RC/Reconcile V/iew Transactions S/Status History"
+7 SET DIR("A")="Enter Action"
+8 SET VALIDCHK="I (U_""RC""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:1
+9 IF CURSTAT="OPEN"
IF (ERASTAT="YES")
Begin DoDot:1
+10 SET DIR("A",1)="V/iew Transactions S/Status History"
+11 SET DIR("A")="Enter Action"
+12 SET VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:1
+13 IF CURSTAT="OPEN"
IF ('$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,0)))
IF (MODE="VIEW")
Begin DoDot:1
+14 SET DIR("A",1)="There is no posting activity. You may delete this session or leave it open. "
+15 SET DIR("A",2)="If you leave it open the cashier will be reassigned this session when they"
+16 SET DIR("A",3)="log back in."
+17 IF $$STILPOST^BARUFUT1(UDUZ)
Begin DoDot:2
+18 SET DIR("A",4)="Before deleting the session BE CAREFUL! It appears the cashier is STILL"
+19 SET DIR("A",5)="LOGGED IN and may still be posting"
End DoDot:2
+20 SET DIR("A")="D/Delete"
+21 SET VALIDCHK="I (U_""D""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:1
+22 IF CURSTAT="RECONCILED"
Begin DoDot:1
+23 SET DIR("A",1)="RV/Review/Approve V/iew Transactions S/Status History"
+24 SET DIR("A")="Enter Action"
+25 SET VALIDCHK="I (U_""RV""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:1
+26 IF CURSTAT="REVIEWED/APPROVED"
Begin DoDot:1
+27 SET DIR("A",1)="T/Transmit V/iew Transactions S/Status History"
+28 SET DIR("A")="Enter Action"
+29 SET VALIDCHK="I (U_""T""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:1
+30 ;BAR*1.8*4 ITEM 2 SCR58 DISABLE RETRANSMIT
+31 IF CURSTAT="TRANSMITTED"
Begin DoDot:1
+32 ;S DIR("A",1)="RT/Retransmit V/iew Transactions S/Status History"
+33 SET DIR("A",1)="V/iew Transactions S/Status History"
+34 SET DIR("A")="Enter Action"
+35 ;S VALIDCHK="I (U_""RT""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
+36 SET VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:1
+37 IF CURSTAT="RETRANSMITTED"
Begin DoDot:1
+38 ;S DIR("A",1)="RT/Retransmit V/iew Transactions S/Status History"
+39 SET DIR("A",1)="V/iew Transactions S/Status History"
+40 SET DIR("A")="Enter Action"
+41 ;S VALIDCHK="I (U_""RT""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
+42 SET VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:1
+43 ;END BAR*1.8*4 ITEM 2 SCR58
+44 IF MODE="CASHIER"
Begin DoDot:1
+45 IF CURSTAT="OPEN"
Begin DoDot:2
+46 SET DIR("A",1)="RC/Reconcile V/iew Transactions S/Status History"
+47 SET VALIDCHK="I (U_""RC""_U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
+48 IF '$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,0))
Begin DoDot:3
+49 SET DIR("A",1)="D/elete Session"
+50 SET VALIDCHK="I (U_""D""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:3
End DoDot:2
+51 IF '$TEST
Begin DoDot:2
+52 SET DIR("A",1)="V/iew Transactions S/Status History"
+53 SET VALIDCHK="I (U_""V""_U_""S""_U)'[(U_Y_U) W !,""Invalid Option. Try Again"" G ASKACT1"
End DoDot:2
+54 SET DIR("A")="Enter Action"
End DoDot:1
+55 ;IF MODE="OUT" THEN THIS WAS CALLED FROM THE SIGN OUT AND THE CASHIER IS
+56 ;IN THE PROCESS OF SIGNING OUT. JUST DISPLAY THE COUNTS AND LEAVE.
+57 IF MODE="OUT"
QUIT
+58 IF MODE="NEW"
DO ASKFORRT^BARUFUT
QUIT
+59 SET DIR(0)="FO"
+60 DO ^DIR
+61 SET Y=$$UPC^BARUTL(Y)
+62 SET ACTION=Y
+63 IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DIRUT))!(Y="")!(Y="Q")
QUIT
+64 XECUTE VALIDCHK
+65 ;IHS/SD/TPF BAR*1.8*21 IN HOUSE TESING
+66 SET POSTING=$$STILPOST^BARUFUT1(UDUZ)
+67 ;IS THE USER STILL LOGGED ON OR POSTING?
IF +POSTING=1
IF (ACTION="RC")
Begin DoDot:1
+68 WRITE !!,"CANNOT RECONCILE SESSION ",SESSID
+69 WRITE !,"THE CASHIER IS ",$PIECE(POSTING,U,2)
+70 DO ASKFORRT^BARUFUT
End DoDot:1
QUIT
+71 ;END BAR*1.8*21
+72 IF ACTION="D"
DO DELETE^BARUFUT1(UDUZ,SESSID)
QUIT
+73 IF ACTION'="T"
IF (ACTION'="RT")
IF (ACTION'="V")
IF (ACTION'="S")
DO SETSESS(UDUZ,SESSID,ACTION)
QUIT
+74 IF ACTION="V"
DO VIEWTRAN^BARUFUT0(UDUZ,SESSID,ERASTAT)
QUIT
+75 IF ACTION="S"
DO VIEWSTAT^BARUFUT0(UDUZ,SESSID)
QUIT
+76 ;D TRANSMIT(UDUZ,SESSID,ACTION) ;IF 'T' OR 'RT' THEN TRANSMIT ;MRS:BAR*1.8*7 IM30562
+77 ;I ACTION="T" D TRANSMIT(UDUZ,SESSID,ACTION) ;MAKE SURE IT IS "T" ;MRS:BAR*1.8*7 IM30562
+78 ;BEGIN BAR*1.8*17 IHS/SD/TPF PRINT EXPORT SUMMARY
+79 IF ACTION="T"
Begin DoDot:1
+80 ;EXPORT SUMMARY
DO EXPORTSM^BARUFSUP(LIST(CHOICE),0)
+81 ;MAKE SURE IT IS "T" ;MRS:BAR*1.8*7 IM30562
DO TRANSMIT(UDUZ,SESSID,ACTION)
+82 DO EXPORTSM^BARUFSUP(LIST(CHOICE),1)
+83 ;END BAR*1.8*17
End DoDot:1
+84 QUIT
+85 ;
ASKFORRT ;EP - ASK FOR <RETURN>
+1 WRITE !
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 QUIT
+4 ;
SELTRAN(UDUZ,SESSID) ;EP - SELECT AND TRANSMIT ONE OR MORE TRANSACTIONS FROM A SESSION
+1 ;DISABLED MRS:BAR*1.8*7 IM30715
QUIT
+2 NEW CHOICE,SELECT,TRDATE,LINE,PIECE,BARNOW
+3 KILL TRANS
+4 DO TRANHDR^BARUFUT0(UDUZ,SESSID)
+5 SET TRDATE=0
+6 FOR LINE=1:1
SET TRDATE=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE))
IF 'TRDATE
QUIT
Begin DoDot:1
+7 SET CREDIT=$$GET1^DIQ(90050.03,TRDATE_",",2)
+8 SET DEBIT=$$GET1^DIQ(90050.03,TRDATE_",",3)
+9 SET TRANTYP=$$GET1^DIQ(90050.03,TRDATE_",",101,"E")
+10 SET ADJCAT=$$GET1^DIQ(90050.03,TRDATE_",",102,"E")
+11 SET TRANS(LINE)=TRDATE
+12 IF $Y>(IOSL-5)
DO ASKFORRT
DO TRANHDR^BARUFUT0(UDUZ,SESSID)
QUIT
+13 WRITE !,LINE,"."
+14 WRITE ?4,DATE,?25,$JUSTIFY(CREDIT,8,2),?35,$JUSTIFY(DEBIT,8,2),?50,TRANTYP,?65,ADJCAT
End DoDot:1
+15 SET LINE=LINE-1
+16 KILL DIR
+17 SET DIR(0)="LO^1:"_LINE
+18 SET DIR("A")="Select Transactions to Transmit"
+19 DO ^DIR
+20 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+21 IF (Y="")
QUIT
+22 SET SELECT=Y
+23 DO EXCLLST^BARUFUT1(","_SELECT,.TRANS)
+24 ;SEND MULTIPLE TRANSACTIONS IN ONE FILE
+25 ;D ONETRAN^BARUFEX(.TRANS) ;MRS:BAR*1.8*4 SCR80 4.1.1
+26 ;MRS:BAR*1.8*4 SCR80 4.1.1
DO ONETRAN^BARUFEX(.TRANS,SESSID)
+27 ;SET SINGLE A/R TRANSACTION AS BEING SENT
+28 DO NOW^%DTC
+29 SET BARNOW=%
+30 FOR PIECE=1:1
SET CHOICE=$PIECE(SELECT,",",PIECE)
IF CHOICE=""
QUIT
Begin DoDot:1
+31 KILL DIR,DIC,DIE,DR,DA
+32 SET DA(2)=UDUZ
SET DA(1)=SESSID
SET DA=TRANS(CHOICE)
+33 SET DR=".02///^S X=1;.03////^S X=DUZ;.04///^S X=BARNOW"
+34 SET DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
+35 DO ^DIE
End DoDot:1
+36 QUIT 1
+37 ;
TRANSMIT(UDUZ,SESSID,ACTION) ;EP - TRANSMIT/RETRANSMIT SESSION
+1 NEW BARFILE
+2 IF $DATA(SESSID)'=1
GOTO CONT
+3 SET CURSTAT=$$CURSTAT(UDUZ,SESSID,"E")
+4 WRITE !,"CURRENT STATUS OF SESSION ID: ",CURSTAT
+5 ;I CURSTAT'="REVIEWED/APPROVED",(CURSTAT'="TRANSMITTED"),(CURSTAT'="RETRANSMITTED") D Q ;MRS:BAR*1.8*6 IM29616
+6 ;.W !!,"SESSION STATUS MUST BE REVIEWED/APPROVED, TRANSMITTED" ;MRS:BAR*1.8*6 IM29616
+7 ;.W !,"OR RETRANSMITTED TO BE ABLE TO TRANSMIT THE SESSION!" ;MRS:BAR*1.8*6 IM29616
+8 ;MRS:BAR*1.8*6 IM29616
IF CURSTAT'="REVIEWED/APPROVED"
Begin DoDot:1
+9 ;MRS:BAR*1.8*6 IM29616
WRITE !!,"SESSION STATUS MUST BE REVIEWED/APPROVED"
+10 ;MRS:BAR*1.8*6 IM29616
WRITE !,"TO BE ABLE TO TRANSMIT THE SESSION!"
+11 HANG 2
End DoDot:1
QUIT
CONT ;EP - SEND THE SESSION TO THE EXTRACTER
+1 SET BARFILE=$$PULLSESS^BARUFEX(UDUZ,.SESSID)
+2 ;I +BARFILE=0 W !,"NO TRANSACTIONS SENT FROM SESSION!" H 3 Q
+3 IF +BARFILE=0
WRITE !,"NO TRANSACTIONS SENT FROM SESSION!"
Begin DoDot:1
+4 KILL DIR
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 ;BEGIN MOD TO UNLOCK SESSIONS;MRS:BAR*1.8*7 IM30562
+8 SET REC=""
+9 FOR
SET REC=$ORDER(SESSID(REC))
IF 'REC
QUIT
Begin DoDot:2
+10 SET UDUZ=$PIECE(SESSID(REC),U)
+11 SET SESSID=$PIECE(SESSID(REC),U,2)
+12 LOCK -^BARSESS(DUZ(2),UDUZ,11,SESSID)
End DoDot:2
+13 ;END MOD TO UNLOCK SESSION;MRS:BAR*1.8*7 IM30562
End DoDot:1
QUIT
+14 IF +BARFILE
SET BARFILE=$PIECE(BARFILE,U,2)
+15 SET RETCODE=$$SETTRANS^BARUFUT0(UDUZ,.SESSID,BARFILE)
+16 KILL DIR
+17 SET DIR(0)="E"
+18 DO ^DIR
+19 QUIT
+20 ;
SETSESS(UDUZ,SESSID,BARSTAT) ;EP - SET SESSION STATUS 'BARSTAT'
+1 IF $GET(BARSTAT)=""
QUIT
+2 ;CREATE A NEW STATUS CHANGE DATE/TIME
SET STATCHG=$$ADDSTAT(UDUZ,SESSID)
+3 IF +STATCHG<1
Begin DoDot:1
+4 WRITE !!,"UNABLE TO MAKE A CHANGE IN STATUS FOR SESSION ID ",SESSID
+5 KILL DIR
+6 SET DIR(0)="E"
+7 DO ^DIR
End DoDot:1
QUIT 0
+8 KILL DIC,DIE,DR,DA,DIR
+9 SET DA(2)=UDUZ
+10 SET DA(1)=SESSID
+11 SET DA=$PIECE(STATCHG,U)
+12 SET DR=".02///^S X=BARSTAT;.03////^S X=DUZ"
+13 SET DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",1,"
+14 DO ^DIE
+15 KILL DIC,DIE,DR,DA,DIR
+16 IF $GET(MODE)="CASHIER"
KILL UFMSESID
+17 QUIT 1
+18 ;
ADDSTAT(UDUZ,SESSID) ; EP - ;CREATE A NEW STATUS CHANGE DATE/TIME
+1 KILL DIC,DIE,DR,DA,DIR
+2 DO NOW^%DTC
+3 SET X=%
+4 SET DA(2)=UDUZ
+5 SET DA(1)=SESSID
+6 SET DIC("P")=$PIECE(^DD(90057.11,110101,0),U,2)
+7 SET DIC="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",1,"
+8 SET DIC(0)="L"
+9 DO ^DIC
+10 IF Y<0
QUIT 0
+11 QUIT Y
+12 ;
TRANTRIG(UDUZ,SESSID,BARTRAN) ;EP - CREATE TRANSACTION ENTRY IN SESSION
+1 ;WHEN SESSID=0 THE MODE IS PROGRAMMER SESSION LOGGIN BYPASS
IF 'SESSID
QUIT 0
+2 ;IHS/SD/PKD 1.8*21 Check current session status
IF $$CURSTAT(UDUZ,SESSID,"E")'="OPEN"
QUIT 0
+3 NEW RET,ASUFAC,DUZ2HOLD
+4 KILL DIC,DIE,DR,DA,DIR
+5 SET DA(2)=UDUZ
+6 SET DA(1)=SESSID
+7 SET X=BARTRAN
+8 SET DIC("P")=$PIECE(^DD(90057.11,110102,0),U,2)
+9 SET DIC="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
+10 SET DIC(0)="L"
+11 DO ^DIC
+12 KILL DIC,DIE,DR,DA,DIR
+13 IF Y<0
QUIT 0
+14 SET RET=+Y
+15 ;PLACE THE ASUFACASUFAC3PIEN IN ITS FIELD
+16 SET ASUFAC=$$ASUFAC^BARUFUT1(DUZ(2),RET)
+17 SET DA(2)=UDUZ
+18 SET DA(1)=SESSID
+19 SET DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
+20 SET DA=RET
+21 SET DR=".05///^S X=ASUFAC"
+22 DO ^DIE
+23 ;LETS SEE IF 3P CAN PROVIDE AN 'INVOICE #'
+24 NEW IENS,ARBILLIN,TPBIEN,TPBDUZ2,UFMSSUFC
+25 SET IENS=BARTRAN_","
+26 ;A/R TRANSACTIONS, BILL (A/R) PTR
SET ARBILLIN=$$GET1^DIQ(90050.03,IENS,4,"I")
+27 ;A/R BILL, 3P IEN (DA)
SET TPBIEN=$$GET1^DIQ(90050.01,ARBILLIN_",",17,"I")
+28 ;BAR*1.8*4 IM26555,IM26610 ET AL
+29 ;A/R BILL, 3P DUZ(2)
SET TPBDUZ2=$$GET1^DIQ(90050.01,ARBILLIN_",",22,"I")
+30 IF 'TPBDUZ2
QUIT 0
+31 IF 'TPBIEN
QUIT 0
+32 ;END BAR*1.8*4
+33 SET UFMSSUFC=0
+34 IF $LENGTH($TEXT(TRANSMIT^ABMUEAPI))
SET UFMSSUFC=$$TRANSMIT^ABMUEAPI(TPBDUZ2,TPBIEN)
+35 ;Q:UFMSSUFC=0 RET
+36 ;BAR*1.8*4 FOUND DURING TESTING
IF UFMSSUFC=0!(UFMSSUFC=-1)
QUIT RET
+37 ;IF 3P GIVES US AN INVOICE, USE IT INSTEAD OF THE ONE FROM A/R
+38 KILL DIC,DIE,DR,DA,DIR
+39 SET DA(2)=UDUZ
+40 SET DA(1)=SESSID
+41 SET DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
+42 SET DA=RET
+43 SET DR=".05///^S X=UFMSSUFC"
+44 DO ^DIE
+45 KILL DIC,DIE,DR,DA,DIR
+46 QUIT RET
+47 ;
IHS(DUZ2) ;EP - RETURN TRUE IF IHS AFFILIATION
+1 NEW REC,AFFIL
+2 SET REC=$ORDER(^AUTTLOC(DUZ2,11,""),-1)
+3 SET AFFIL=$$GET1^DIQ(9999999.0611,REC_","_DUZ2_",",.03,"I")
+4 ;1 MEANS IHS
QUIT AFFIL=1
+5 ;NEW CODE :HEAT147572
IHSNEGB(DUZ2) ;EP - CHECK IF ERA POSTING NB IS ALLOWED (1)
+1 ;RETURNS 1 IF:
+2 ; (1) AFFILIATION=IHS
+3 ; (2) AFFILIATION'=IHS AND FLAG 1402 (20;5) ALLOW ERA POSTING NEG BAL = "N"
+4 ;FLAG: 1402 ERA POSTING: ALLOW POSTING OF NEGATIVE BALANCES N - follow Fed rules
+5 ;FED
IF $$IHS(DUZ2)
QUIT 1
+6 ;I $P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,5)="" Q 0 ;IF NO FLAG SET ;bar*1.8*26 IHS/SD/SDR HEAT170856
+7 ;IF NO FLAG SET ;bar*1.8*26 IHS/SD/SDR HEAT170856
IF $PIECE($GET(^BAR(90052.06,DUZ2,DUZ2,20)),U,5)=""
QUIT 1
+8 ;P.OTT ;2/4/2014
QUIT '($PIECE($GET(^BAR(90052.06,DUZ2,DUZ2,20)),U,5)="Y")
+9 ;;NEW CODE :HEAT147572
+10 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
IHSCANCB(DUZ2) ;EP - CHECK IF ERA POSTING CANCELLED BILLS IS ALLOWED (1)
+1 ;Q $P($G(^BAR(90052.06,DUZ2,DUZ2,20)),U,6)="Y" ;P.OTT ;bar*1.8*26 IHS/SD/SDR HEAT170856
+2 ;bar*1.8*26 IHS/SD/SDR HEAT170856
IF $$IHS(DUZ2)
QUIT 0
+3 ;bar*1.8*26 IHS/SD/SDR HEAT170856
IF $PIECE($GET(^BAR(90052.06,DUZ2,DUZ2,20)),U,6)=""
QUIT 0
+4 ;P.OTT ;bar*1.8*26 IHS/SD/SDR HEAT170856
QUIT ($PIECE($GET(^BAR(90052.06,DUZ2,DUZ2,20)),U,6)="Y")
+5 ;END OF NEW CODE :HEAT147572
NOTOPEN(DUZ,UFMSESID) ;EP - IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490 EXIT CASHIER IF SESSION NOT OPEN
+1 ;IF STATUS CHANGES WHILE CASHIER IS POSTING KICK CASHIER OUT
+2 ;BAROPEN not New'd - used in calling routine. want to finish filing if started
+3 ;UFMSESID NOT DEFINED THEN SESSION IS NOT OPEN
IF $GET(UFMSESID)=""
QUIT 1
+4 ;W !!,"FOR TESTING ONLY: CHECKING SESSION STATUS"
+5 ;I $$CURSTAT(DUZ,UFMSESID,"E")'="OPEN" D Q 1 ;bar*1.8*21 SDR
+6 ;bar*1.8*21 SDR
IF $$CURSTAT(DUZ,UFMSESID,"E")'=""
IF $$CURSTAT(DUZ,UFMSESID,"E")'="OPEN"
Begin DoDot:1
+7 WRITE !!,"**Your cashiering session is no longer in an OPEN status.**"
+8 WRITE !,"Please open a new cashiering session to continue Posting.",!
+9 ;Kill the scratch global
DO CANCEL^BARPST3
+10 ;
SET X=$$DELFLG^BARUFUT1(DUZ,UFMSESID)
+11 ;CLEAR SESSION ID
SET UFMSESID=""
+12 DO ASKFORRT^BARUFUT
End DoDot:1
QUIT 1
+13 QUIT 0
