ACRFSS4 ;IHS/OIRM/DSD/THL,AEF - EDIT TRAVEL VOUCHER; [ 01/31/2007 7:35 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,22**;NOV 05, 2001
;;CONTINUATION OF ACRFSS
EN N ACRY,ACRJ
D EXITSS4^ACRFSSA
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
I '$D(ACRREV),'$D(ACRPRT),ACRREF=130,$P(^ACRDOC(ACRDOCDA,"TO"),U,19)="Y" D TA^ACRFSSA1
I $D(ACRCHANG) S ACRSCHK="" D APPROVE^ACRFSCHK,PAUSE^ACRFWARN K ACRCHANG,ACRSCHK
EXIT D EXITSS4^ACRFSSA
Q
EN1 D DISPLAY^ACRFSS42
Q:$D(ACRQUIT)!$D(ACROUT)
I $D(ACRPRT) S ACRQUIT="" Q
I $D(ACRREV) D PAUSE^ACRFWARN S ACRQUIT="" Q
N X,Y
S (X,Y)=0
F S X=$O(^ACRSS("J",ACRDOCDA,X)) Q:'X S Y=Y+$P($G(^ACRSS(X,"DT")),U,4)
I Y,$G(ACRREF)'=600 D CHECK^ACRFWARN
Q:$D(ACROUT)
I Y,$$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD" D ;ACR*2.1*5.17
.;I Y>2500 D CHECKCC^ACRFWARN(Y) ;ACR*2.1*5.17 ;ACR*2.1*22.06 IM23064
.I Y>3000 D CHECKCC^ACRFWARN(Y) ;ACR*2.1*22.06 IM23064
Q:$D(ACROUT) ;ACR*2.1*5.17
S ACRFIRST=$P(^ACRDOC(ACRDOCDA,"TO"),U,14)
S ACRLAST=$P(^ACRDOC(ACRDOCDA,"TO"),U,15)
I $G(ACRJ)=0 D ADD^ACRFSS41 G EN1
S DIR(0)="SO^1:Edit Travel Day;2:Add Travel Days;3:Delete Travel Days"
S DIR("A")="Which Option ===> "
D DIR^ACRFDIC
Q:$D(ACROUT)
I Y=1 D EDIT^ACRFSS41 K ACRQUIT Q
I Y=2 D ADD^ACRFSS41 I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
I Y=3 D DELETE^ACRFSS41 K ACRQUIT Q
D CME
I $P(^ACRDOC(ACRDOCDA,"TO"),U,22)=1 D ATM
;IF TRAVEL ADVANCE NOT REQUESTED DELETE ANY TA AMOUNT AND OTA ENTRY
I '$D(ACRREV),'$D(ACRPRT),$P(^ACRDOC(ACRDOCDA,"TO"),U,19)'="Y" D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="130160///@"
.W !
.D DIE^ACRFDIC
.S DA=ACRDOCDA
.S DIK="^ACROTA("
.D DIK^ACRFDIC
I $D(^ACRAL("E",ACRDOCDA)) S ACRQUIT="" Q
S DIR(0)="YO"
S DIR("A")="Add/Edit FLIGHT INFO"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 S ACRQUIT=""
E D ^ACRFSS5
Q
ATM ;CALCULATE ATM SERVICE CHARGE
Q:$P(^ACRDOC(ACRDOCDA,"TO"),U,22)'=1
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="130177Amount of ATM advance "_$S(ACRREF=600:"taken....",1:"requested")
W !
D DIE^ACRFDIC
I ACRREF'=600,$D(ACRATM),$P($G(^ACROBL(ACRDOCDA,"APV")),U)'="A" D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="130158////"_ACRATM
.D DIE^ACRFDIC
S ACR4P=$P(^ACRDOC(ACRDOCDA,"TO"),U,26)
S ACR4P=$FN(ACR4P,"P",2)
S ACR4P=$TR(ACR4P," ","")
Q
DEPART ;EP;TO INDICATE IF THIS IS THE DEPART DATE
Q:'$D(^ACRTV(+$G(DA),"DT"))!'$D(^ACRTV(+$G(DA),0))
N Y
S Y=^ACRTV(DA,"DT")
S ACRDFR=$P(Y,U,18)
S ACRAAT=$P(Y,U,19)
I ACRYN="LEAVE",$P(Y,U,2)]"" S ACRYN=1 Q
I ACRYN="ARRIVE",$P(Y,U,3)]"" S ACRYN=1 Q
S Y=$P(Y,U)
W !!,$S(Y<(DT+1):"Did",1:"Will")," you "
X ^DD("DD")
W:ACRYN="LEAVE" "DEPART FROM"
W:ACRYN="ARRIVE" "ARRIVE BACK AT"
W " your home or permanent duty station"
W !,"on ",Y
N %
S %=2
D YN^DICN
S ACRYN=%
W !
Q
TAXI ;EP;TO ENTER THE ROUNDTRIP TAXI FARE FROM HOME TO AIRPORT
N DA
S DA=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
S DIE="^ACRAU("
S DR="9ROUNDTRIP taxi fare"
Q:'DA
Q:$P($G(^ACRAU(DA,1)),U,9)
W !!,"Enter the average ROUNDTRIP taxi fare from the traveler's home"
W !,"to the nearest airport"
W !
D:DA DIE^ACRFDIC
Q
RECEIPTS ;EP;TO DETERMINE IF RECEIPTS ARE REQUIRED FOR PROCESSING THIS
;TRAVEL VOUCHER
W !!,"Are RECEIPTS required"
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR=".28in order to process this voucher"_$S($P(^ACRDOC(ACRDOCDA,0),U,28)=0:"//NO",1:"//YES")
D DIE^ACRFDIC
Q
CME ;INDICATE MAXIMUM AMOUNT FOR CONTINUING EDUCATION
W !!,"(For Continuing Education Travel/Training ONLY"
W !," enter MAXIMUM government contribution.)"
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="148370Cost to government Not to Exceed"
W !
D DIE^ACRFDIC
Q
ACRFSS4 ;IHS/OIRM/DSD/THL,AEF - EDIT TRAVEL VOUCHER; [ 01/31/2007 7:35 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,22**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFSS
EN NEW ACRY,ACRJ
+1 DO EXITSS4^ACRFSSA
+2 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 IF '$DATA(ACRREV)
IF '$DATA(ACRPRT)
IF ACRREF=130
IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,19)="Y"
DO TA^ACRFSSA1
+4 IF $DATA(ACRCHANG)
SET ACRSCHK=""
DO APPROVE^ACRFSCHK
DO PAUSE^ACRFWARN
KILL ACRCHANG,ACRSCHK
EXIT DO EXITSS4^ACRFSSA
+1 QUIT
EN1 DO DISPLAY^ACRFSS42
+1 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 IF $DATA(ACRPRT)
SET ACRQUIT=""
QUIT
+3 IF $DATA(ACRREV)
DO PAUSE^ACRFWARN
SET ACRQUIT=""
QUIT
+4 NEW X,Y
+5 SET (X,Y)=0
+6 FOR
SET X=$ORDER(^ACRSS("J",ACRDOCDA,X))
IF 'X
QUIT
SET Y=Y+$PIECE($GET(^ACRSS(X,"DT")),U,4)
+7 IF Y
IF $GET(ACRREF)'=600
DO CHECK^ACRFWARN
+8 IF $DATA(ACROUT)
QUIT
+9 ;ACR*2.1*5.17
IF Y
IF $$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD"
Begin DoDot:1
+10 ;I Y>2500 D CHECKCC^ACRFWARN(Y) ;ACR*2.1*5.17 ;ACR*2.1*22.06 IM23064
+11 ;ACR*2.1*22.06 IM23064
IF Y>3000
DO CHECKCC^ACRFWARN(Y)
End DoDot:1
+12 ;ACR*2.1*5.17
IF $DATA(ACROUT)
QUIT
+13 SET ACRFIRST=$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,14)
+14 SET ACRLAST=$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,15)
+15 IF $GET(ACRJ)=0
DO ADD^ACRFSS41
GOTO EN1
+16 SET DIR(0)="SO^1:Edit Travel Day;2:Add Travel Days;3:Delete Travel Days"
+17 SET DIR("A")="Which Option ===> "
+18 DO DIR^ACRFDIC
+19 IF $DATA(ACROUT)
QUIT
+20 IF Y=1
DO EDIT^ACRFSS41
KILL ACRQUIT
QUIT
+21 IF Y=2
DO ADD^ACRFSS41
IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+22 IF Y=3
DO DELETE^ACRFSS41
KILL ACRQUIT
QUIT
+23 DO CME
+24 IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,22)=1
DO ATM
+25 ;IF TRAVEL ADVANCE NOT REQUESTED DELETE ANY TA AMOUNT AND OTA ENTRY
+26 IF '$DATA(ACRREV)
IF '$DATA(ACRPRT)
IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,19)'="Y"
Begin DoDot:1
+27 SET DA=ACRDOCDA
+28 SET DIE="^ACRDOC("
+29 SET DR="130160///@"
+30 WRITE !
+31 DO DIE^ACRFDIC
+32 SET DA=ACRDOCDA
+33 SET DIK="^ACROTA("
+34 DO DIK^ACRFDIC
End DoDot:1
+35 IF $DATA(^ACRAL("E",ACRDOCDA))
SET ACRQUIT=""
QUIT
+36 SET DIR(0)="YO"
+37 SET DIR("A")="Add/Edit FLIGHT INFO"
+38 SET DIR("B")="NO"
+39 WRITE !
+40 DO DIR^ACRFDIC
+41 IF Y'=1
SET ACRQUIT=""
+42 IF '$TEST
DO ^ACRFSS5
+43 QUIT
ATM ;CALCULATE ATM SERVICE CHARGE
+1 IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,22)'=1
QUIT
+2 SET DA=ACRDOCDA
+3 SET DIE="^ACRDOC("
+4 SET DR="130177Amount of ATM advance "_$SELECT(ACRREF=600:"taken....",1:"requested")
+5 WRITE !
+6 DO DIE^ACRFDIC
+7 IF ACRREF'=600
IF $DATA(ACRATM)
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U)'="A"
Begin DoDot:1
+8 SET DA=ACRDOCDA
+9 SET DIE="^ACRDOC("
+10 SET DR="130158////"_ACRATM
+11 DO DIE^ACRFDIC
End DoDot:1
+12 SET ACR4P=$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,26)
+13 SET ACR4P=$FNUMBER(ACR4P,"P",2)
+14 SET ACR4P=$TRANSLATE(ACR4P," ","")
+15 QUIT
DEPART ;EP;TO INDICATE IF THIS IS THE DEPART DATE
+1 IF '$DATA(^ACRTV(+$GET(DA),"DT"))!'$DATA(^ACRTV(+$GET(DA),0))
QUIT
+2 NEW Y
+3 SET Y=^ACRTV(DA,"DT")
+4 SET ACRDFR=$PIECE(Y,U,18)
+5 SET ACRAAT=$PIECE(Y,U,19)
+6 IF ACRYN="LEAVE"
IF $PIECE(Y,U,2)]""
SET ACRYN=1
QUIT
+7 IF ACRYN="ARRIVE"
IF $PIECE(Y,U,3)]""
SET ACRYN=1
QUIT
+8 SET Y=$PIECE(Y,U)
+9 WRITE !!,$SELECT(Y<(DT+1):"Did",1:"Will")," you "
+10 XECUTE ^DD("DD")
+11 IF ACRYN="LEAVE"
WRITE "DEPART FROM"
+12 IF ACRYN="ARRIVE"
WRITE "ARRIVE BACK AT"
+13 WRITE " your home or permanent duty station"
+14 WRITE !,"on ",Y
+15 NEW %
+16 SET %=2
+17 DO YN^DICN
+18 SET ACRYN=%
+19 WRITE !
+20 QUIT
TAXI ;EP;TO ENTER THE ROUNDTRIP TAXI FARE FROM HOME TO AIRPORT
+1 NEW DA
+2 SET DA=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+3 SET DIE="^ACRAU("
+4 SET DR="9ROUNDTRIP taxi fare"
+5 IF 'DA
QUIT
+6 IF $PIECE($GET(^ACRAU(DA,1)),U,9)
QUIT
+7 WRITE !!,"Enter the average ROUNDTRIP taxi fare from the traveler's home"
+8 WRITE !,"to the nearest airport"
+9 WRITE !
+10 IF DA
DO DIE^ACRFDIC
+11 QUIT
RECEIPTS ;EP;TO DETERMINE IF RECEIPTS ARE REQUIRED FOR PROCESSING THIS
+1 ;TRAVEL VOUCHER
+2 WRITE !!,"Are RECEIPTS required"
+3 SET DA=ACRDOCDA
+4 SET DIE="^ACRDOC("
+5 SET DR=".28in order to process this voucher"_$SELECT($PIECE(^ACRDOC(ACRDOCDA,0),U,28)=0:"//NO",1:"//YES")
+6 DO DIE^ACRFDIC
+7 QUIT
CME ;INDICATE MAXIMUM AMOUNT FOR CONTINUING EDUCATION
+1 WRITE !!,"(For Continuing Education Travel/Training ONLY"
+2 WRITE !," enter MAXIMUM government contribution.)"
+3 SET DA=ACRDOCDA
+4 SET DIE="^ACRDOC("
+5 SET DR="148370Cost to government Not to Exceed"
+6 WRITE !
+7 DO DIE^ACRFDIC
+8 QUIT
