ACRFCLM ;IHS/OIRM/DSD/THL,AEF - CALCULATE AMOUNT CLAIMED FOR TRAVEL ORDER; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO CALCULATE AMOUNT CLAIMED FOR TRAVEL ORDER
EN ;EP;TO CALCULATE AND PRINT AMOUNT CLAIMED ON TRAVEL ORDER
D EN1
EXIT ;EP;TO KILL TRAINING TRAVEL VARIABLES
K ACR1,ACR11,ACR2,ACR21,ACR3,ACR31,ACR4,ACR5,ACR6,ACRTNGTV,ACRADV,ACRALDA
Q
EN1 D EN11
W !!,"---------------------------- PAYMENT INFORMATION -----------------------------"
W !,"AMOUNT CLAIMED...........:",$J($FN(ACRX,"P",2),10)
W !,"APPLIED TO TRAVEL ADVANCE:",$J($FN(ACRADV,"P",2),10)
W !,"VERIFIED CHARGE TO APPROP:",$J($FN(ACRX,"P",2),10)
W !,"NET TO TRAVELER..........:"
W:ACRX>ACRADV $J($FN(ACRX-ACRADV,"P",2),10)
D PAUSE^ACRFWARN
Q
EN11 ;EP;TO FIND TRAVEL ADVANCE AMOUNT AND AMOUNT OWED TO TRAVELER
S ACRADV=$S($D(^ACRDOC(ACRDOCDA,"TO")):$P(^("TO"),U,25),1:0)
S (ACRX,ACRSSDA)=0
F ACRI=1:1:3 D
.S ACRSSDA=$O(^ACRSS("E",ACRDOCDA,ACRI,0))
.S:ACRSSDA ACRX=ACRX+$P(^ACRSS(ACRSSDA,"DT"),U,4)
D ALTOT
I $P($G(^ACRSYS(1,400)),U,4) S ACRX=ACRX+$$TMFEE^ACRFSS42(ACRDOCDA)
S ACRX=ACRX-$S($P(^ACRDOC(ACRDOCDA,"TOAU"),U,5)=1:0,1:$G(ACRALTOT))
Q
ALTOT ;EP;TO CALCULATE TOTAL AIRLINE EXPENSE FOR A TRAVEL DOCUMENT
S ACRALTOT=0
Q:'$G(ACRDOCDA)
N ACRALDA
S ACRALDA=0
F S ACRALDA=$O(^ACRAL("E",ACRDOCDA,ACRALDA)) Q:'ACRALDA D
.S ACRALTOT=ACRALTOT+$P($G(^ACRAL(ACRALDA,"DT")),U,9)
Q
EN2 ;EP;TO DETERMINE TRAINING TRAVEL EXPENSES
S (ACR1,ACR2,ACR3,ACR4,ACR5,ACR6)=0
G:'$D(^ACRDOC(ACRDOCDA,"TRNGTO")) EN21
S ACRTNGTV=$P(^ACRDOC(ACRDOCDA,"TRNGTO"),U)
G:'ACRTNGTV EN21
G:'$D(^ACRDOC(ACRTNGTV,0)) EN21
S ACRTNGTV=$P(^ACRDOC(ACRTNGTV,0),U,5)
G:'ACRTNGTV EN21
N X
F X=1:1:3 S @("ACR"_X)=$O(^ACRSS("E",ACRTNGTV,X,0))
F X=1:1:3 S @("ACR"_X)=$P($G(^ACRSS(+@("ACR"_X),"DT")),U,4)
EN21 S (ACR4,ACR5)=$P(^ACRDOC(ACRDOCDA,0),U,5)
S ACR4=$O(^ACRSS("E",+ACR4,1,0))
S ACR4=$P($G(^ACRSS(+ACR4,"DT")),U,4)
S ACR5=$O(^ACRSS("E",+ACR5,2,0))
S ACR5=$P($G(^ACRSS(+ACR5,"DT")),U,4)
F X=1:1:5 S ACR6=$G(ACR6)+@("ACR"_X)
F X=1:1:6 S @("ACR"_X)=$FN(@("ACR"_X),"P",2)
Q
ACRFCLM ;IHS/OIRM/DSD/THL,AEF - CALCULATE AMOUNT CLAIMED FOR TRAVEL ORDER; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO CALCULATE AMOUNT CLAIMED FOR TRAVEL ORDER
EN ;EP;TO CALCULATE AND PRINT AMOUNT CLAIMED ON TRAVEL ORDER
+1 DO EN1
EXIT ;EP;TO KILL TRAINING TRAVEL VARIABLES
+1 KILL ACR1,ACR11,ACR2,ACR21,ACR3,ACR31,ACR4,ACR5,ACR6,ACRTNGTV,ACRADV,ACRALDA
+2 QUIT
EN1 DO EN11
+1 WRITE !!,"---------------------------- PAYMENT INFORMATION -----------------------------"
+2 WRITE !,"AMOUNT CLAIMED...........:",$JUSTIFY($FNUMBER(ACRX,"P",2),10)
+3 WRITE !,"APPLIED TO TRAVEL ADVANCE:",$JUSTIFY($FNUMBER(ACRADV,"P",2),10)
+4 WRITE !,"VERIFIED CHARGE TO APPROP:",$JUSTIFY($FNUMBER(ACRX,"P",2),10)
+5 WRITE !,"NET TO TRAVELER..........:"
+6 IF ACRX>ACRADV
WRITE $JUSTIFY($FNUMBER(ACRX-ACRADV,"P",2),10)
+7 DO PAUSE^ACRFWARN
+8 QUIT
EN11 ;EP;TO FIND TRAVEL ADVANCE AMOUNT AND AMOUNT OWED TO TRAVELER
+1 SET ACRADV=$SELECT($DATA(^ACRDOC(ACRDOCDA,"TO")):$PIECE(^("TO"),U,25),1:0)
+2 SET (ACRX,ACRSSDA)=0
+3 FOR ACRI=1:1:3
Begin DoDot:1
+4 SET ACRSSDA=$ORDER(^ACRSS("E",ACRDOCDA,ACRI,0))
+5 IF ACRSSDA
SET ACRX=ACRX+$PIECE(^ACRSS(ACRSSDA,"DT"),U,4)
End DoDot:1
+6 DO ALTOT
+7 IF $PIECE($GET(^ACRSYS(1,400)),U,4)
SET ACRX=ACRX+$$TMFEE^ACRFSS42(ACRDOCDA)
+8 SET ACRX=ACRX-$SELECT($PIECE(^ACRDOC(ACRDOCDA,"TOAU"),U,5)=1:0,1:$GET(ACRALTOT))
+9 QUIT
ALTOT ;EP;TO CALCULATE TOTAL AIRLINE EXPENSE FOR A TRAVEL DOCUMENT
+1 SET ACRALTOT=0
+2 IF '$GET(ACRDOCDA)
QUIT
+3 NEW ACRALDA
+4 SET ACRALDA=0
+5 FOR
SET ACRALDA=$ORDER(^ACRAL("E",ACRDOCDA,ACRALDA))
IF 'ACRALDA
QUIT
Begin DoDot:1
+6 SET ACRALTOT=ACRALTOT+$PIECE($GET(^ACRAL(ACRALDA,"DT")),U,9)
End DoDot:1
+7 QUIT
EN2 ;EP;TO DETERMINE TRAINING TRAVEL EXPENSES
+1 SET (ACR1,ACR2,ACR3,ACR4,ACR5,ACR6)=0
+2 IF '$DATA(^ACRDOC(ACRDOCDA,"TRNGTO"))
GOTO EN21
+3 SET ACRTNGTV=$PIECE(^ACRDOC(ACRDOCDA,"TRNGTO"),U)
+4 IF 'ACRTNGTV
GOTO EN21
+5 IF '$DATA(^ACRDOC(ACRTNGTV,0))
GOTO EN21
+6 SET ACRTNGTV=$PIECE(^ACRDOC(ACRTNGTV,0),U,5)
+7 IF 'ACRTNGTV
GOTO EN21
+8 NEW X
+9 FOR X=1:1:3
SET @("ACR"_X)=$ORDER(^ACRSS("E",ACRTNGTV,X,0))
+10 FOR X=1:1:3
SET @("ACR"_X)=$PIECE($GET(^ACRSS(+@("ACR"_X),"DT")),U,4)
EN21 SET (ACR4,ACR5)=$PIECE(^ACRDOC(ACRDOCDA,0),U,5)
+1 SET ACR4=$ORDER(^ACRSS("E",+ACR4,1,0))
+2 SET ACR4=$PIECE($GET(^ACRSS(+ACR4,"DT")),U,4)
+3 SET ACR5=$ORDER(^ACRSS("E",+ACR5,2,0))
+4 SET ACR5=$PIECE($GET(^ACRSS(+ACR5,"DT")),U,4)
+5 FOR X=1:1:5
SET ACR6=$GET(ACR6)+@("ACR"_X)
+6 FOR X=1:1:6
SET @("ACR"_X)=$FNUMBER(@("ACR"_X),"P",2)
+7 QUIT
