BARUFUT4 ; IHS/SD/POT - UTILITIES 2 FOR UFMS ; 04/28/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
;;NEW ROUTINE : OVERFLOW CODE FROM BARUFUT1
;IHS/SD/POT JUN 2013 belcourt HEAT118656 - BAR*1.8*.24 OVERFLOW FROM CODE BARUFUT1
Q
SITECHK ;EP - CHECK DUZ(2) FOR SITE SET UP HEAT118656 BAR*1.8*.24
;OLD CODE
;I '$D(^BARBL(DUZ(2))) D Q
;. W !,$P(^DIC(4,DUZ(2),0),U)," IS NOT REGIONALLY SETUP"
;. W !,"CONTACT YOUR A/R MANAGER",*7
;. S BARQUIT=1
;. S XQUIT=1
;. D EOP^BARUTL(1)
;NEW CODE
N BARERR
I $G(DUZ(2))="" D ERR(1) Q
I '$D(^BARBL(DUZ(2))) D ERR(2) Q
Q
ERR(BARERR) ; HEAT118656 BAR*1.8*.24
I BARERR=1 W !," SITE DUZ(2) IS NIL OR UNDEFINED ?!?"
I BARERR=2 D
. W !,"A/R BILL FILE NOT IS NOT SETUP FOR SITE ",DUZ(2)
. I '$D(^DIC(4,DUZ(2))) W !,"Global entry ^DIC(4 IS NOT SETUP"
W !,"CONTACT YOUR A/R MANAGER"
S BARQUIT=1
S XQUIT=1
D EOP^BARUTL(1)
Q
BARUFUT4 ; IHS/SD/POT - UTILITIES 2 FOR UFMS ; 04/28/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
+2 ;;NEW ROUTINE : OVERFLOW CODE FROM BARUFUT1
+3 ;IHS/SD/POT JUN 2013 belcourt HEAT118656 - BAR*1.8*.24 OVERFLOW FROM CODE BARUFUT1
+4 QUIT
SITECHK ;EP - CHECK DUZ(2) FOR SITE SET UP HEAT118656 BAR*1.8*.24
+1 ;OLD CODE
+2 ;I '$D(^BARBL(DUZ(2))) D Q
+3 ;. W !,$P(^DIC(4,DUZ(2),0),U)," IS NOT REGIONALLY SETUP"
+4 ;. W !,"CONTACT YOUR A/R MANAGER",*7
+5 ;. S BARQUIT=1
+6 ;. S XQUIT=1
+7 ;. D EOP^BARUTL(1)
+8 ;NEW CODE
+9 NEW BARERR
+10 IF $GET(DUZ(2))=""
DO ERR(1)
QUIT
+11 IF '$DATA(^BARBL(DUZ(2)))
DO ERR(2)
QUIT
+12 QUIT
ERR(BARERR) ; HEAT118656 BAR*1.8*.24
+1 IF BARERR=1
WRITE !," SITE DUZ(2) IS NIL OR UNDEFINED ?!?"
+2 IF BARERR=2
Begin DoDot:1
+3 WRITE !,"A/R BILL FILE NOT IS NOT SETUP FOR SITE ",DUZ(2)
+4 IF '$DATA(^DIC(4,DUZ(2)))
WRITE !,"Global entry ^DIC(4 IS NOT SETUP"
End DoDot:1
+5 WRITE !,"CONTACT YOUR A/R MANAGER"
+6 SET BARQUIT=1
+7 SET XQUIT=1
+8 DO EOP^BARUTL(1)
+9 QUIT