ACRFSS43.m

ACRFSS43 ;IHS/OIRM/DSD/THL,AEF - CONTINUATION OF ACRFSS4;  [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;CONTINUATION OF ACRFSS4

DELETE ;EP;DELETE TRAVEL DAYS

 S DIR(0)="LO^1:"_ACRJ

 S DIR("A")="Which DAY(s)"

 W !

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)!(+$G(Y)<1)

 S ACRDEL=Y

 S DIR(0)="YO"

 S DIR("A")="Sure you want to delete travel day(s) "_$E(Y,1,$L(Y)-1)_" "

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 Q:Y'=1

 F ACRI=1:1 S ACRYY=$P(ACRDEL,",",ACRI) Q:ACRYY=""  D DTV1:$D(^TMP("ACRTV",$J,ACRYY))

 K ACRDEL

 Q

DTV1 S DA=+^TMP("ACRTV",$J,ACRYY)

 S DIK="^ACRTV("

 D DIK^ACRFDIC

 S ACRCHANG=""

 K ^TMP("ACRTV",$J,ACRYY)

 Q

CHK1 ;SET VARIABLES FOR TRAVEL DAY DATA BEFORE DAY IS EDITED

 S ^TMP("ACRTV",$J,"CHK",ACRTVDA)=^ACRTV(ACRTVDA,0)_"&&&&"_^ACRTV(ACRTVDA,"DT")

 Q

CHK2 ;COMPARE TRAVEL DAY INFO AFTER IT IS EDITED

 Q:'ACRTVDA

 Q:'$D(^ACRTV(ACRTVDA,0))

 S X=^ACRTV(ACRTVDA,0)_"&&&&"_^ACRTV(ACRTVDA,"DT")

 I ^TMP("ACRTV",$J,"CHK",ACRTVDA)'=X S ACRCHANG=""

 Q

DESTIN ;EP;TO SELECT AUTHORIZED DESTINATIONS FOR A TRAVEL ORDER

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR="[ACR TRAVEL DESTINATION]"

 I $D(ACRREV) S ACRSCREN=""

 E  D DDS^ACRFDIC

 I '$D(ACRSCREN) D IDEN Q

 K ACRSCREN

 F ACRI=1:1 D D1 Q:$D(ACRQUIT)!$D(ACROUT)!$D(ACRREV)

 K ACRQUIT

 Q

D1 W @IOF

 D ITIN

 I $D(ACRREV) D PAUSE^ACRFWARN K ACRQUIT Q

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR="1301T"

 W !

 D DIE^ACRFDIC

 I '$O(^ACRDOC(ACRDOCDA,9,0)) D

 .S (ACRI,Y)=1

 .D D1A

 .W @IOF

 .D ITIN

 S DIR(0)="SO^1:Edit Mode of Travel;2:Add Authorized Destination;3:Delete Authorized Destination"

 S DIR("A")="Which one"

 W !

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)!(+$G(Y)<1)

 I Y=2 D  Q

 .W !

 .D D1A

 I 13[Y D

 .S ACRDEST=$S(Y=1:"EDIT",1:"DELETE")

 .D DELDEST

 .K ACRDEST

 Q

D1A ;ADD TRAVEL TO DESTINATION

 S:'$D(^ACRDOC(ACRDOCDA,9,0))#2 ^ACRDOC(ACRDOCDA,9,0)="^9002196.901P"

 S DIC="^ACRPD("

 S DIC(0)="AEMQZ"

 S DIC("A")=$S(ACRI=1:"TRAVEL AUTHORIZED TO: ",1:"AND ALSO TO.........: ")

 D DIC^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!(+$G(Y)<1) D  K ACRDESTN,ACRQUIT Q

 .K ACRDESTN

 .S X=0

 .F  S X=$O(^ACRDOC(ACRDOCDA,9,X)) Q:'X  I $D(^(X,0)) S ACRDESTN="" Q

 .I '$D(ACRDESTN)#2 D

 ..W *7,*7

 ..W !!,"No AUTHORIZED DESTINATIONS have been entered."

 ..W !,"You will not be able to add any TRAVEL DAYS unless an AUTHORIZED DESTINATION"

 ..W !,"is entered."

 ..D PAUSE^ACRFWARN

 I $D(^ACRDOC(ACRDOCDA,9,"B",+Y)) S Y=$O(^(+Y,0))

 E  D

 .S DA(1)=ACRDOCDA

 .S DIC="^ACRDOC("_ACRDOCDA_",9,"

 .S DIC(0)="L"

 .S X=+Y

 .D FILE^ACRFDIC

 S DA=+Y

D1E ;EDIT TRAVEL TO DESTINATION

 S DA(1)=ACRDOCDA

 S DIE="^ACRDOC("_ACRDOCDA_",9,"

 S DR="S ACRTM=$P(^ACRDOC(ACRDOCDA,9,DA,0),U,3);.02T;S:X'=4&(ACRTM="""") Y=""@1"";.03T;@1"

 W !

 D DIE^ACRFDIC

 W !

 D IDEN

 Q

DELDEST ;EP;TO DELETE A TRAVEL DESTINATION

 D DESTLIST

 S DIR(0)="LO^1:"_ACRK

 S DIR("A")=ACRDEST_" which TRAVEL DESTINATION(s)"

 W !

 D DIR^ACRFDIC

 I '+$G(ACRY) K ACRQUIT Q

 F ACRJ=1:1 S ACRX=$P(ACRY,",",ACRJ) Q:ACRX=""  D

 .S DA=ACRX(ACRX)

 .S (DIE,DIK)="^ACRDOC("_ACRDOCDA_",9,"

 .S DA(1)=ACRDOCDA

 .D ^DIK:ACRDEST="DELETE"

 .I ACRDEST="EDIT" D D1E

 Q

DESTLIST ;

 W !

 S (ACRX,ACRK)=0

 F  S ACRX=$O(^ACRDOC(ACRDOCDA,9,ACRX)) Q:'ACRX  D

 .I $D(^ACRDOC(ACRDOCDA,9,ACRX,0)) S Y=^(0) D

 ..I $D(^ACRPD(+Y,0)) D

 ...S Z=$P(^ACRPD(+Y,0),U)

 ...S ACRK=ACRK+1

 ...S ACRX(ACRK)=ACRX

 ...W !?10,ACRK

 ...W ?15,Z

 Q

ITIN ;EP;TO DISPLAY CITIES TO WHICH TRAVEL IS AUTHORIZED

 Q:$D(ACROUT)

 Q:'$D(^ACRDOC(ACRDOCDA,9,0))&'$D(^ACRDOC(ACRDOCDA,13,0))

 N ACRI

 W !,"|-----------------------------  TRAVEL ITINERARY  -----------------------------|"

 I $D(^ACRDOC(ACRDOCDA,13))#2 N ACRPDDA S ACRPDDA=+^(13) I ACRPDDA,$D(^ACRPD(ACRPDDA,0)) D

 .W !,"|"

 .W ?5,"Travel authorized fr: ",$P(^ACRPD(ACRPDDA,0),U)

 .W ?79,"|"

 S X=0

 F ACRI=1:1 S X=$O(^ACRDOC(ACRDOCDA,9,X)) Q:'X  D

 .S Y=$G(^ACRDOC(ACRDOCDA,9,X,0))

 .I $D(^ACRPD(+Y,0)) S Z=$P(^(0),U) D

 ..W !,"|"

 ..W ?5,$S(ACRI=1:"Travel authorized to",1:"and also to........."),": ",Z," via "

 ..S Z=$P(Y,U,2)

 ..W $S(Z=1:"COMMON CARRIER",Z=2:"POV",Z=3:"COMMON CARRIER & POV",Z=5:"GSA VEHICLE",Z=6:"CHARTER",1:$S($P(Y,U,3)]"":$P(Y,U,3),1:"OTHER"))

 ..W:'$O(^ACRDOC(ACRDOCDA,9,X)) " and return"

 ..W ?79,"|"

 Q

LODGE ;EP;TO DISPLAY THE LODGING AND PER DIEM RATES FOR CITIES TO WHICH THE

 ;TRAVELER IS TRAVELING

 Q:$D(ACROUT)

 N ACR,ACRPD

 S:'$D(D0)&$D(ACRDOCDA) D0=ACRDOCDA

 S ACR=0

 F  S ACR=$O(^ACRTV("D",D0,ACR)) Q:'ACR  D

 .S ACRPD=$P($G(^ACRTV(ACR,"DT")),U,4)

 .I $D(^ACRPD(+ACRPD,0)) S ACRPD=^(0),ACRPD($P(ACRPD,U))=ACRPD

 Q:'$D(ACRPD)

 S ACR=""

 F  S ACR=$O(ACRPD(ACR)) Q:ACR=""  D

 .S ACRPD=ACRPD(ACR)

 .W !,"|"

 .W ?23,$P(ACRPD,U),$S('$P(ACRPD,U,2):"",$D(^DIC(5,$P(ACRPD,U,2),0)):", "_$P(^(0),U,2),1:"")

 .W ?56,$J($FN($P(ACRPD,U,3),"P,",2),10)

 .W ?$X+2,$J($FN($P(ACRPD,U,4),"P,",2),10)

 .W ?79,"|"

 Q

DELAUTO ;EP;TO DELETE RENTAL CAR EXPENSES IF RENTAL CAR IS DENIED

 S:'$D(ACRDOCDA) ACRDOCDA=DA

 Q:'ACRDOCDA

 S ACR=0

 F  S ACR=$O(^ACRTV("D",ACRDOCDA,ACR)) Q:'ACR  D

 .S ACRX=$G(^ACRTV(ACR,"DT"))

 .I $L($P(ACRX,U,13,15))>2!$D(^ACRTV(ACR,"RCJ")) D

 ..S DA=ACR

 ..S DIE="^ACRTV("

 ..S DR="13///@;14///@;15///@;21///@;22///@;23///@;24///@;25///@"

 ..D DIE^ACRFDIC

 Q

IDEN ;EP;TO SET IDENTIFIER FOR TRAVEL ORDER

 Q:'$G(ACRDOCDA)

 Q:$L($P($G(^ACRDOC(ACRDOCDA,0)),U,14))>8

 N X

 S X=$O(^ACRDOC(ACRDOCDA,9,0))

 S X=$P($G(^ACRDOC(ACRDOCDA,9,+X,0)),U)

 Q:'X

 S X=$E($P($G(^ACRPD(X,0)),U),1,6)

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR=".14////"_$P(^ACRDOC(ACRDOCDA,0),U,14)_"/"_X

 D DIE^ACRFDIC

 Q

ACRFSS43  ;IHS/OIRM/DSD/THL,AEF - CONTINUATION OF ACRFSS4;  [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;CONTINUATION OF ACRFSS4

DELETE    ;EP;DELETE TRAVEL DAYS

 +1        SET DIR(0)="LO^1:"_ACRJ

 +2        SET DIR("A")="Which DAY(s)"

 +3        WRITE !

 +4        DO DIR^ACRFDIC

 +5        IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+$GET(Y)<1)

               QUIT 

 +6        SET ACRDEL=Y

 +7        SET DIR(0)="YO"

 +8        SET DIR("A")="Sure you want to delete travel day(s) "_$EXTRACT(Y,1,$LENGTH(Y)-1)_" "

 +9        SET DIR("B")="NO"

 +10       WRITE !

 +11       DO DIR^ACRFDIC

 +12       IF Y'=1

               QUIT 

 +13       FOR ACRI=1:1

               SET ACRYY=$PIECE(ACRDEL,",",ACRI)

               IF ACRYY=""

                   QUIT 

               IF $DATA(^TMP("ACRTV",$JOB,ACRYY))

                   DO DTV1

 +14       KILL ACRDEL

 +15       QUIT 

DTV1       SET DA=+^TMP("ACRTV",$JOB,ACRYY)

 +1        SET DIK="^ACRTV("

 +2        DO DIK^ACRFDIC

 +3        SET ACRCHANG=""

 +4        KILL ^TMP("ACRTV",$JOB,ACRYY)

 +5        QUIT 

CHK1      ;SET VARIABLES FOR TRAVEL DAY DATA BEFORE DAY IS EDITED

 +1        SET ^TMP("ACRTV",$JOB,"CHK",ACRTVDA)=^ACRTV(ACRTVDA,0)_"&&&&"_^ACRTV(ACRTVDA,"DT")

 +2        QUIT 

CHK2      ;COMPARE TRAVEL DAY INFO AFTER IT IS EDITED

 +1        IF 'ACRTVDA

               QUIT 

 +2        IF '$DATA(^ACRTV(ACRTVDA,0))

               QUIT 

 +3        SET X=^ACRTV(ACRTVDA,0)_"&&&&"_^ACRTV(ACRTVDA,"DT")

 +4        IF ^TMP("ACRTV",$JOB,"CHK",ACRTVDA)'=X

               SET ACRCHANG=""

 +5        QUIT 

DESTIN    ;EP;TO SELECT AUTHORIZED DESTINATIONS FOR A TRAVEL ORDER

 +1        SET DA=ACRDOCDA

 +2        SET DIE="^ACRDOC("

 +3        SET DR="[ACR TRAVEL DESTINATION]"

 +4        IF $DATA(ACRREV)

               SET ACRSCREN=""

 +5       IF '$TEST

               DO DDS^ACRFDIC

 +6        IF '$DATA(ACRSCREN)

               DO IDEN

               QUIT 

 +7        KILL ACRSCREN

 +8        FOR ACRI=1:1

               DO D1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)!$DATA(ACRREV)

                   QUIT 

 +9        KILL ACRQUIT

 +10       QUIT 

D1         WRITE @IOF

 +1        DO ITIN

 +2        IF $DATA(ACRREV)

               DO PAUSE^ACRFWARN

               KILL ACRQUIT

               QUIT 

 +3        SET DA=ACRDOCDA

 +4        SET DIE="^ACRDOC("

 +5        SET DR="1301T"

 +6        WRITE !

 +7        DO DIE^ACRFDIC

 +8        IF '$ORDER(^ACRDOC(ACRDOCDA,9,0))

               Begin DoDot:1

 +9                SET (ACRI,Y)=1

 +10               DO D1A

 +11               WRITE @IOF

 +12               DO ITIN

               End DoDot:1

 +13       SET DIR(0)="SO^1:Edit Mode of Travel;2:Add Authorized Destination;3:Delete Authorized Destination"

 +14       SET DIR("A")="Which one"

 +15       WRITE !

 +16       DO DIR^ACRFDIC

 +17       IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+$GET(Y)<1)

               QUIT 

 +18       IF Y=2

               Begin DoDot:1

 +19               WRITE !

 +20               DO D1A

               End DoDot:1

               QUIT 

 +21       IF 13[Y

               Begin DoDot:1

 +22               SET ACRDEST=$SELECT(Y=1:"EDIT",1:"DELETE")

 +23               DO DELDEST

 +24               KILL ACRDEST

               End DoDot:1

 +25       QUIT 

D1A       ;ADD TRAVEL TO DESTINATION

 +1        IF '$DATA(^ACRDOC(ACRDOCDA,9,0))#2

               SET ^ACRDOC(ACRDOCDA,9,0)="^9002196.901P"

 +2        SET DIC="^ACRPD("

 +3        SET DIC(0)="AEMQZ"

 +4        SET DIC("A")=$SELECT(ACRI=1:"TRAVEL AUTHORIZED TO: ",1:"AND ALSO TO.........: ")

 +5        DO DIC^ACRFDIC

 +6        IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+$GET(Y)<1)

               Begin DoDot:1

 +7                KILL ACRDESTN

 +8                SET X=0

 +9                FOR 

                       SET X=$ORDER(^ACRDOC(ACRDOCDA,9,X))

                       IF 'X

                           QUIT 

                       IF $DATA(^(X,0))

                           SET ACRDESTN=""

                           QUIT 

 +10               IF '$DATA(ACRDESTN)#2

                       Begin DoDot:2

 +11                       WRITE *7,*7

 +12                       WRITE !!,"No AUTHORIZED DESTINATIONS have been entered."

 +13                       WRITE !,"You will not be able to add any TRAVEL DAYS unless an AUTHORIZED DESTINATION"

 +14                       WRITE !,"is entered."

 +15                       DO PAUSE^ACRFWARN

                       End DoDot:2

               End DoDot:1

               KILL ACRDESTN,ACRQUIT

               QUIT 

 +16       IF $DATA(^ACRDOC(ACRDOCDA,9,"B",+Y))

               SET Y=$ORDER(^(+Y,0))

 +17      IF '$TEST

               Begin DoDot:1

 +18               SET DA(1)=ACRDOCDA

 +19               SET DIC="^ACRDOC("_ACRDOCDA_",9,"

 +20               SET DIC(0)="L"

 +21               SET X=+Y

 +22               DO FILE^ACRFDIC

               End DoDot:1

 +23       SET DA=+Y

D1E       ;EDIT TRAVEL TO DESTINATION

 +1        SET DA(1)=ACRDOCDA

 +2        SET DIE="^ACRDOC("_ACRDOCDA_",9,"

 +3        SET DR="S ACRTM=$P(^ACRDOC(ACRDOCDA,9,DA,0),U,3);.02T;S:X'=4&(ACRTM="""") Y=""@1"";.03T;@1"

 +4        WRITE !

 +5        DO DIE^ACRFDIC

 +6        WRITE !

 +7        DO IDEN

 +8        QUIT 

DELDEST   ;EP;TO DELETE A TRAVEL DESTINATION

 +1        DO DESTLIST

 +2        SET DIR(0)="LO^1:"_ACRK

 +3        SET DIR("A")=ACRDEST_" which TRAVEL DESTINATION(s)"

 +4        WRITE !

 +5        DO DIR^ACRFDIC

 +6        IF '+$GET(ACRY)

               KILL ACRQUIT

               QUIT 

 +7        FOR ACRJ=1:1

               SET ACRX=$PIECE(ACRY,",",ACRJ)

               IF ACRX=""

                   QUIT 

               Begin DoDot:1

 +8                SET DA=ACRX(ACRX)

 +9                SET (DIE,DIK)="^ACRDOC("_ACRDOCDA_",9,"

 +10               SET DA(1)=ACRDOCDA

 +11               IF ACRDEST="DELETE"

                       DO ^DIK

 +12               IF ACRDEST="EDIT"

                       DO D1E

               End DoDot:1

 +13       QUIT 

DESTLIST  ;

 +1        WRITE !

 +2        SET (ACRX,ACRK)=0

 +3        FOR 

               SET ACRX=$ORDER(^ACRDOC(ACRDOCDA,9,ACRX))

               IF 'ACRX

                   QUIT 

               Begin DoDot:1

 +4                IF $DATA(^ACRDOC(ACRDOCDA,9,ACRX,0))

                       SET Y=^(0)

                       Begin DoDot:2

 +5                        IF $DATA(^ACRPD(+Y,0))

                               Begin DoDot:3

 +6                                SET Z=$PIECE(^ACRPD(+Y,0),U)

 +7                                SET ACRK=ACRK+1

 +8                                SET ACRX(ACRK)=ACRX

 +9                                WRITE !?10,ACRK

 +10                               WRITE ?15,Z

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +11       QUIT 

ITIN      ;EP;TO DISPLAY CITIES TO WHICH TRAVEL IS AUTHORIZED

 +1        IF $DATA(ACROUT)

               QUIT 

 +2        IF '$DATA(^ACRDOC(ACRDOCDA,9,0))&'$DATA(^ACRDOC(ACRDOCDA,13,0))

               QUIT 

 +3        NEW ACRI

 +4        WRITE !,"|-----------------------------  TRAVEL ITINERARY  -----------------------------|"

 +5        IF $DATA(^ACRDOC(ACRDOCDA,13))#2

               NEW ACRPDDA

               SET ACRPDDA=+^(13)

               IF ACRPDDA

                   IF $DATA(^ACRPD(ACRPDDA,0))

                       Begin DoDot:1

 +6                        WRITE !,"|"

 +7                        WRITE ?5,"Travel authorized fr: ",$PIECE(^ACRPD(ACRPDDA,0),U)

 +8                        WRITE ?79,"|"

                       End DoDot:1

 +9        SET X=0

 +10       FOR ACRI=1:1

               SET X=$ORDER(^ACRDOC(ACRDOCDA,9,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +11               SET Y=$GET(^ACRDOC(ACRDOCDA,9,X,0))

 +12               IF $DATA(^ACRPD(+Y,0))

                       SET Z=$PIECE(^(0),U)

                       Begin DoDot:2

 +13                       WRITE !,"|"

 +14                       WRITE ?5,$SELECT(ACRI=1:"Travel authorized to",1:"and also to........."),": ",Z," via "

 +15                       SET Z=$PIECE(Y,U,2)

 +16                       WRITE $SELECT(Z=1:"COMMON CARRIER",Z=2:"POV",Z=3:"COMMON CARRIER & POV",Z=5:"GSA VEHICLE",Z=6:"CHARTER",1:$SELECT($PIECE(Y,U,3)]"":$PIECE(Y,U,3),1:"OTHER"))

 +17                       IF '$ORDER(^ACRDOC(ACRDOCDA,9,X))

                               WRITE " and return"

 +18                       WRITE ?79,"|"

                       End DoDot:2

               End DoDot:1

 +19       QUIT 

LODGE     ;EP;TO DISPLAY THE LODGING AND PER DIEM RATES FOR CITIES TO WHICH THE

 +1       ;TRAVELER IS TRAVELING

 +2        IF $DATA(ACROUT)

               QUIT 

 +3        NEW ACR,ACRPD

 +4        IF '$DATA(D0)&$DATA(ACRDOCDA)

               SET D0=ACRDOCDA

 +5        SET ACR=0

 +6        FOR 

               SET ACR=$ORDER(^ACRTV("D",D0,ACR))

               IF 'ACR

                   QUIT 

               Begin DoDot:1

 +7                SET ACRPD=$PIECE($GET(^ACRTV(ACR,"DT")),U,4)

 +8                IF $DATA(^ACRPD(+ACRPD,0))

                       SET ACRPD=^(0)

                       SET ACRPD($PIECE(ACRPD,U))=ACRPD

               End DoDot:1

 +9        IF '$DATA(ACRPD)

               QUIT 

 +10       SET ACR=""

 +11       FOR 

               SET ACR=$ORDER(ACRPD(ACR))

               IF ACR=""

                   QUIT 

               Begin DoDot:1

 +12               SET ACRPD=ACRPD(ACR)

 +13               WRITE !,"|"

 +14               WRITE ?23,$PIECE(ACRPD,U),$SELECT('$PIECE(ACRPD,U,2):"",$DATA(^DIC(5,$PIECE(ACRPD,U,2),0)):", "_$PIECE(^(0),U,2),1:"")

 +15               WRITE ?56,$JUSTIFY($FNUMBER($PIECE(ACRPD,U,3),"P,",2),10)

 +16               WRITE ?$X+2,$JUSTIFY($FNUMBER($PIECE(ACRPD,U,4),"P,",2),10)

 +17               WRITE ?79,"|"

               End DoDot:1

 +18       QUIT 

DELAUTO   ;EP;TO DELETE RENTAL CAR EXPENSES IF RENTAL CAR IS DENIED

 +1        IF '$DATA(ACRDOCDA)

               SET ACRDOCDA=DA

 +2        IF 'ACRDOCDA

               QUIT 

 +3        SET ACR=0

 +4        FOR 

               SET ACR=$ORDER(^ACRTV("D",ACRDOCDA,ACR))

               IF 'ACR

                   QUIT 

               Begin DoDot:1

 +5                SET ACRX=$GET(^ACRTV(ACR,"DT"))

 +6                IF $LENGTH($PIECE(ACRX,U,13,15))>2!$DATA(^ACRTV(ACR,"RCJ"))

                       Begin DoDot:2

 +7                        SET DA=ACR

 +8                        SET DIE="^ACRTV("

 +9                        SET DR="13///@;14///@;15///@;21///@;22///@;23///@;24///@;25///@"

 +10                       DO DIE^ACRFDIC

                       End DoDot:2

               End DoDot:1

 +11       QUIT 

IDEN      ;EP;TO SET IDENTIFIER FOR TRAVEL ORDER

 +1        IF '$GET(ACRDOCDA)

               QUIT 

 +2        IF $LENGTH($PIECE($GET(^ACRDOC(ACRDOCDA,0)),U,14))>8

               QUIT 

 +3        NEW X

 +4        SET X=$ORDER(^ACRDOC(ACRDOCDA,9,0))

 +5        SET X=$PIECE($GET(^ACRDOC(ACRDOCDA,9,+X,0)),U)

 +6        IF 'X

               QUIT 

 +7        SET X=$EXTRACT($PIECE($GET(^ACRPD(X,0)),U),1,6)

 +8        SET DA=ACRDOCDA

 +9        SET DIE="^ACRDOC("

 +10       SET DR=".14////"_$PIECE(^ACRDOC(ACRDOCDA,0),U,14)_"/"_X

 +11       DO DIE^ACRFDIC

 +12       QUIT