- 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
