ACRFTA.m

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)