- 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
