ACRFTA ;IHS/OIRM/DSD/THL,AEF - TRAVEL ORDER PROCESSING; [ 09/26/2005 7:35 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5,19**;NOV 05, 2001
;;NOV 05, 2001
;;PROCESS TRAVEL ORDERS
TA ;EP;SELECT OTA REPORT
D TAEXIT
F D TA1 Q:$D(ACRQUIT)!$D(ACROUT)
TAEXIT ;EP
K ACRQUIT,ACRDC,ACROTA0,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR7,ACR8,ACR9,ACR9E,ACR9F,ACR9G,ACROUT,ACRUNLIQ,ACRTOT1,ACRTOT2
K ^TMP("ACRTAS",$J)
Q
TA1 W @IOF
W !?10,"Select TRAVEL ADVANCE Function"
S DIR(0)="SO^1:Print TA for One Travel Order" ;ACR*2.1*5.10
S DIR(0)=DIR(0)_";2:Print TA History for Selected Employee" ;ACR*2.1*5.10
S DIR(0)=DIR(0)_";3:Print TA Summary for Selected Time Period" ;ACR*2.1*5.10
S DIR(0)=DIR(0)_";4:Edit Travel Advance" ;ACR*2.1*5.10
S DIR(0)=DIR(0)_";5:Delete Travel Advance" ;ACR*2.1*5.10
S DIR("A")="Which function"
W !
D DIR^ACRFDIC
I Y<1 S ACRQUIT="" Q
I Y=1 D DOC Q
I Y=2 D OTAEMP Q
I Y=3 D TASUM Q
I Y=4 N ACRTAED S ACRTAED="" D EDIT Q ;ACR*2.1*5.10
I Y=5 D DELETE Q
Q
DOC ;SELECT DOC FOR TA REVIEW
S (ACRREF,ACRREFX)=130
D SELDOC
I '$G(ACRDOCDA) K ACRQUIT Q
S (ACRRTN,ZTRTN)="TAFORM^ACRFTA"
S ZTDESC="TRAVEL ORDER OUTSTANDING ADVANCE SUMMARY"
D ^ACRFZIS
Q
TAFORM ;EP;PRINT TA FORM
Q:'$G(ACRDOCDA)
N X,Y,Z,ACRREFX,ACRDOCX,ACROTA0,ACRFR,ACRTO,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR7,ACR8,ACR9,ACR9E,ACR9F,ACR10,ACR101,ACR102
D TAGATHER
W $$DASH^ACRFMENU
W !?10,"ADVANCE OF FUNDS APPLICATION AND ACCOUNT"
W !,"TRAVEL ORDER.....: ",$G(ACRDOC)
W !,"TRAVEL FROM......: "
S Y=$G(ACRFR)
X ^DD("DD")
S ACRFR=Y
S Y=$G(ACRTO)
X ^DD("DD")
S ACRTO=Y
W $G(ACRFR)
W:$G(ACRTO)]"" " TO: ",$G(ACRTO)
W !,"TYPE OF ADVANCE..: ",$G(ACR1)
W !,"TYPE OF TRAVEL...: ",$G(ACR2)
W !,"TRAVELER.........: ",$G(ACR3)," (SSN ",$S($G(ACR6)]"":"ON RECORD",1:"NOT ON RECORD"),")"
W !,"SIGNED ON........: ",$G(ACR32),$G(ACR31)
W !,"TO APPROVED BY...: ",$G(ACR33)
W:$G(ACR34)]"" " ON: ",$G(ACR34)
W !,"OFFICE PHONE.....: ",$G(ACR5)
W !,"DEPARTMENT.......: ",$G(ACR7)
W !,"OFF DUTY STATION.: ",$G(ACR8)
W !,"BALANCE DUE......: ",$J($FN($G(ACR9E),"P,",2),10)
W !,"AMT APPLIED FOR..: ",$J($FN($G(ACR9F),"P,",2),10)
W !,"AMT LIQUIDATED...: ",$J($FN($G(ACR9G),"P,",2),10)
W !,"ADVANCE SIGNATURE: ",$S($G(ACR102)]"":ACR102,1:"(NOT YET SIGNED)")," ",$G(ACR10)
W:$G(ACR101)]"" " ON: ",$G(ACR101)
S ACRY="PURPOSE OF TRAVEL"
N ACRREFX
S ACRREFX=600
D JUST^ACRFSSD1
W $$DASH^ACRFMENU
D PAUSE^ACRFWARN
Q
OTASUM ;EP;SUMMARIZE TA
D TASUMH
S (ACRTOT1,ACRTOT2)=0
S ACRDOCDA=99999999
F S ACRDOCDA=$O(^ACROTA("C",ACRDUZ,ACRDOCDA),-1) Q:'ACRDOCDA!$D(ACRQUIT) D
.I $D(ACRUNLIQ),$P($G(^ACROBL(ACRDOCDA,"APV")),U,8)'="A"!'($P(^ACROTA(ACRDOCDA,0),U,3)-$P(^ACROTA(ACRDOCDA,0),U,4)) Q
.D TAGATHER
.Q:ACRFR<ACRBEGIN ; ACR*2.1*3.21
.Q:ACRFR>ACREND ; ACR*2.1*3.21
.D TASUML
D SUMT
D PAUSE^ACRFWARN
D TAEXIT
Q
TASUM ;EP;PRINT TA SUMMARY
W !
D ^ACRFDATE
Q:'$G(ACRBEGIN)
Q:$D(ACRQUIT)
D UNLIQ
Q:$D(ACRQUIT)
S (ACRRTN,ZTRTN)="TAS^ACRFTA"
S ZTDESC="OUTSTANDING TRAVEL ADVANCE SUMMARY"
D ^ACRFZIS
Q
TAS ;PRINT OUTSTANDING TA
I $E($G(IOST),1,2)="C-" D
.W !!,"It could take me a while to find all the Travel advances."
.W !,"Please stand by."
S ACRDATE=0
F S ACRDATE=$O(^ACRDOC("DD",ACRDATE)) Q:'ACRDATE!(ACRDATE>ACREND) D
.Q:ACRDATE<ACRBEGIN ; ACR*2.1*3.21
.S ACRDOCDA=0
.F S ACRDOCDA=$O(^ACRDOC("DD",ACRDATE,ACRDOCDA)) Q:'ACRDOCDA D:$D(^ACROTA(ACRDOCDA,0))
..S X=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
..;S X=$P($G(^VA(200,+X,0)),U) ;ACR*2.1*19.02 IM16848
..S X=$$NAME2^ACRFUTL1(+X) ;ACR*2.1*19.02 IM16848
..Q:X=""
..I $D(ACRUNLIQ),$P($G(^ACROBL(ACRDOCDA,"APV")),U,8)'="A"!'($P(^ACROTA(ACRDOCDA,0),U,3)-$P(^ACROTA(ACRDOCDA,0),U,4)) Q
..S ^TMP("ACRTAS",$J,X,ACRDOCDA)=""
D TASUMH
S (ACRTOT1,ACRTOT2)=0
S ACRX=""
F S ACRX=$O(^TMP("ACRTAS",$J,ACRX)) Q:ACRX=""!$D(ACRQUIT) D
.S ACRDOCDA=0
.F S ACRDOCDA=$O(^TMP("ACRTAS",$J,ACRX,ACRDOCDA)) Q:'ACRDOCDA!$D(ACRQUIT) D
..N ACRDUZ
..D TAGATHER
..D TASUML
.D SUMT
.I $Y+4>IOSL D PAUSE^ACRFWARN D TASUMH:'$D(ACRQUIT)
D PAUSE^ACRFWARN
D TAEXIT
Q
SUMT ;TOTALS
I $G(ACRTOT1)>$G(ACRTOT2) D
.W ?59,$J($FN((ACRTOT1-ACRTOT2),"P,",2),10)
.W !
Q
TASUML ;TA SUMMARY LINE
W !,$G(ACR3),?21,$G(ACRDOC),?35,$J($FN($G(ACR9F),"P,",2),10),?47,$J($FN($G(ACR9G),"P,",2),10)
S ACRTOT1=$G(ACRTOT1)+$G(ACR9F)
S ACRTOT2=$G(ACRTOT2)+$G(ACR9G)
Q
TASUMH ;TA SUMMARY HDR
W @IOF
W !?5,"Travel Advance Summary Report - OUTSTANDING TRAVEL ADVANCES"
W !?5,"-----------------------------------------------------------"
W !?5,"Date Report Run......: "
S Y=DT
X ^DD("DD")
W Y
S ACRDC=$G(ACRDC)+1
W ?55,"PAGE: ",ACRDC
W !?10,"Reporting Period From: "
S Y=ACRBEGIN
X ^DD("DD")
W Y
W !?10,"Reporting Period To..: "
S Y=ACREND
X ^DD("DD")
W Y
W $$DASH^ACRFMENU
W !,?35,"ADVANCE",?47,"LIQUIDATED",?59,"TOTAL"
W !,"TRAVELER",?21,"TRAVEL ORDER",?35,"AMOUNT",?47,"AMOUNT",?59,"OUTSTANDING"
W !,"--------------------",?21,"-------------",?35,"-----------",?47,"-----------",?59,"-----------"
Q
TAGATHER ;GATHER TA INFO
I '$D(^ACROTA(ACRDOCDA,0)) S ACR3="NO TRAVEL ADVANCE ON FILE" Q
N X,Y
S ACRDUZ=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
;S X=$P($G(^VA(200,+ACRDUZ,0)),U) ;ACR*2.1*19.02 IM16848
S X=$$NAME2^ACRFUTL1(+ACRDUZ) ;ACR*2.1*19.02 IM16848
S ACR3=$P($P(X,",",2)," ")_" "_$P(X,",")
S ACR5=$P($G(^VA(200,+ACRDUZ,.13)),U,2)
S ACR6=$P($G(^VA(200,+ACRDUZ,1)),U,9)
S Y=$G(^ACRDOC(ACRDOCDA,0))
S ACR7=$P(Y,U,6)
S ACR7=$P($G(^ACRLOCB(+ACR7,0)),U,12)
S ACR8=$P($G(^DIC(4,+$P($G(^ACRAU(+ACRDUZ,1)),U),0)),U)
S ACRREFX=$O(^AUTTDOCR("B",130,0))
S ACRDOC=$P(Y,U)
S ACRFR=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,14)
S ACRTO=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,15)
I (U_$G(^ACRDOC(ACRDOCDA,"TOPCS"))_U)[("^Y^") S ACR2="PCS"
E S ACR2="TDY"
S ACR1=$S($P($G(^ACRAU(+ACRDUZ,19)),U)]"":"EFT",1:"CHECK")
S ACROTA0=$G(^ACROTA(ACRDOCDA,0))
S ACROTA1=$G(^ACROTA(ACRDOCDA,1))
S ACR9F=$P(ACROTA0,U,3)
S ACR9G=$P(ACROTA0,U,4)
D OUTSTD
S (ACR31,ACR32,ACR33,ACR34)=""
S X=0
F S X=$O(^ACRAPVS("AB",ACRDOCDA,X)) Q:'X D
.I $P($G(^ACRAPVS(X,0)),U,6)=135,$P(^(0),U,3)=15,$P(^ACRAPVS(X,"DT"),U,4) D
..S ACR10=^ACRAPVS(X,"DT")
..S ACR102=$E(ACR10)
..S ACR102=$S($G(ACR102)="A":"APPROVED BY",$G(ACR102)="D":"DISAPPROVED",$G(ACR102)="C":"CANCELLED BY",1:"(NOT YET SIGNED)")
..S Y=$P(ACR10,U,4)
..X ^DD("DD")
..S ACR101=Y
..S ACR10=$S($P(ACR10,U,6):$P(ACR10,U,6),1:$P(ACR10,U,2))
..;S ACR10=$P($G(^VA(200,+ACR10,0)),U) ;ACR*2.1*19.02 IM16848
..S ACR10=$$NAME2^ACRFUTL1(+ACR10) ;ACR*2.1*19.02 IM16848
..S ACR10=$P($P(ACR10,",",2)," ")_" "_$P(ACR10,",")
.I $P($G(^ACRAPVS(X,0)),U,6)=35 D
..I $P($G(^ACRAPVS(X,"DT")),U,2)=ACRDUZ,$P(^("DT"),U,4) S ACR31=$P(^("DT"),U,6),ACR32=$P(^("DT"),U,4)
..I $P($G(^ACRAPVS(X,"DT")),U,5)="Y",$P(^("DT"),U,4) S ACR33=$P(^("DT"),U,6),ACR34=$P(^("DT"),U,4)
I ACR33 D
.;S ACR33=$P($G(^VA(200,ACR33,0)),U) ;ACR*2.1*19.02 IM16848
.S ACR33=$$NAME2^ACRFUTL1(ACR33) ;ACR*2.1*19.02 IM16848
.S ACR33=$P($P(ACR33,",",2)," ")_" "_$P(ACR33,",")
.S Y=ACR34
.X ^DD("DD")
.S ACR34=Y
I ACR31,ACR31'=ACRDUZ D I 1
.;S X=$P($G(^VA(200,+ACR31,0)),U) ;ACR*2.1*19.02 IM16848
.S X=$$NAME2^ACRFUTL1(+ACR31) ;ACR*2.1*19.02 IM16848
.S ACR31=" (by "_$P($P(X,",",2)," ")_" "_$P(X,",")_")"
E S ACR31=""
S Y=ACR32
X ^DD("DD")
S ACR32=Y
Q
OTAEMP ;EP;REVIEW TA
D EMP1^ACRFAU
I '$G(ACRDUZ) K ACRQUIT Q
W !
D ^ACRFDATE
Q:'$G(ACRBEGIN)
Q:$D(ACRQUIT)
D UNLIQ
Q:$D(ACRQUIT)
S (ACRRTN,ZTRTN)="OTASUM^ACRFTA"
S ZTDESC="EMPLOYEE TRAVEL ADVANCE SUMMARY"
D ^ACRFZIS
Q
EDIT ;EDIT TA
F D E1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
E1 D SELDOC
E11 ;EP;EDIT TRAVEL ADVANCE
I '$G(ACRDOCDA) S ACRQUIT="" Q
S DA=ACRDOCDA
S DIE="^ACROTA("
S DR=".03TRAVEL ADVANCE AMNT." ;ACR*2.1*5.10
D DIE^ACRFDIC ;ACR*2.1*5.10
I $D(ACRTAED) D E12 ;ACR*2.1*5.10
S ACRADV=$P($G(^ACROTA(ACRDOCDA,0)),U,3) ;ACR*2.1*5.10
D ETA^ACRFSSA1 ;ACR*2.1*5.10
Q
E12 ;Local entry; LIQUIDATE TRAVEL ADVANCE ;ACR*2.1*5.10
S DA=ACRDOCDA ;ACR*2.1*5.10
S DIE="^ACROTA(" ;ACR*2.1*5.10
S ACRADV=$P($G(^ACROTA(ACRDOCDA,0)),U,3) ;ACR*2.1*5.10
S DR=".04//"_ACRADV ;ACR*2.1*5.10
D DIE^ACRFDIC ;ACR*2.1*5.10
Q ;ACR*2.1*5.10
DELETE ;DELETE TA
D SELDOC
Q:'$G(ACRDOCDA)
S DIR(0)="YO"
S DIR("A",1)="Are you certain you want to delete the"
S DIR("A")="TRAVEL ADVANCE for TO "_ACRDOC
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 K ACRQUIT Q
S DA=ACRDOCDA
S DIK="^ACROTA("
D DIK^ACRFDIC
D OTADEL
Q
SELDOC ;SELECT TRAVEL ORDER
K ACRDOCDA
S DIC="^ACROTA("
S DIC(0)="AEMQZ"
S DIC("A")="Select TRAVEL ORDER: "
W !
D DIC^ACRFDIC
I +Y<1 K ACRQUIT Q
S ACRDOCDA=+Y
D SETDOC^ACRFEA1
Q
UNLIQ ;INCLUDE UNLIQUIDATED ADVANCES ONLY
S DIR(0)="YO"
S DIR("A")="UNLIQUIDATED Advances Only"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y=1 S ACRUNLIQ=""
Q
OUTSTD ;EP;TO CHECK FOR OUTSTANDING ADVANCES
N X,Y,Z,ACROTA0,ACROTA1,ACRDOCX
Q:'$G(ACRDUZ)!'$G(ACRDOCDA)
S X=0
F S X=$O(^ACROTA("C",ACRDUZ,X)) Q:'X D:X'=ACRDOCDA
.S ACROTA0=$G(^ACROTA(X,0))
.S ACRDOCX=$P(ACROTA0,U,2)
.S ACR9E=$G(ACR9E)+$P(^ACROTA(X,0),U,3)-$P(^ACROTA(X,0),U,4)
Q
S Z=0
F S Z=$O(^ACRAPVS("AB",ACRDOCDA,Z)) Q:'Z D
.I ACRREFX=$P(^ACRAPVS(Z,0),U,6) S ACRQUIT=""
.I $D(ACRQUIT) K ACRQUIT Q
.S ACR9E=$G(ACR9E)+$P(^ACROTA(X,0),U,3)-$P(^ACROTA(X,0),U,4)
.S ACR9E=$G(ACR9E)+$P(^ACROTA(X,0),U,3)-$P(^ACROTA(X,0),U,4)
Q
OTA ;EP;PROCESS APPROVAL OF TRAVEL ADVANCE
N ACRDUZ
S ACRDUZ=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
Q:'ACRDUZ
S ACRACH=$S($P($G(^ACRAU(ACRDUZ,19)),U)]"":"B",1:"C")
S ACRCAN=$P(^ACRDOC(ACRDOCDA,0),U,8)
S ACRCAN=$P($G(^ACRPO(+ACRCAN,0)),U,4)
S ACRCAN=$P($G(^AUTTACPT(+ACRCAN,0)),U)
I ACRCAN="" D Q
.W !!,"Purchasing office not properly set up."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
S ACRCANDA=$P(^ACRDOC(ACRDOCDA,"REQ"),U,10) ; ACR*2.1*3.01
I 'ACRCANDA D Q
.W !!,"CAN not found."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
S (ACRREF,ACRREFX)=602
S ACRREFDA=$O(^AUTTDOCR("B",602,0))
S DA=ACRDOCDA
S DIE="^ACROTA("
S DR="1////"_ACRAPDA
D DIE^ACRFDIC
K ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRAPDA),^TMP("ACRDATA",$J,ACRDUZ,ACRJJ),^TMP("ACRALT",$J,ACRDUZ,ACRJJ)
S ACROBJDA=$P(^ACRDOC(ACRDOCDA,"REQ"),U,6) ; ACR*2.1*3.01
Q:'ACRCANDA!'ACROBJDA!'$P($G(^ACROTA(ACRDOCDA,0)),U,3)
S ACRIVPAY(ACRCANDA,ACROBJDA)=$P(^ACROTA(ACRDOCDA,0),U,3)
I $P(^ACRDOC(ACRDOCDA,"TO"),U,25)'=$P(^ACROTA(ACRDOCDA,0),U,3) D
.S ACRADV=$P(^ACROTA(ACRDOCDA,0),U,3)
.D ETA^ACRFSSA1
S ACRTCODE="06119"
S ACRPAYDA=DT
K ACRLBDT
S ACRBTYP="T"
D ^ACRFIV11
K ACRIVPAY
Q
OTADEL ;EP;DELETE TRAVEL ADVANCE WHEN DISAPPROVED
S DA=ACRDOCDA
S DIE="^ACROTA("
S DR=".03///0;.04///0"
D DIE^ACRFDIC
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="130120///N;130160///0"
D DIE^ACRFDIC
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR="1000///0"
D DIE^ACRFDIC
Q
ACRFTA ;IHS/OIRM/DSD/THL,AEF - TRAVEL ORDER PROCESSING; [ 09/26/2005 7:35 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5,19**;NOV 05, 2001
+2 ;;NOV 05, 2001
+3 ;;PROCESS TRAVEL ORDERS
TA ;EP;SELECT OTA REPORT
+1 DO TAEXIT
+2 FOR
DO TA1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
TAEXIT ;EP
+1 KILL ACRQUIT,ACRDC,ACROTA0,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR7,ACR8,ACR9,ACR9E,ACR9F,ACR9G,ACROUT,ACRUNLIQ,ACRTOT1,ACRTOT2
+2 KILL ^TMP("ACRTAS",$JOB)
+3 QUIT
TA1 WRITE @IOF
+1 WRITE !?10,"Select TRAVEL ADVANCE Function"
+2 ;ACR*2.1*5.10
SET DIR(0)="SO^1:Print TA for One Travel Order"
+3 ;ACR*2.1*5.10
SET DIR(0)=DIR(0)_";2:Print TA History for Selected Employee"
+4 ;ACR*2.1*5.10
SET DIR(0)=DIR(0)_";3:Print TA Summary for Selected Time Period"
+5 ;ACR*2.1*5.10
SET DIR(0)=DIR(0)_";4:Edit Travel Advance"
+6 ;ACR*2.1*5.10
SET DIR(0)=DIR(0)_";5:Delete Travel Advance"
+7 SET DIR("A")="Which function"
+8 WRITE !
+9 DO DIR^ACRFDIC
+10 IF Y<1
SET ACRQUIT=""
QUIT
+11 IF Y=1
DO DOC
QUIT
+12 IF Y=2
DO OTAEMP
QUIT
+13 IF Y=3
DO TASUM
QUIT
+14 ;ACR*2.1*5.10
IF Y=4
NEW ACRTAED
SET ACRTAED=""
DO EDIT
QUIT
+15 IF Y=5
DO DELETE
QUIT
+16 QUIT
DOC ;SELECT DOC FOR TA REVIEW
+1 SET (ACRREF,ACRREFX)=130
+2 DO SELDOC
+3 IF '$GET(ACRDOCDA)
KILL ACRQUIT
QUIT
+4 SET (ACRRTN,ZTRTN)="TAFORM^ACRFTA"
+5 SET ZTDESC="TRAVEL ORDER OUTSTANDING ADVANCE SUMMARY"
+6 DO ^ACRFZIS
+7 QUIT
TAFORM ;EP;PRINT TA FORM
+1 IF '$GET(ACRDOCDA)
QUIT
+2 NEW X,Y,Z,ACRREFX,ACRDOCX,ACROTA0,ACRFR,ACRTO,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR7,ACR8,ACR9,ACR9E,ACR9F,ACR10,ACR101,ACR102
+3 DO TAGATHER
+4 WRITE $$DASH^ACRFMENU
+5 WRITE !?10,"ADVANCE OF FUNDS APPLICATION AND ACCOUNT"
+6 WRITE !,"TRAVEL ORDER.....: ",$GET(ACRDOC)
+7 WRITE !,"TRAVEL FROM......: "
+8 SET Y=$GET(ACRFR)
+9 XECUTE ^DD("DD")
+10 SET ACRFR=Y
+11 SET Y=$GET(ACRTO)
+12 XECUTE ^DD("DD")
+13 SET ACRTO=Y
+14 WRITE $GET(ACRFR)
+15 IF $GET(ACRTO)]""
WRITE " TO: ",$GET(ACRTO)
+16 WRITE !,"TYPE OF ADVANCE..: ",$GET(ACR1)
+17 WRITE !,"TYPE OF TRAVEL...: ",$GET(ACR2)
+18 WRITE !,"TRAVELER.........: ",$GET(ACR3)," (SSN ",$SELECT($GET(ACR6)]"":"ON RECORD",1:"NOT ON RECORD"),")"
+19 WRITE !,"SIGNED ON........: ",$GET(ACR32),$GET(ACR31)
+20 WRITE !,"TO APPROVED BY...: ",$GET(ACR33)
+21 IF $GET(ACR34)]""
WRITE " ON: ",$GET(ACR34)
+22 WRITE !,"OFFICE PHONE.....: ",$GET(ACR5)
+23 WRITE !,"DEPARTMENT.......: ",$GET(ACR7)
+24 WRITE !,"OFF DUTY STATION.: ",$GET(ACR8)
+25 WRITE !,"BALANCE DUE......: ",$JUSTIFY($FNUMBER($GET(ACR9E),"P,",2),10)
+26 WRITE !,"AMT APPLIED FOR..: ",$JUSTIFY($FNUMBER($GET(ACR9F),"P,",2),10)
+27 WRITE !,"AMT LIQUIDATED...: ",$JUSTIFY($FNUMBER($GET(ACR9G),"P,",2),10)
+28 WRITE !,"ADVANCE SIGNATURE: ",$SELECT($GET(ACR102)]"":ACR102,1:"(NOT YET SIGNED)")," ",$GET(ACR10)
+29 IF $GET(ACR101)]""
WRITE " ON: ",$GET(ACR101)
+30 SET ACRY="PURPOSE OF TRAVEL"
+31 NEW ACRREFX
+32 SET ACRREFX=600
+33 DO JUST^ACRFSSD1
+34 WRITE $$DASH^ACRFMENU
+35 DO PAUSE^ACRFWARN
+36 QUIT
OTASUM ;EP;SUMMARIZE TA
+1 DO TASUMH
+2 SET (ACRTOT1,ACRTOT2)=0
+3 SET ACRDOCDA=99999999
+4 FOR
SET ACRDOCDA=$ORDER(^ACROTA("C",ACRDUZ,ACRDOCDA),-1)
IF 'ACRDOCDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+5 IF $DATA(ACRUNLIQ)
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,8)'="A"!'($PIECE(^ACROTA(ACRDOCDA,0),U,3)-$PIECE(^ACROTA(ACRDOCDA,0),U,4))
QUIT
+6 DO TAGATHER
+7 ; ACR*2.1*3.21
IF ACRFR<ACRBEGIN
QUIT
+8 ; ACR*2.1*3.21
IF ACRFR>ACREND
QUIT
+9 DO TASUML
End DoDot:1
+10 DO SUMT
+11 DO PAUSE^ACRFWARN
+12 DO TAEXIT
+13 QUIT
TASUM ;EP;PRINT TA SUMMARY
+1 WRITE !
+2 DO ^ACRFDATE
+3 IF '$GET(ACRBEGIN)
QUIT
+4 IF $DATA(ACRQUIT)
QUIT
+5 DO UNLIQ
+6 IF $DATA(ACRQUIT)
QUIT
+7 SET (ACRRTN,ZTRTN)="TAS^ACRFTA"
+8 SET ZTDESC="OUTSTANDING TRAVEL ADVANCE SUMMARY"
+9 DO ^ACRFZIS
+10 QUIT
TAS ;PRINT OUTSTANDING TA
+1 IF $EXTRACT($GET(IOST),1,2)="C-"
Begin DoDot:1
+2 WRITE !!,"It could take me a while to find all the Travel advances."
+3 WRITE !,"Please stand by."
End DoDot:1
+4 SET ACRDATE=0
+5 FOR
SET ACRDATE=$ORDER(^ACRDOC("DD",ACRDATE))
IF 'ACRDATE!(ACRDATE>ACREND)
QUIT
Begin DoDot:1
+6 ; ACR*2.1*3.21
IF ACRDATE<ACRBEGIN
QUIT
+7 SET ACRDOCDA=0
+8 FOR
SET ACRDOCDA=$ORDER(^ACRDOC("DD",ACRDATE,ACRDOCDA))
IF 'ACRDOCDA
QUIT
IF $DATA(^ACROTA(ACRDOCDA,0))
Begin DoDot:2
+9 SET X=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+10 ;S X=$P($G(^VA(200,+X,0)),U) ;ACR*2.1*19.02 IM16848
+11 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+X)
+12 IF X=""
QUIT
+13 IF $DATA(ACRUNLIQ)
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,8)'="A"!'($PIECE(^ACROTA(ACRDOCDA,0),U,3)-$PIECE(^ACROTA(ACRDOCDA,0),U,4))
QUIT
+14 SET ^TMP("ACRTAS",$JOB,X,ACRDOCDA)=""
End DoDot:2
End DoDot:1
+15 DO TASUMH
+16 SET (ACRTOT1,ACRTOT2)=0
+17 SET ACRX=""
+18 FOR
SET ACRX=$ORDER(^TMP("ACRTAS",$JOB,ACRX))
IF ACRX=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+19 SET ACRDOCDA=0
+20 FOR
SET ACRDOCDA=$ORDER(^TMP("ACRTAS",$JOB,ACRX,ACRDOCDA))
IF 'ACRDOCDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+21 NEW ACRDUZ
+22 DO TAGATHER
+23 DO TASUML
End DoDot:2
+24 DO SUMT
+25 IF $Y+4>IOSL
DO PAUSE^ACRFWARN
IF '$DATA(ACRQUIT)
DO TASUMH
End DoDot:1
+26 DO PAUSE^ACRFWARN
+27 DO TAEXIT
+28 QUIT
SUMT ;TOTALS
+1 IF $GET(ACRTOT1)>$GET(ACRTOT2)
Begin DoDot:1
+2 WRITE ?59,$JUSTIFY($FNUMBER((ACRTOT1-ACRTOT2),"P,",2),10)
+3 WRITE !
End DoDot:1
+4 QUIT
TASUML ;TA SUMMARY LINE
+1 WRITE !,$GET(ACR3),?21,$GET(ACRDOC),?35,$JUSTIFY($FNUMBER($GET(ACR9F),"P,",2),10),?47,$JUSTIFY($FNUMBER($GET(ACR9G),"P,",2),10)
+2 SET ACRTOT1=$GET(ACRTOT1)+$GET(ACR9F)
+3 SET ACRTOT2=$GET(ACRTOT2)+$GET(ACR9G)
+4 QUIT
TASUMH ;TA SUMMARY HDR
+1 WRITE @IOF
+2 WRITE !?5,"Travel Advance Summary Report - OUTSTANDING TRAVEL ADVANCES"
+3 WRITE !?5,"-----------------------------------------------------------"
+4 WRITE !?5,"Date Report Run......: "
+5 SET Y=DT
+6 XECUTE ^DD("DD")
+7 WRITE Y
+8 SET ACRDC=$GET(ACRDC)+1
+9 WRITE ?55,"PAGE: ",ACRDC
+10 WRITE !?10,"Reporting Period From: "
+11 SET Y=ACRBEGIN
+12 XECUTE ^DD("DD")
+13 WRITE Y
+14 WRITE !?10,"Reporting Period To..: "
+15 SET Y=ACREND
+16 XECUTE ^DD("DD")
+17 WRITE Y
+18 WRITE $$DASH^ACRFMENU
+19 WRITE !,?35,"ADVANCE",?47,"LIQUIDATED",?59,"TOTAL"
+20 WRITE !,"TRAVELER",?21,"TRAVEL ORDER",?35,"AMOUNT",?47,"AMOUNT",?59,"OUTSTANDING"
+21 WRITE !,"--------------------",?21,"-------------",?35,"-----------",?47,"-----------",?59,"-----------"
+22 QUIT
TAGATHER ;GATHER TA INFO
+1 IF '$DATA(^ACROTA(ACRDOCDA,0))
SET ACR3="NO TRAVEL ADVANCE ON FILE"
QUIT
+2 NEW X,Y
+3 SET ACRDUZ=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+4 ;S X=$P($G(^VA(200,+ACRDUZ,0)),U) ;ACR*2.1*19.02 IM16848
+5 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+ACRDUZ)
+6 SET ACR3=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")
+7 SET ACR5=$PIECE($GET(^VA(200,+ACRDUZ,.13)),U,2)
+8 SET ACR6=$PIECE($GET(^VA(200,+ACRDUZ,1)),U,9)
+9 SET Y=$GET(^ACRDOC(ACRDOCDA,0))
+10 SET ACR7=$PIECE(Y,U,6)
+11 SET ACR7=$PIECE($GET(^ACRLOCB(+ACR7,0)),U,12)
+12 SET ACR8=$PIECE($GET(^DIC(4,+$PIECE($GET(^ACRAU(+ACRDUZ,1)),U),0)),U)
+13 SET ACRREFX=$ORDER(^AUTTDOCR("B",130,0))
+14 SET ACRDOC=$PIECE(Y,U)
+15 SET ACRFR=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,14)
+16 SET ACRTO=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,15)
+17 IF (U_$GET(^ACRDOC(ACRDOCDA,"TOPCS"))_U)[("^Y^")
SET ACR2="PCS"
+18 IF '$TEST
SET ACR2="TDY"
+19 SET ACR1=$SELECT($PIECE($GET(^ACRAU(+ACRDUZ,19)),U)]"":"EFT",1:"CHECK")
+20 SET ACROTA0=$GET(^ACROTA(ACRDOCDA,0))
+21 SET ACROTA1=$GET(^ACROTA(ACRDOCDA,1))
+22 SET ACR9F=$PIECE(ACROTA0,U,3)
+23 SET ACR9G=$PIECE(ACROTA0,U,4)
+24 DO OUTSTD
+25 SET (ACR31,ACR32,ACR33,ACR34)=""
+26 SET X=0
+27 FOR
SET X=$ORDER(^ACRAPVS("AB",ACRDOCDA,X))
IF 'X
QUIT
Begin DoDot:1
+28 IF $PIECE($GET(^ACRAPVS(X,0)),U,6)=135
IF $PIECE(^(0),U,3)=15
IF $PIECE(^ACRAPVS(X,"DT"),U,4)
Begin DoDot:2
+29 SET ACR10=^ACRAPVS(X,"DT")
+30 SET ACR102=$EXTRACT(ACR10)
+31 SET ACR102=$SELECT($GET(ACR102)="A":"APPROVED BY",$GET(ACR102)="D":"DISAPPROVED",$GET(ACR102)="C":"CANCELLED BY",1:"(NOT YET SIGNED)")
+32 SET Y=$PIECE(ACR10,U,4)
+33 XECUTE ^DD("DD")
+34 SET ACR101=Y
+35 SET ACR10=$SELECT($PIECE(ACR10,U,6):$PIECE(ACR10,U,6),1:$PIECE(ACR10,U,2))
+36 ;S ACR10=$P($G(^VA(200,+ACR10,0)),U) ;ACR*2.1*19.02 IM16848
+37 ;ACR*2.1*19.02 IM16848
SET ACR10=$$NAME2^ACRFUTL1(+ACR10)
+38 SET ACR10=$PIECE($PIECE(ACR10,",",2)," ")_" "_$PIECE(ACR10,",")
End DoDot:2
+39 IF $PIECE($GET(^ACRAPVS(X,0)),U,6)=35
Begin DoDot:2
+40 IF $PIECE($GET(^ACRAPVS(X,"DT")),U,2)=ACRDUZ
IF $PIECE(^("DT"),U,4)
SET ACR31=$PIECE(^("DT"),U,6)
SET ACR32=$PIECE(^("DT"),U,4)
+41 IF $PIECE($GET(^ACRAPVS(X,"DT")),U,5)="Y"
IF $PIECE(^("DT"),U,4)
SET ACR33=$PIECE(^("DT"),U,6)
SET ACR34=$PIECE(^("DT"),U,4)
End DoDot:2
End DoDot:1
+42 IF ACR33
Begin DoDot:1
+43 ;S ACR33=$P($G(^VA(200,ACR33,0)),U) ;ACR*2.1*19.02 IM16848
+44 ;ACR*2.1*19.02 IM16848
SET ACR33=$$NAME2^ACRFUTL1(ACR33)
+45 SET ACR33=$PIECE($PIECE(ACR33,",",2)," ")_" "_$PIECE(ACR33,",")
+46 SET Y=ACR34
+47 XECUTE ^DD("DD")
+48 SET ACR34=Y
End DoDot:1
+49 IF ACR31
IF ACR31'=ACRDUZ
Begin DoDot:1
+50 ;S X=$P($G(^VA(200,+ACR31,0)),U) ;ACR*2.1*19.02 IM16848
+51 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+ACR31)
+52 SET ACR31=" (by "_$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")_")"
End DoDot:1
IF 1
+53 IF '$TEST
SET ACR31=""
+54 SET Y=ACR32
+55 XECUTE ^DD("DD")
+56 SET ACR32=Y
+57 QUIT
OTAEMP ;EP;REVIEW TA
+1 DO EMP1^ACRFAU
+2 IF '$GET(ACRDUZ)
KILL ACRQUIT
QUIT
+3 WRITE !
+4 DO ^ACRFDATE
+5 IF '$GET(ACRBEGIN)
QUIT
+6 IF $DATA(ACRQUIT)
QUIT
+7 DO UNLIQ
+8 IF $DATA(ACRQUIT)
QUIT
+9 SET (ACRRTN,ZTRTN)="OTASUM^ACRFTA"
+10 SET ZTDESC="EMPLOYEE TRAVEL ADVANCE SUMMARY"
+11 DO ^ACRFZIS
+12 QUIT
EDIT ;EDIT TA
+1 FOR
DO E1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
E1 DO SELDOC
E11 ;EP;EDIT TRAVEL ADVANCE
+1 IF '$GET(ACRDOCDA)
SET ACRQUIT=""
QUIT
+2 SET DA=ACRDOCDA
+3 SET DIE="^ACROTA("
+4 ;ACR*2.1*5.10
SET DR=".03TRAVEL ADVANCE AMNT."
+5 ;ACR*2.1*5.10
DO DIE^ACRFDIC
+6 ;ACR*2.1*5.10
IF $DATA(ACRTAED)
DO E12
+7 ;ACR*2.1*5.10
SET ACRADV=$PIECE($GET(^ACROTA(ACRDOCDA,0)),U,3)
+8 ;ACR*2.1*5.10
DO ETA^ACRFSSA1
+9 QUIT
E12 ;Local entry; LIQUIDATE TRAVEL ADVANCE ;ACR*2.1*5.10
+1 ;ACR*2.1*5.10
SET DA=ACRDOCDA
+2 ;ACR*2.1*5.10
SET DIE="^ACROTA("
+3 ;ACR*2.1*5.10
SET ACRADV=$PIECE($GET(^ACROTA(ACRDOCDA,0)),U,3)
+4 ;ACR*2.1*5.10
SET DR=".04//"_ACRADV
+5 ;ACR*2.1*5.10
DO DIE^ACRFDIC
+6 ;ACR*2.1*5.10
QUIT
DELETE ;DELETE TA
+1 DO SELDOC
+2 IF '$GET(ACRDOCDA)
QUIT
+3 SET DIR(0)="YO"
+4 SET DIR("A",1)="Are you certain you want to delete the"
+5 SET DIR("A")="TRAVEL ADVANCE for TO "_ACRDOC
+6 SET DIR("B")="NO"
+7 WRITE !
+8 DO DIR^ACRFDIC
+9 IF Y'=1
KILL ACRQUIT
QUIT
+10 SET DA=ACRDOCDA
+11 SET DIK="^ACROTA("
+12 DO DIK^ACRFDIC
+13 DO OTADEL
+14 QUIT
SELDOC ;SELECT TRAVEL ORDER
+1 KILL ACRDOCDA
+2 SET DIC="^ACROTA("
+3 SET DIC(0)="AEMQZ"
+4 SET DIC("A")="Select TRAVEL ORDER: "
+5 WRITE !
+6 DO DIC^ACRFDIC
+7 IF +Y<1
KILL ACRQUIT
QUIT
+8 SET ACRDOCDA=+Y
+9 DO SETDOC^ACRFEA1
+10 QUIT
UNLIQ ;INCLUDE UNLIQUIDATED ADVANCES ONLY
+1 SET DIR(0)="YO"
+2 SET DIR("A")="UNLIQUIDATED Advances Only"
+3 SET DIR("B")="NO"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y=1
SET ACRUNLIQ=""
+7 QUIT
OUTSTD ;EP;TO CHECK FOR OUTSTANDING ADVANCES
+1 NEW X,Y,Z,ACROTA0,ACROTA1,ACRDOCX
+2 IF '$GET(ACRDUZ)!'$GET(ACRDOCDA)
QUIT
+3 SET X=0
+4 FOR
SET X=$ORDER(^ACROTA("C",ACRDUZ,X))
IF 'X
QUIT
IF X'=ACRDOCDA
Begin DoDot:1
+5 SET ACROTA0=$GET(^ACROTA(X,0))
+6 SET ACRDOCX=$PIECE(ACROTA0,U,2)
+7 SET ACR9E=$GET(ACR9E)+$PIECE(^ACROTA(X,0),U,3)-$PIECE(^ACROTA(X,0),U,4)
End DoDot:1
+8 QUIT
+9 SET Z=0
+10 FOR
SET Z=$ORDER(^ACRAPVS("AB",ACRDOCDA,Z))
IF 'Z
QUIT
Begin DoDot:1
+11 IF ACRREFX=$PIECE(^ACRAPVS(Z,0),U,6)
SET ACRQUIT=""
+12 IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+13 SET ACR9E=$GET(ACR9E)+$PIECE(^ACROTA(X,0),U,3)-$PIECE(^ACROTA(X,0),U,4)
+14 SET ACR9E=$GET(ACR9E)+$PIECE(^ACROTA(X,0),U,3)-$PIECE(^ACROTA(X,0),U,4)
End DoDot:1
+15 QUIT
OTA ;EP;PROCESS APPROVAL OF TRAVEL ADVANCE
+1 NEW ACRDUZ
+2 SET ACRDUZ=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+3 IF 'ACRDUZ
QUIT
+4 SET ACRACH=$SELECT($PIECE($GET(^ACRAU(ACRDUZ,19)),U)]"":"B",1:"C")
+5 SET ACRCAN=$PIECE(^ACRDOC(ACRDOCDA,0),U,8)
+6 SET ACRCAN=$PIECE($GET(^ACRPO(+ACRCAN,0)),U,4)
+7 SET ACRCAN=$PIECE($GET(^AUTTACPT(+ACRCAN,0)),U)
+8 IF ACRCAN=""
Begin DoDot:1
+9 WRITE !!,"Purchasing office not properly set up."
+10 DO PAUSE^ACRFWARN
+11 SET ACRQUIT=""
End DoDot:1
QUIT
+12 ; ACR*2.1*3.01
SET ACRCANDA=$PIECE(^ACRDOC(ACRDOCDA,"REQ"),U,10)
+13 IF 'ACRCANDA
Begin DoDot:1
+14 WRITE !!,"CAN not found."
+15 DO PAUSE^ACRFWARN
+16 SET ACRQUIT=""
End DoDot:1
QUIT
+17 SET (ACRREF,ACRREFX)=602
+18 SET ACRREFDA=$ORDER(^AUTTDOCR("B",602,0))
+19 SET DA=ACRDOCDA
+20 SET DIE="^ACROTA("
+21 SET DR="1////"_ACRAPDA
+22 DO DIE^ACRFDIC
+23 KILL ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRAPDA),^TMP("ACRDATA",$JOB,ACRDUZ,ACRJJ),^TMP("ACRALT",$JOB,ACRDUZ,ACRJJ)
+24 ; ACR*2.1*3.01
SET ACROBJDA=$PIECE(^ACRDOC(ACRDOCDA,"REQ"),U,6)
+25 IF 'ACRCANDA!'ACROBJDA!'$PIECE($GET(^ACROTA(ACRDOCDA,0)),U,3)
QUIT
+26 SET ACRIVPAY(ACRCANDA,ACROBJDA)=$PIECE(^ACROTA(ACRDOCDA,0),U,3)
+27 IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,25)'=$PIECE(^ACROTA(ACRDOCDA,0),U,3)
Begin DoDot:1
+28 SET ACRADV=$PIECE(^ACROTA(ACRDOCDA,0),U,3)
+29 DO ETA^ACRFSSA1
End DoDot:1
+30 SET ACRTCODE="06119"
+31 SET ACRPAYDA=DT
+32 KILL ACRLBDT
+33 SET ACRBTYP="T"
+34 DO ^ACRFIV11
+35 KILL ACRIVPAY
+36 QUIT
OTADEL ;EP;DELETE TRAVEL ADVANCE WHEN DISAPPROVED
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACROTA("
+3 SET DR=".03///0;.04///0"
+4 DO DIE^ACRFDIC
+5 SET DA=ACRDOCDA
+6 SET DIE="^ACRDOC("
+7 SET DR="130120///N;130160///0"
+8 DO DIE^ACRFDIC
+9 SET DA=ACRDOCDA
+10 SET DIE="^ACROBL("
+11 SET DR="1000///0"
+12 DO DIE^ACRFDIC
+13 QUIT
