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

BARUFUT.m

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