ACRFTV1 ;IHS/OIRM/DSD/THL,AEF - TRAVEL REPORT -CON'T; [ 09/262005 2:53 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
;;CONTINUATION OF ACRFTV
DISPLAY ;EP;TO SETUP TO DISPLAY PAGE AND COLUMN HEADER
;I "^CAN^TDEPT^PO^"'[(U_ACRTVT_U),"NDC"'[$E(ACRTVT) D ;ACR*2.1*19.05 IM16848 -NOT NEEDED
I "GFH"'[$E(ACRTVT) S (ACRFY,ACRALWDA,ACRSSADA,ACRSSA)=""
I "GFH"[$E(ACRTVT) D
. I ACRTVT="G" D ;ACR*2.1*3.24
. . S ACRDEPT=$P($G(^ACRALC(ACRZDA,0)),U,12) ;ACR*2.1*3.24
. . S ACRDT=$G(^ACRALC(ACRZDA,"DT")) ;ACR*2.1*3.24
. I ACRTVT="F" D ;ACR*2.1*3.24
. . S ACRDEPT=$P($G(^ACRLOCB(ACRZDA,0)),U,5) ;ACR*2.1*3.24
. . S ACRDT=$G(^ACRLOCB(ACRZDA,"DT")) ;ACR*2.1*3.24
. I ACRTVT="H" D ;ACR*2.1*3.24
. . S ACRDEPT=$P($G(^ACRALW(ACRZDA,0)),U,12) ;ACR*2.1*3.24
. . S ACRDT=$G(^ACRALW(ACRZDA,"DT")) ;ACR*2.1*3.24
;S:ACRTVT="D" ACRDEPT=$P(^VA(200,ACRTVDA,0),U) ;ACR*2.1*19.02 IM16848
S:ACRTVT="D" ACRDEPT=$$NAME2^ACRFUTL1(ACRTVDA) ;ACR*2.1*19.02 IM16848
S:ACRTVT="TDEPT"!(ACRTVT="PO") ACRDEPT=ACRZDA
S:ACRTVT="C" ACRDEPT=ACRDPTDA
S:"^LOC^RC^AE^"[(U_ACRTVT_U) ACRDEPT="NOT SPECIFIED"
Q
H1 ;EP;TO PRINT PAGE HEADER
Q:$D(ACRQUIT)!$D(ACROUT)
I $E(IOST,1,2)="C-" W @IOF
W !,"TRAVEL REPORT"
S Y=DT
X ^DD("DD")
W ?40,"DATE: ",Y
S ACRPAGE=$G(ACRPAGE)+1
W ?60,"PAGE: ",ACRPAGE
I ACRTVT="CAN"!$D(ACRCANDA) D
.S:ACRTVT="CAN" ACRCANDA=ACRZDA
.W !!,"Report for CAN: ",$P(^AUTTCAN(ACRCANDA,0),U)
I ACRTVT'="CAN","ND"'[$E(ACRTVT) D
.W !,"-----------------------"
.W ?40,"----------------"
.W ?60,"-------"
.I $G(ACRSSA)]""&$G(ACRALWDA) D ;ACR*2.1*3.24
..W !,"SUB-SUB ACT: ",ACRSSA
..W ?50,"ALLOWANCE: ",$P(^AUTTALLW(ACRALWDA,0),U)
.I ACRTVT'="PO" W !,"DEPARTMENT.: ",$S(ACRTVT="F"!(ACRTVT="TDEPT")!(ACRTVT="C"):$P(^AUTTPRG(ACRDEPT,0),U)_" ("_ACRDEPT_")",1:ACRDEPT)
.I ACRTVT="PO" W !,"PURCHASING OFFICE: ",$P(^DIC(4,+$G(^ACRPO(ACRDEPT,0)),0),U)," (",ACRDEPT,")"
.W:$G(ACRFY)]"" ?50,"FY.......: ",$G(ACRFY) ;ACR*2.1*3.24
I ACRTVT="RC" D
.W !!,"TRAVEL ORDERS WITH RENTAL VEHICLE"
.W !
I ACRTVT="LOC" D
.W !!,"TRAVEL ORDERS TO SELECTED LOCATION: ",$P($G(^ACRPD(+$G(ACRLOC),0)),U)
.W !
I ACRTVT="AE" W !!,"TRAVEL ORDERS WHERE ACTUAL EXPENSES CLAIMED"
I ACRTVT="NCC" W !!,"TRAVEL ORDERS ON WHICH A NON-CONTRACT CARRIER WAS USED"
I ACRTVT="D" D
.W !!
.W:'$D(ACRDTAIL) "SUMMARY FOR "
.W "TRAVELER: ",ACRDEPT
S Y=ACRBEGIN
X ^DD("DD")
W !,"FOR TRAVEL BETWEEN..: ",Y
S Y=ACREND
X ^DD("DD")
W " AND: ",Y
H11 W:$D(ACRDTAIL) $$DASH^ACRFMENU
Q
H2 W !,"------"
W ?25,"---------------"
W ?42,"---------------"
W ?59,"---------------"
W !?27,"OBLIGATIONS"
W ?46,"PENDING"
W !?29,"TO DATE"
W ?44,"OBLIGATIONS"
H3 W !,"------"
W ?25,"---------------"
W ?42,"---------------"
W ?59,"---------------"
Q
CAN ;EP;TO SELECT CAN FOR TV
S DIC="^AUTTCAN("
S DIC(0)="AEMQ"
S DIC("A")="Which CAN NO.: "
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRZDA=+Y
S DIR(0)="FOA^4:4"
S DIR("A")="Fiscal Year..: "
W !
D DIR^ACRFDIC
I Y'?4N S ACRQUIT="" Q
S ACRFY=Y
Q
DEPT ;EP;TO SELECT DEPARTMENT
I ACRTVT="TDEPT" D
.S DIC="^AUTTPRG("
.S DIC(0)="AEMQ"
.S DIC("A")="Which DEPARTMENT/PROGRAM: "
I ACRTVT="PO" D
.S DIC="^ACRPO("
.S DIC(0)="AEMQ"
.S DIC("A")="Which PURCHASING OFFICE: "
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRZDA=+Y
Q
C1 ;EP;
S DIR(0)="YO"
S DIR("A")="Print report for a specific CAN"
S DIR("B")="NO"
K ACRCANDA
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I ACRY=1 D
.S ACRZZDA=ACRZDA
.D CAN
.Q:$D(ACRQUIT)!$D(ACROUT)
.S ACRCANDA=ACRZDA
.S ACRZDA=ACRZZDA
.K ACRZZDA
Q
PDEPT ;EP;
K ^TMP("ACRTV",$J)
S ACRXREF=ACRTVT
S ACRDPTDA=ACRZDA
S ACRZDA=0
S (ACRREQ,ACROBL,ACRSPT)=0
F S ACRZDA=$O(^ACRDOC(ACRXREF,ACRDPTDA,ACRZDA)) Q:'ACRZDA D
.Q:'$D(^ACRDOC(ACRZDA,"TO"))
.S ACRTO=^ACRDOC(ACRZDA,"TO")
.S ACRFR=$P(ACRTO,U,14)
.S ACRTO=$P(ACRTO,U,15)
.I ACRFR>(ACRBEGIN-1),ACRTO<(ACREND+1) D
..I $D(ACRINCMP) D I $D(ACRQUIT) K ACRQUIT Q
...S ACRDOCDA=ACRZDA
...D INCOMP^ACRFTV3
..S:'$D(ACRTVTX) ACRTVTX=ACRTVT
..S ACRTVT="C"
..I $D(ACRBOTH) N ACRDTAIL S ACRDTAIL=""
..D SS4^ACRFTV3
S ACRZDA=ACRDPTDA
S ACRTVT=$S($G(ACRTVTX)]"":ACRTVTX,1:"TDEPT")
K ACRZZDA,ACRTVTX
D SS1^ACRFTV2
D PAUSE^ACRFWARN
W:$D(ACRDTAIL) @IOF
Q
SS2 ;EP;TO PRINT DETAILED LISTING OF EACH TRAVEL ORDER
D H1,SS3
S ACROBJ=$S($G(ACRDTL1):"",1:"ALL")
S ACRX=""
F S ACRX=$O(^TMP("ACRTV",$J,ACR,ACRX)) Q:ACRX=""!$D(ACRQUIT)!$D(ACROUT) S ACR0=^(ACRX) D
.I ACR'="ALL",ACROBJ'="ALL",ACROBJ'=ACR D
..S ACROBJ=ACR
..W !?10,"Object Code: ",ACROBJ
.F ACRI=1:1:6,11:1:14,21 S @("ACR"_ACRI)=$P(ACR0,U,ACRI)
.W !,$E(ACR1,4,7),$E(ACR1,2,3)
.W ?7,ACR2
.W ?22,ACR3
.W ?50,$J($FN(ACR5,"P,",2),15)
.W ?64,$J($FN(ACR6,"P,",2),15)
.I ION>80 W ?80,$J($FN(ACR21,"P,",2),15)
.W !,$E(ACR11,4,7),$E(ACR11,2,3)
.W ?7,$S(ACRTVT="D":ACR14,1:$P(ACR0,U,10))
.;I ACR13,ACRTVT'="D" W ?22,$E($P(^VA(200,ACR13,0),U),1,28) ;ACR*2.1*19.02 IM16848
.I ACR13,ACRTVT'="D" W ?22,$E($$NAME2^ACRFUTL1(ACR13),1,28) ;ACR*2.1*19.02 IM16848
.I ACR12]"",ACRTVT="D" W ?22,$E(ACR12,1,28)
.I ION<81 W ?65,$J($FN(ACR21,"P,",2),15)
.I $D(^TMP("ACRTV",$J,ACR,ACRX,"SIGS")) S ACRSIGS=^("SIGS") D SIGS
.K ACRSIGS
.I $Y>(IOSL-5) D PAUSE^ACRFWARN W @IOF D:'$D(ACRQUIT) H1,SS3
Q
SS3 ;EP;TO PRINT COLUMN LABELS
Q:$D(ACRQUIT)!$D(ACROUT)
I $D(ACRDTAIL) D
.W !,"BEGIN"
.W:ION<81 ?68,"OBLIGATED"
.W !,"END"
.W ?7,"DOCUMENT NO."
.W ?22,"PURPOSE OF TRAVEL/",$S(ACRTVT'="D":"TRAVELER",1:"DESTINATION")
.W ?53,"REQUESTED"
I '$D(ACRDTAIL) D
.W !
.W:ION<81 ?68,"OBLIGATED"
.W !?53,"REQUESTED"
I ION>80 D
.W ?68,"OBLIGATED"
.W ?84,"SPENT"
W:ION<81 ?68,"SPENT"
W $$DASH^ACRFMENU
Q
SIGS ;CHECK EACH DOCUMENT IF ONLY INCOMPLETE TV'S ARE BEING REPORTED
S ACRY=$P(ACR0,U,11)
F ACRI=1:1:6 S ACRD=$P($P(ACRSIGS,U,ACRI),".") D DD
S ACRSIGS=""
W $$DASH^ACRFMENU
Q
DD W:ACRI=1 !?7,"TO TRAVELER..: "
W:ACRI=2 !?7,"TRAVELER SIG.: "
I ACRD]"" D
.W:ACRI=3 !?7,"RECOMMEND SIG: "
.W:ACRI=4 !?7,"APPROVER SIG.: "
W:ACRI=5 !?7,"AUDITOR SIG..: "
W:ACRI=6 !?7,"CERTIFIER SIG: "
S:'$D(ACRSIGT(ACRI)) ACRSIGT(ACRI)=0
Q:ACRD=""
W $E(ACRD,4,5),"-",$E(ACRD,6,7),"-",$E(ACRD,2,3)
S X1=ACRD,X2=ACRY
D ^%DTC
W " (",$J(X,2),")"
S ACRY=ACRD
S $P(ACRSIGT(ACRI),U)=$P(ACRSIGT(ACRI),U)+1
S $P(ACRSIGT(ACRI),U,2)=$P(ACRSIGT(ACRI),U,2)+X
Q
ACRFTV1 ;IHS/OIRM/DSD/THL,AEF - TRAVEL REPORT -CON'T; [ 09/262005 2:53 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFTV
DISPLAY ;EP;TO SETUP TO DISPLAY PAGE AND COLUMN HEADER
+1 ;I "^CAN^TDEPT^PO^"'[(U_ACRTVT_U),"NDC"'[$E(ACRTVT) D ;ACR*2.1*19.05 IM16848 -NOT NEEDED
+2 IF "GFH"'[$EXTRACT(ACRTVT)
SET (ACRFY,ACRALWDA,ACRSSADA,ACRSSA)=""
+3 IF "GFH"[$EXTRACT(ACRTVT)
Begin DoDot:1
+4 ;ACR*2.1*3.24
IF ACRTVT="G"
Begin DoDot:2
+5 ;ACR*2.1*3.24
SET ACRDEPT=$PIECE($GET(^ACRALC(ACRZDA,0)),U,12)
+6 ;ACR*2.1*3.24
SET ACRDT=$GET(^ACRALC(ACRZDA,"DT"))
End DoDot:2
+7 ;ACR*2.1*3.24
IF ACRTVT="F"
Begin DoDot:2
+8 ;ACR*2.1*3.24
SET ACRDEPT=$PIECE($GET(^ACRLOCB(ACRZDA,0)),U,5)
+9 ;ACR*2.1*3.24
SET ACRDT=$GET(^ACRLOCB(ACRZDA,"DT"))
End DoDot:2
+10 ;ACR*2.1*3.24
IF ACRTVT="H"
Begin DoDot:2
+11 ;ACR*2.1*3.24
SET ACRDEPT=$PIECE($GET(^ACRALW(ACRZDA,0)),U,12)
+12 ;ACR*2.1*3.24
SET ACRDT=$GET(^ACRALW(ACRZDA,"DT"))
End DoDot:2
End DoDot:1
+13 ;S:ACRTVT="D" ACRDEPT=$P(^VA(200,ACRTVDA,0),U) ;ACR*2.1*19.02 IM16848
+14 ;ACR*2.1*19.02 IM16848
IF ACRTVT="D"
SET ACRDEPT=$$NAME2^ACRFUTL1(ACRTVDA)
+15 IF ACRTVT="TDEPT"!(ACRTVT="PO")
SET ACRDEPT=ACRZDA
+16 IF ACRTVT="C"
SET ACRDEPT=ACRDPTDA
+17 IF "^LOC^RC^AE^"[(U_ACRTVT_U)
SET ACRDEPT="NOT SPECIFIED"
+18 QUIT
H1 ;EP;TO PRINT PAGE HEADER
+1 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 WRITE !,"TRAVEL REPORT"
+4 SET Y=DT
+5 XECUTE ^DD("DD")
+6 WRITE ?40,"DATE: ",Y
+7 SET ACRPAGE=$GET(ACRPAGE)+1
+8 WRITE ?60,"PAGE: ",ACRPAGE
+9 IF ACRTVT="CAN"!$DATA(ACRCANDA)
Begin DoDot:1
+10 IF ACRTVT="CAN"
SET ACRCANDA=ACRZDA
+11 WRITE !!,"Report for CAN: ",$PIECE(^AUTTCAN(ACRCANDA,0),U)
End DoDot:1
+12 IF ACRTVT'="CAN"
IF "ND"'[$EXTRACT(ACRTVT)
Begin DoDot:1
+13 WRITE !,"-----------------------"
+14 WRITE ?40,"----------------"
+15 WRITE ?60,"-------"
+16 ;ACR*2.1*3.24
IF $GET(ACRSSA)]""&$GET(ACRALWDA)
Begin DoDot:2
+17 WRITE !,"SUB-SUB ACT: ",ACRSSA
+18 WRITE ?50,"ALLOWANCE: ",$PIECE(^AUTTALLW(ACRALWDA,0),U)
End DoDot:2
+19 IF ACRTVT'="PO"
WRITE !,"DEPARTMENT.: ",$SELECT(ACRTVT="F"!(ACRTVT="TDEPT")!(ACRTVT="C"):$PIECE(^AUTTPRG(ACRDEPT,0),U)_" ("_ACRDEPT_")",1:ACRDEPT)
+20 IF ACRTVT="PO"
WRITE !,"PURCHASING OFFICE: ",$PIECE(^DIC(4,+$GET(^ACRPO(ACRDEPT,0)),0),U)," (",ACRDEPT,")"
+21 ;ACR*2.1*3.24
IF $GET(ACRFY)]""
WRITE ?50,"FY.......: ",$GET(ACRFY)
End DoDot:1
+22 IF ACRTVT="RC"
Begin DoDot:1
+23 WRITE !!,"TRAVEL ORDERS WITH RENTAL VEHICLE"
+24 WRITE !
End DoDot:1
+25 IF ACRTVT="LOC"
Begin DoDot:1
+26 WRITE !!,"TRAVEL ORDERS TO SELECTED LOCATION: ",$PIECE($GET(^ACRPD(+$GET(ACRLOC),0)),U)
+27 WRITE !
End DoDot:1
+28 IF ACRTVT="AE"
WRITE !!,"TRAVEL ORDERS WHERE ACTUAL EXPENSES CLAIMED"
+29 IF ACRTVT="NCC"
WRITE !!,"TRAVEL ORDERS ON WHICH A NON-CONTRACT CARRIER WAS USED"
+30 IF ACRTVT="D"
Begin DoDot:1
+31 WRITE !!
+32 IF '$DATA(ACRDTAIL)
WRITE "SUMMARY FOR "
+33 WRITE "TRAVELER: ",ACRDEPT
End DoDot:1
+34 SET Y=ACRBEGIN
+35 XECUTE ^DD("DD")
+36 WRITE !,"FOR TRAVEL BETWEEN..: ",Y
+37 SET Y=ACREND
+38 XECUTE ^DD("DD")
+39 WRITE " AND: ",Y
H11 IF $DATA(ACRDTAIL)
WRITE $$DASH^ACRFMENU
+1 QUIT
H2 WRITE !,"------"
+1 WRITE ?25,"---------------"
+2 WRITE ?42,"---------------"
+3 WRITE ?59,"---------------"
+4 WRITE !?27,"OBLIGATIONS"
+5 WRITE ?46,"PENDING"
+6 WRITE !?29,"TO DATE"
+7 WRITE ?44,"OBLIGATIONS"
H3 WRITE !,"------"
+1 WRITE ?25,"---------------"
+2 WRITE ?42,"---------------"
+3 WRITE ?59,"---------------"
+4 QUIT
CAN ;EP;TO SELECT CAN FOR TV
+1 SET DIC="^AUTTCAN("
+2 SET DIC(0)="AEMQ"
+3 SET DIC("A")="Which CAN NO.: "
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF +Y<1
SET ACRQUIT=""
QUIT
+7 SET ACRZDA=+Y
+8 SET DIR(0)="FOA^4:4"
+9 SET DIR("A")="Fiscal Year..: "
+10 WRITE !
+11 DO DIR^ACRFDIC
+12 IF Y'?4N
SET ACRQUIT=""
QUIT
+13 SET ACRFY=Y
+14 QUIT
DEPT ;EP;TO SELECT DEPARTMENT
+1 IF ACRTVT="TDEPT"
Begin DoDot:1
+2 SET DIC="^AUTTPRG("
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Which DEPARTMENT/PROGRAM: "
End DoDot:1
+5 IF ACRTVT="PO"
Begin DoDot:1
+6 SET DIC="^ACRPO("
+7 SET DIC(0)="AEMQ"
+8 SET DIC("A")="Which PURCHASING OFFICE: "
End DoDot:1
+9 WRITE !
+10 DO DIC^ACRFDIC
+11 IF +Y<1
SET ACRQUIT=""
QUIT
+12 SET ACRZDA=+Y
+13 QUIT
C1 ;EP;
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Print report for a specific CAN"
+3 SET DIR("B")="NO"
+4 KILL ACRCANDA
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+8 IF ACRY=1
Begin DoDot:1
+9 SET ACRZZDA=ACRZDA
+10 DO CAN
+11 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 SET ACRCANDA=ACRZDA
+13 SET ACRZDA=ACRZZDA
+14 KILL ACRZZDA
End DoDot:1
+15 QUIT
PDEPT ;EP;
+1 KILL ^TMP("ACRTV",$JOB)
+2 SET ACRXREF=ACRTVT
+3 SET ACRDPTDA=ACRZDA
+4 SET ACRZDA=0
+5 SET (ACRREQ,ACROBL,ACRSPT)=0
+6 FOR
SET ACRZDA=$ORDER(^ACRDOC(ACRXREF,ACRDPTDA,ACRZDA))
IF 'ACRZDA
QUIT
Begin DoDot:1
+7 IF '$DATA(^ACRDOC(ACRZDA,"TO"))
QUIT
+8 SET ACRTO=^ACRDOC(ACRZDA,"TO")
+9 SET ACRFR=$PIECE(ACRTO,U,14)
+10 SET ACRTO=$PIECE(ACRTO,U,15)
+11 IF ACRFR>(ACRBEGIN-1)
IF ACRTO<(ACREND+1)
Begin DoDot:2
+12 IF $DATA(ACRINCMP)
Begin DoDot:3
+13 SET ACRDOCDA=ACRZDA
+14 DO INCOMP^ACRFTV3
End DoDot:3
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+15 IF '$DATA(ACRTVTX)
SET ACRTVTX=ACRTVT
+16 SET ACRTVT="C"
+17 IF $DATA(ACRBOTH)
NEW ACRDTAIL
SET ACRDTAIL=""
+18 DO SS4^ACRFTV3
End DoDot:2
End DoDot:1
+19 SET ACRZDA=ACRDPTDA
+20 SET ACRTVT=$SELECT($GET(ACRTVTX)]"":ACRTVTX,1:"TDEPT")
+21 KILL ACRZZDA,ACRTVTX
+22 DO SS1^ACRFTV2
+23 DO PAUSE^ACRFWARN
+24 IF $DATA(ACRDTAIL)
WRITE @IOF
+25 QUIT
SS2 ;EP;TO PRINT DETAILED LISTING OF EACH TRAVEL ORDER
+1 DO H1
DO SS3
+2 SET ACROBJ=$SELECT($GET(ACRDTL1):"",1:"ALL")
+3 SET ACRX=""
+4 FOR
SET ACRX=$ORDER(^TMP("ACRTV",$JOB,ACR,ACRX))
IF ACRX=""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
SET ACR0=^(ACRX)
Begin DoDot:1
+5 IF ACR'="ALL"
IF ACROBJ'="ALL"
IF ACROBJ'=ACR
Begin DoDot:2
+6 SET ACROBJ=ACR
+7 WRITE !?10,"Object Code: ",ACROBJ
End DoDot:2
+8 FOR ACRI=1:1:6,11:1:14,21
SET @("ACR"_ACRI)=$PIECE(ACR0,U,ACRI)
+9 WRITE !,$EXTRACT(ACR1,4,7),$EXTRACT(ACR1,2,3)
+10 WRITE ?7,ACR2
+11 WRITE ?22,ACR3
+12 WRITE ?50,$JUSTIFY($FNUMBER(ACR5,"P,",2),15)
+13 WRITE ?64,$JUSTIFY($FNUMBER(ACR6,"P,",2),15)
+14 IF ION>80
WRITE ?80,$JUSTIFY($FNUMBER(ACR21,"P,",2),15)
+15 WRITE !,$EXTRACT(ACR11,4,7),$EXTRACT(ACR11,2,3)
+16 WRITE ?7,$SELECT(ACRTVT="D":ACR14,1:$PIECE(ACR0,U,10))
+17 ;I ACR13,ACRTVT'="D" W ?22,$E($P(^VA(200,ACR13,0),U),1,28) ;ACR*2.1*19.02 IM16848
+18 ;ACR*2.1*19.02 IM16848
IF ACR13
IF ACRTVT'="D"
WRITE ?22,$EXTRACT($$NAME2^ACRFUTL1(ACR13),1,28)
+19 IF ACR12]""
IF ACRTVT="D"
WRITE ?22,$EXTRACT(ACR12,1,28)
+20 IF ION<81
WRITE ?65,$JUSTIFY($FNUMBER(ACR21,"P,",2),15)
+21 IF $DATA(^TMP("ACRTV",$JOB,ACR,ACRX,"SIGS"))
SET ACRSIGS=^("SIGS")
DO SIGS
+22 KILL ACRSIGS
+23 IF $Y>(IOSL-5)
DO PAUSE^ACRFWARN
WRITE @IOF
IF '$DATA(ACRQUIT)
DO H1
DO SS3
End DoDot:1
+24 QUIT
SS3 ;EP;TO PRINT COLUMN LABELS
+1 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 IF $DATA(ACRDTAIL)
Begin DoDot:1
+3 WRITE !,"BEGIN"
+4 IF ION<81
WRITE ?68,"OBLIGATED"
+5 WRITE !,"END"
+6 WRITE ?7,"DOCUMENT NO."
+7 WRITE ?22,"PURPOSE OF TRAVEL/",$SELECT(ACRTVT'="D":"TRAVELER",1:"DESTINATION")
+8 WRITE ?53,"REQUESTED"
End DoDot:1
+9 IF '$DATA(ACRDTAIL)
Begin DoDot:1
+10 WRITE !
+11 IF ION<81
WRITE ?68,"OBLIGATED"
+12 WRITE !?53,"REQUESTED"
End DoDot:1
+13 IF ION>80
Begin DoDot:1
+14 WRITE ?68,"OBLIGATED"
+15 WRITE ?84,"SPENT"
End DoDot:1
+16 IF ION<81
WRITE ?68,"SPENT"
+17 WRITE $$DASH^ACRFMENU
+18 QUIT
SIGS ;CHECK EACH DOCUMENT IF ONLY INCOMPLETE TV'S ARE BEING REPORTED
+1 SET ACRY=$PIECE(ACR0,U,11)
+2 FOR ACRI=1:1:6
SET ACRD=$PIECE($PIECE(ACRSIGS,U,ACRI),".")
DO DD
+3 SET ACRSIGS=""
+4 WRITE $$DASH^ACRFMENU
+5 QUIT
DD IF ACRI=1
WRITE !?7,"TO TRAVELER..: "
+1 IF ACRI=2
WRITE !?7,"TRAVELER SIG.: "
+2 IF ACRD]""
Begin DoDot:1
+3 IF ACRI=3
WRITE !?7,"RECOMMEND SIG: "
+4 IF ACRI=4
WRITE !?7,"APPROVER SIG.: "
End DoDot:1
+5 IF ACRI=5
WRITE !?7,"AUDITOR SIG..: "
+6 IF ACRI=6
WRITE !?7,"CERTIFIER SIG: "
+7 IF '$DATA(ACRSIGT(ACRI))
SET ACRSIGT(ACRI)=0
+8 IF ACRD=""
QUIT
+9 WRITE $EXTRACT(ACRD,4,5),"-",$EXTRACT(ACRD,6,7),"-",$EXTRACT(ACRD,2,3)
+10 SET X1=ACRD
SET X2=ACRY
+11 DO ^%DTC
+12 WRITE " (",$JUSTIFY(X,2),")"
+13 SET ACRY=ACRD
+14 SET $PIECE(ACRSIGT(ACRI),U)=$PIECE(ACRSIGT(ACRI),U)+1
+15 SET $PIECE(ACRSIGT(ACRI),U,2)=$PIECE(ACRSIGT(ACRI),U,2)+X
+16 QUIT
