ACRFSSA1 ;IHS/OIRM/DSD/THL,AEF - AUXILLIARY SUB-ROUTINES FOR ACRFSS* ROUTINES; [ 07/20/2006 9:58 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5,20**;NOV 05, 2001
;;CONTINUATION OF ACRFSSA
TA ;EP;
N ACRQTA ;ACR*2.1*3.25
N ACRTAMT ;ACR*2.1*5.10
N ACRADVR ;ACR*2.1*5.10
D ADVANCE
Q:$D(ACRQTA) ;HAS OUTSTANDING ADVANCE ;ACR*2.1*3.25
S ACRADVR=$$ADVR^ACRFSSA1(ACRDOCDA,ACRTAMT,ACRADV) ;ACR*2.1*5.10
W !!,"ALLOWABLE TRAVEL ADVANCE: ",$J($FN(ACRADV,"P",2),8)
W !,"CURRENT AMOUNT REQUESTED: ",$J($FN(ACRADVR,"P",2),8) ;ACR*2.1*5.10
S DIR(0)="YO"
S DIR("A")="ACCEPT ALLOWABLE ADVANCE"
S DIR("B")="YES" ;ACR*2.1*5.10
D DIR^ACRFDIC
I Y=1 S ACRADV=ACRADVR D ETA Q ;ACR*2.1*5.10
I Y=0 D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="130160T"
.D DIE^ACRFDIC
.I $D(^ACRDOC(ACRDOCDA,"TO")),$P(^("TO"),U,25) S ACRADV=$P(^("TO"),U,25) D
..S DA=ACRDOCDA
..S DIE="^ACROBL("
..S DR="1000////"_ACRADV
..D DIE^ACRFDIC
..D OTA ;ACR*2.1*5.10
Q
OTA ;EP;RECORD OUTSTANDING TRAVEL ADVANCE
I '$D(^ACROTA(ACRDOCDA,0)) D
.N ACRNOW
.D NOW^%DTC
.S ACRNOW=%
.S (DINUM,X)=ACRDOCDA
.S DIC="^ACROTA("
.S DIC(0)="LZ"
.S DIC("DR")=".02////"_$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
.D FILE^ACRFDIC
S DA=ACRDOCDA
S DIE="^ACROTA("
S DR=".03////"_ACRADV
D DIE^ACRFDIC
I +$G(^ACROBL(ACRDOCDA,"TA"))'=ACRADV D
.S DA=ACRDOCDA
.S DIE="^ACROBL("
.S DR="1000////"_ACRADV
.D DIE^ACRFDIC
I $P($G(^ACRDOC(ACRDOCDA,"TO")),U,25)'=ACRADV D
.S DA=ACRDOCDA
.;I '$D(ACRTAMT) S ACRTAMT=ACRADV/.8 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
.I '$D(ACRTAMT) S ACRTAMT=ACRADV/.6 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
.S DIE="^ACRDOC("
.S DR="130160///"_ACRADV
.D DIE^ACRFDIC
Q
TOTAL ;EP;
I $P(^ACRDOC(ACRDOCDA,"TO"),U,22)=1 D
.S ACRATM=ACRREIM-ACRLDG-ACRRC-ACRPHN-ACR4P-$S($P(^ACRDOC(ACRDOCDA,"TOAU"),U,5)=1:$G(ACRALTOT),1:0)
.S ACRATM=$P(ACRATM,".")
.S ACRATMX=$E(ACRATM,$L(ACRATM))
.S:ACRATMX#10 ACRATM=ACRATM+(10-ACRATMX)
.S:$E(ACRATM,$L(ACRATM)-1)#2 ACRATM=ACRATM+10
.S ACRATM1=$S(ACRREFX=600:$P(^ACRDOC(ACRDOCDA,"TO"),U,23),1:ACRATM)
.S ACRATM2=$P(^ACRDOC(ACRDOCDA,"TOAU"),U,8)
.W !!,"GOVERNMENT ATM CASH WITHDRAWAL ",$S(ACRREFX=600:"AUTHORIZED",1:"ESTIMATED."),": ",$J($FN(ACRATM1,"P",2),10)
.W !,"GOVERNMENT ATM CASH WITHDRAWAL ",$S(ACRREFX=600:"TAKEN.....",1:"REQUESTED."),": ",$J($FN(ACRATM2,"P",2),10)
.W !,"GOVERNMENT ATM SERVICE CHARGE ",$S(ACRREFX=600:"AUTHORIZED",1:"EXPECTED.."),": ",$J($FN($S(ACRREFX=600:$P(^ACRDOC(ACRDOCDA,"TO"),U,26),1:ACRATM*$P(^ACRSYS(1,"DT"),U,16)),"P",2),10)
.W !,"YOU ARE REQUIRED TO ABIDE BY THE MAX ATM WITHDRAWAL LIMITS OF $60/DAY, $360/WEEK"
W $$DASH^ACRFMENU
W !
W:$D(ACRALTOT) "AIRLINE.: ",$J($FN(ACRALTOT,"P",2),8)
W:$D(ACRRC) ?25,"RENTAL CAR: ",$J($FN(ACRRC,"P",2),8)
W ?54,"TOTAL EXPENSES: ",$J($FN(ACRTOT,"P",2),9)
W !,"PER DIEM: ",$J($FN(ACRPD+ACRLDG,"P",2),8)
W ?25,"OTHER.....: ",$J($FN(ACROTHT,"P",2),8)
W ?54,$S(ACRREF=130:"EXCLD AIRLINE.: ",1:"REIMBURSABLE..: "),$J($FN(ACRREIM-$P($G(^ACROTA(ACRDOCDA,0)),U,3),"P",2),9)
W !,"TM FEE..: ",$J($FN($$TMFEE^ACRFSS42(ACRDOCDA),"P",2),8)
W ?54,"TRAVEL ADVANCE: ",$J($FN($P(^ACRDOC(ACRDOCDA,"TO"),U,25),"P",2),9)
I $P($G(^ACRDOC(ACRDOCDA,"TRNG4")),U,16) W !?48,"TOTAL NOT TO EXCEED.: ",$J($FN($P(^("TRNG4"),U,16),"P",2),9) S:ACRTOT>$P(^("TRNG4"),U,16) ACRTOT=$P(^("TRNG4"),U,16)
W:$D(ACRPRT)&(ACRREF'=130) !?48,"TOTAL AMOUNT CLAIMED: ",$J($FN(ACRTOT-ACRADV,"P",2),9)
I ACRREF'=130,$P($G(^ACRDOC(ACRDOCDA,"TOAU")),U,7) D
.S ACROBL=$P(^ACRDOC(ACRDOCDA,"TOAU"),U,7)
.W !?48,"ORIGINALLY OBLIGATED: ",$J($FN(ACROBL,"P",2),9)
.I ACRTOT>ACROBL D
..W !?48,"UNDER-OBLIGATED.....: ",$J($FN(ACRTOT-ACROBL,"P",2),9)
D PAUSE^ACRFWARN:'$D(ACRQUIT)
D UP^ACRFSS3
K ACRTV("D")
Q
CHK ;EP;CHECK TO SEE IF ANY SIGNATURES HAVE BEEN APPLIED TO THE TRAVEL
;VOUCHER CHECK FOR CHANGE TO TRAVEL DAYS AFTER TRAVEL VOUCHER SIGNED
Q:'$D(^ACRAPVS("AB",ACRDOCDA))
N ACR
S ACRAPVDA=0
F S ACRAPVDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPVDA)) Q:'ACRAPVDA I $D(^ACRAPVS(ACRAPVDA,0)),$P(^(0),U,3)=39,$E($G(^ACRAPVS(ACRAPVDA,"DT")))="A" S ACRTVCH="" Q
Q
ADVANCE ;EP;UPDATE TRAVEL ADVANCE AMOUNT DURING TRAVEL ORDER PROCESSING
Q:$O(^AUTTDOCR("B","130",0))'=+$P(^ACRDOC(ACRDOCDA,0),U,13)
S ACRLDG=$G(ACRLDG) ;ACR*2.1*3.35
S ACRRC=$G(ACRRC) ;ACR*2.1*3.35
S ACROTHT=$G(ACROTHT) ;ACR*2.1*3.35
N ACRDUZ
S ACRDUZ=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
Q:'ACRDUZ
D OUTSTD^ACRFTA
I $G(ACR9E) D Q
.K ACR9E
.W !,"It appears that the traveler has an outstanding travel advance."
.W !,"No additional advance can be requested until the outstanding"
.W !,"advance is liquidated."
.S ACRQTA=1 ;SET QUIT FLAG ;ACR*2.1*3.25
.D PAUSE^ACRFWARN
N ACRTO
S ACRTO=^ACRDOC(ACRDOCDA,"TO")
I $P(ACRTO,U,22)=0,$P(ACRTO,U,19)="Y" D I 1
.S ACRTAMT=ACROTHT+ACRPD+ACRLDG+ACRRC ;ACR*2.1*5.10
.;S ACRADV=.8*ACRTAMT ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
.S ACRADV=.6*ACRTAMT ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
.S ACRADV=$P(ACRADV,".")
.;S ACRADVX=$E(ACRADV,$L(ACRADV)) ;ACR*2.1*5.10
.;S ACRADV=($E(ACRADV,1,$L(ACRADV)-1)_0)+$S(ACRADVX>4:10,1:0) ;ACR*2.1*5.10
E S (ACRADV,ACRTAMT)=0 ;ACR*2.1*5.10
Q
ALTOT ;EP;TO CALCULATE TOTAL AIRLINE EXPENSE
Q:'$D(^ACRAL("E",ACRDOCDA))
S (ACRALTOT,ACRALDA)=0
F S ACRALDA=$O(^ACRAL("E",ACRDOCDA,ACRALDA)) Q:'ACRALDA D
.S ACRALTOT=ACRALTOT+$P($G(^ACRAL(ACRALDA,"DT")),U,9)
.S:+$P($G(^ACRAL(ACRALDA,"DT")),U,11)>0 ACRCONC=$P(^ACRAL(ACRALDA,"DT"),U,11)
Q
ETA ;EP;TO EDIT/UPDATE TRAVEL ADVANCE
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR="1000////"_ACRADV
D DIE^ACRFDIC
S DA=ACRDOCDA
;I '$D(ACRTAMT) S ACRTAMT=ACRADV/.8 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
I '$D(ACRTAMT) S ACRTAMT=ACRADV/.6 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
S DIE="^ACRDOC("
S DR="130160////"_ACRADV
D DIE^ACRFDIC
D OTA ;ACR*2.1*5.10
Q
ADVR(ACRDOCDA,ACRTAMT,ACRADV) ;LOCAL ENTRY; EXTRINSIC FUNCTION ;ACR*2.1*5.10
; ENTERS WITH: DOCUMENT IEN
; AMOUNT BEFORE MINU 8 %
; ALLOWABLE ADVANCE
; RETURNS: ADVANCE AMOUNT
; ADJUSTED IF GREATER THAN TAMT-5.00
;
S ACRADVR=+$P($G(^ACRDOC(ACRDOCDA,"TO")),U,25)
I ACRADVR=0 S ACRADVR=ACRADV
I ACRADVR'>0 Q 0
I ACRADVR>(ACRTAMT-5) D
.W !,"Requested advance cannot be greater than the total allowed amount, less $5.00"
.W !,"Adjusting the amount to the greatest amount allowed."
.S ACRADVR=ACRTAMT-5
.D PAUSE^ACRFWARN
Q ACRADVR
ACRFSSA1 ;IHS/OIRM/DSD/THL,AEF - AUXILLIARY SUB-ROUTINES FOR ACRFSS* ROUTINES; [ 07/20/2006 9:58 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5,20**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFSSA
TA ;EP;
+1 ;ACR*2.1*3.25
NEW ACRQTA
+2 ;ACR*2.1*5.10
NEW ACRTAMT
+3 ;ACR*2.1*5.10
NEW ACRADVR
+4 DO ADVANCE
+5 ;HAS OUTSTANDING ADVANCE ;ACR*2.1*3.25
IF $DATA(ACRQTA)
QUIT
+6 ;ACR*2.1*5.10
SET ACRADVR=$$ADVR^ACRFSSA1(ACRDOCDA,ACRTAMT,ACRADV)
+7 WRITE !!,"ALLOWABLE TRAVEL ADVANCE: ",$JUSTIFY($FNUMBER(ACRADV,"P",2),8)
+8 ;ACR*2.1*5.10
WRITE !,"CURRENT AMOUNT REQUESTED: ",$JUSTIFY($FNUMBER(ACRADVR,"P",2),8)
+9 SET DIR(0)="YO"
+10 SET DIR("A")="ACCEPT ALLOWABLE ADVANCE"
+11 ;ACR*2.1*5.10
SET DIR("B")="YES"
+12 DO DIR^ACRFDIC
+13 ;ACR*2.1*5.10
IF Y=1
SET ACRADV=ACRADVR
DO ETA
QUIT
+14 IF Y=0
Begin DoDot:1
+15 SET DA=ACRDOCDA
+16 SET DIE="^ACRDOC("
+17 SET DR="130160T"
+18 DO DIE^ACRFDIC
+19 IF $DATA(^ACRDOC(ACRDOCDA,"TO"))
IF $PIECE(^("TO"),U,25)
SET ACRADV=$PIECE(^("TO"),U,25)
Begin DoDot:2
+20 SET DA=ACRDOCDA
+21 SET DIE="^ACROBL("
+22 SET DR="1000////"_ACRADV
+23 DO DIE^ACRFDIC
+24 ;ACR*2.1*5.10
DO OTA
End DoDot:2
End DoDot:1
+25 QUIT
OTA ;EP;RECORD OUTSTANDING TRAVEL ADVANCE
+1 IF '$DATA(^ACROTA(ACRDOCDA,0))
Begin DoDot:1
+2 NEW ACRNOW
+3 DO NOW^%DTC
+4 SET ACRNOW=%
+5 SET (DINUM,X)=ACRDOCDA
+6 SET DIC="^ACROTA("
+7 SET DIC(0)="LZ"
+8 SET DIC("DR")=".02////"_$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+9 DO FILE^ACRFDIC
End DoDot:1
+10 SET DA=ACRDOCDA
+11 SET DIE="^ACROTA("
+12 SET DR=".03////"_ACRADV
+13 DO DIE^ACRFDIC
+14 IF +$GET(^ACROBL(ACRDOCDA,"TA"))'=ACRADV
Begin DoDot:1
+15 SET DA=ACRDOCDA
+16 SET DIE="^ACROBL("
+17 SET DR="1000////"_ACRADV
+18 DO DIE^ACRFDIC
End DoDot:1
+19 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,25)'=ACRADV
Begin DoDot:1
+20 SET DA=ACRDOCDA
+21 ;I '$D(ACRTAMT) S ACRTAMT=ACRADV/.8 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
+22 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
IF '$DATA(ACRTAMT)
SET ACRTAMT=ACRADV/.6
IF ACRADV=0
SET ACRTAMT=0
+23 SET DIE="^ACRDOC("
+24 SET DR="130160///"_ACRADV
+25 DO DIE^ACRFDIC
End DoDot:1
+26 QUIT
TOTAL ;EP;
+1 IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,22)=1
Begin DoDot:1
+2 SET ACRATM=ACRREIM-ACRLDG-ACRRC-ACRPHN-ACR4P-$SELECT($PIECE(^ACRDOC(ACRDOCDA,"TOAU"),U,5)=1:$GET(ACRALTOT),1:0)
+3 SET ACRATM=$PIECE(ACRATM,".")
+4 SET ACRATMX=$EXTRACT(ACRATM,$LENGTH(ACRATM))
+5 IF ACRATMX#10
SET ACRATM=ACRATM+(10-ACRATMX)
+6 IF $EXTRACT(ACRATM,$LENGTH(ACRATM)-1)#2
SET ACRATM=ACRATM+10
+7 SET ACRATM1=$SELECT(ACRREFX=600:$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,23),1:ACRATM)
+8 SET ACRATM2=$PIECE(^ACRDOC(ACRDOCDA,"TOAU"),U,8)
+9 WRITE !!,"GOVERNMENT ATM CASH WITHDRAWAL ",$SELECT(ACRREFX=600:"AUTHORIZED",1:"ESTIMATED."),": ",$JUSTIFY($FNUMBER(ACRATM1,"P",2),10)
+10 WRITE !,"GOVERNMENT ATM CASH WITHDRAWAL ",$SELECT(ACRREFX=600:"TAKEN.....",1:"REQUESTED."),": ",$JUSTIFY($FNUMBER(ACRATM2,"P",2),10)
+11 WRITE !,"GOVERNMENT ATM SERVICE CHARGE ",$SELECT(ACRREFX=600:"AUTHORIZED",1:"EXPECTED.."),": ",$JUSTIFY($FNUMBER($SELECT(ACRREFX=600:$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,26),1:ACRATM*$PIECE(^ACRSYS(1,"DT"),U,16)),"P",2),10)
+12 WRITE !,"YOU ARE REQUIRED TO ABIDE BY THE MAX ATM WITHDRAWAL LIMITS OF $60/DAY, $360/WEEK"
End DoDot:1
+13 WRITE $$DASH^ACRFMENU
+14 WRITE !
+15 IF $DATA(ACRALTOT)
WRITE "AIRLINE.: ",$JUSTIFY($FNUMBER(ACRALTOT,"P",2),8)
+16 IF $DATA(ACRRC)
WRITE ?25,"RENTAL CAR: ",$JUSTIFY($FNUMBER(ACRRC,"P",2),8)
+17 WRITE ?54,"TOTAL EXPENSES: ",$JUSTIFY($FNUMBER(ACRTOT,"P",2),9)
+18 WRITE !,"PER DIEM: ",$JUSTIFY($FNUMBER(ACRPD+ACRLDG,"P",2),8)
+19 WRITE ?25,"OTHER.....: ",$JUSTIFY($FNUMBER(ACROTHT,"P",2),8)
+20 WRITE ?54,$SELECT(ACRREF=130:"EXCLD AIRLINE.: ",1:"REIMBURSABLE..: "),$JUSTIFY($FNUMBER(ACRREIM-$PIECE($GET(^ACROTA(ACRDOCDA,0)),U,3),"P",2),9)
+21 WRITE !,"TM FEE..: ",$JUSTIFY($FNUMBER($$TMFEE^ACRFSS42(ACRDOCDA),"P",2),8)
+22 WRITE ?54,"TRAVEL ADVANCE: ",$JUSTIFY($FNUMBER($PIECE(^ACRDOC(ACRDOCDA,"TO"),U,25),"P",2),9)
+23 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG4")),U,16)
WRITE !?48,"TOTAL NOT TO EXCEED.: ",$JUSTIFY($FNUMBER($PIECE(^("TRNG4"),U,16),"P",2),9)
IF ACRTOT>$PIECE(^("TRNG4"),U,16)
SET ACRTOT=$PIECE(^("TRNG4"),U,16)
+24 IF $DATA(ACRPRT)&(ACRREF'=130)
WRITE !?48,"TOTAL AMOUNT CLAIMED: ",$JUSTIFY($FNUMBER(ACRTOT-ACRADV,"P",2),9)
+25 IF ACRREF'=130
IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TOAU")),U,7)
Begin DoDot:1
+26 SET ACROBL=$PIECE(^ACRDOC(ACRDOCDA,"TOAU"),U,7)
+27 WRITE !?48,"ORIGINALLY OBLIGATED: ",$JUSTIFY($FNUMBER(ACROBL,"P",2),9)
+28 IF ACRTOT>ACROBL
Begin DoDot:2
+29 WRITE !?48,"UNDER-OBLIGATED.....: ",$JUSTIFY($FNUMBER(ACRTOT-ACROBL,"P",2),9)
End DoDot:2
End DoDot:1
+30 IF '$DATA(ACRQUIT)
DO PAUSE^ACRFWARN
+31 DO UP^ACRFSS3
+32 KILL ACRTV("D")
+33 QUIT
CHK ;EP;CHECK TO SEE IF ANY SIGNATURES HAVE BEEN APPLIED TO THE TRAVEL
+1 ;VOUCHER CHECK FOR CHANGE TO TRAVEL DAYS AFTER TRAVEL VOUCHER SIGNED
+2 IF '$DATA(^ACRAPVS("AB",ACRDOCDA))
QUIT
+3 NEW ACR
+4 SET ACRAPVDA=0
+5 FOR
SET ACRAPVDA=$ORDER(^ACRAPVS("AB",ACRDOCDA,ACRAPVDA))
IF 'ACRAPVDA
QUIT
IF $DATA(^ACRAPVS(ACRAPVDA,0))
IF $PIECE(^(0),U,3)=39
IF $EXTRACT($GET(^ACRAPVS(ACRAPVDA,"DT")))="A"
SET ACRTVCH=""
QUIT
+6 QUIT
ADVANCE ;EP;UPDATE TRAVEL ADVANCE AMOUNT DURING TRAVEL ORDER PROCESSING
+1 IF $ORDER(^AUTTDOCR("B","130",0))'=+$PIECE(^ACRDOC(ACRDOCDA,0),U,13)
QUIT
+2 ;ACR*2.1*3.35
SET ACRLDG=$GET(ACRLDG)
+3 ;ACR*2.1*3.35
SET ACRRC=$GET(ACRRC)
+4 ;ACR*2.1*3.35
SET ACROTHT=$GET(ACROTHT)
+5 NEW ACRDUZ
+6 SET ACRDUZ=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+7 IF 'ACRDUZ
QUIT
+8 DO OUTSTD^ACRFTA
+9 IF $GET(ACR9E)
Begin DoDot:1
+10 KILL ACR9E
+11 WRITE !,"It appears that the traveler has an outstanding travel advance."
+12 WRITE !,"No additional advance can be requested until the outstanding"
+13 WRITE !,"advance is liquidated."
+14 ;SET QUIT FLAG ;ACR*2.1*3.25
SET ACRQTA=1
+15 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+16 NEW ACRTO
+17 SET ACRTO=^ACRDOC(ACRDOCDA,"TO")
+18 IF $PIECE(ACRTO,U,22)=0
IF $PIECE(ACRTO,U,19)="Y"
Begin DoDot:1
+19 ;ACR*2.1*5.10
SET ACRTAMT=ACROTHT+ACRPD+ACRLDG+ACRRC
+20 ;S ACRADV=.8*ACRTAMT ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
+21 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
SET ACRADV=.6*ACRTAMT
+22 SET ACRADV=$PIECE(ACRADV,".")
+23 ;S ACRADVX=$E(ACRADV,$L(ACRADV)) ;ACR*2.1*5.10
+24 ;S ACRADV=($E(ACRADV,1,$L(ACRADV)-1)_0)+$S(ACRADVX>4:10,1:0) ;ACR*2.1*5.10
End DoDot:1
IF 1
+25 ;ACR*2.1*5.10
IF '$TEST
SET (ACRADV,ACRTAMT)=0
+26 QUIT
ALTOT ;EP;TO CALCULATE TOTAL AIRLINE EXPENSE
+1 IF '$DATA(^ACRAL("E",ACRDOCDA))
QUIT
+2 SET (ACRALTOT,ACRALDA)=0
+3 FOR
SET ACRALDA=$ORDER(^ACRAL("E",ACRDOCDA,ACRALDA))
IF 'ACRALDA
QUIT
Begin DoDot:1
+4 SET ACRALTOT=ACRALTOT+$PIECE($GET(^ACRAL(ACRALDA,"DT")),U,9)
+5 IF +$PIECE($GET(^ACRAL(ACRALDA,"DT")),U,11)>0
SET ACRCONC=$PIECE(^ACRAL(ACRALDA,"DT"),U,11)
End DoDot:1
+6 QUIT
ETA ;EP;TO EDIT/UPDATE TRAVEL ADVANCE
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACROBL("
+3 SET DR="1000////"_ACRADV
+4 DO DIE^ACRFDIC
+5 SET DA=ACRDOCDA
+6 ;I '$D(ACRTAMT) S ACRTAMT=ACRADV/.8 S:ACRADV=0 ACRTAMT=0 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
+7 ;ACR*2.1*5.10;ACR*2.1*20.08 IM18616
IF '$DATA(ACRTAMT)
SET ACRTAMT=ACRADV/.6
IF ACRADV=0
SET ACRTAMT=0
+8 SET DIE="^ACRDOC("
+9 SET DR="130160////"_ACRADV
+10 DO DIE^ACRFDIC
+11 ;ACR*2.1*5.10
DO OTA
+12 QUIT
ADVR(ACRDOCDA,ACRTAMT,ACRADV) ;LOCAL ENTRY; EXTRINSIC FUNCTION ;ACR*2.1*5.10
+1 ; ENTERS WITH: DOCUMENT IEN
+2 ; AMOUNT BEFORE MINU 8 %
+3 ; ALLOWABLE ADVANCE
+4 ; RETURNS: ADVANCE AMOUNT
+5 ; ADJUSTED IF GREATER THAN TAMT-5.00
+6 ;
+7 SET ACRADVR=+$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,25)
+8 IF ACRADVR=0
SET ACRADVR=ACRADV
+9 IF ACRADVR'>0
QUIT 0
+10 IF ACRADVR>(ACRTAMT-5)
Begin DoDot:1
+11 WRITE !,"Requested advance cannot be greater than the total allowed amount, less $5.00"
+12 WRITE !,"Adjusting the amount to the greatest amount allowed."
+13 SET ACRADVR=ACRTAMT-5
+14 DO PAUSE^ACRFWARN
End DoDot:1
+15 QUIT ACRADVR
