ACRFFF3 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF TRAVEL INFORMATION [ 09/23/2005 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**13,19**;NOV 05, 2001
;
DESC ;----- ROUTINE DESCRIPTION
;;Create Travel Information Flat File
;;
;;This option will gather all travel documents within the
;;specified date range and place them into a UNIX comma
;;delimited flat file which can then be imported into an
;;Access or Excel spreadsheet.
;;
;;Fields included in the flat file are:
;; 1 ASUFAC Code 12 Travel End Date
;; 2 CAN Number 13 Days in Travel
;; 3 Travel Order Number 14 Travel From City
;; 4 Traveler Name 15 Travel From State
;; 5 Official Duty Station 16 Travel To City
;; 6 ODS Area 17 Travel To State
;; 7 Gender 18 Amount Requested
;; 8 Pay Plan 19 Amount Obligated
;; 9 Grade 20 Amount Spent
;; 10 Series 21 Status
;; 11 Travel Begin Date 22 Purpose of Travel
;;$$END
;
EN ;EP -- MAIN ENTRY POINT
;
N ACRDATES,ACRFILE
;
D ^XBKVAR
D HOME^%ZIS
;
D TXT
;
D DATES(.ACRDATES)
Q:$G(ACRDATES)']""
;
D FILE(.ACRFILE)
Q:$G(ACRFILE)']""
;
W " please wait..."
;
D GET(ACRDATES)
;
I '$D(^TMP("ACR",$J,"T")) D Q
. W !!,"No data found"
. D PAUSE^ACRFWARN
;
D UNIX(ACRFILE)
;
;K ^TMP("ACR",$J,"T")
;
D ^%ZISC
;
D PAUSE^ACRFWARN
;
Q
GET(ACRDATES) ;
;----- LOOP THROUGH TRAVEL ORDERS AND PUT DATA INTO ^TMP GLOBAL
;
N ACRDATA,ACRDOCDA,ACRREF,ACRTOREF,ACRTVREF
;
K ^TMP("ACR",$J,"T")
K ^TMP("ACR",$J,"D")
;
S ACRTOREF=$O(^AUTTDOCR("B",130,0))
S ACRTVREF=$O(^AUTTDOCR("B",600,0))
F ACRREF=ACRTOREF,ACRTVREF D
. S ACRDOCDA=0
. F S ACRDOCDA=$O(^ACRDOC("REF",ACRREF,ACRDOCDA)) Q:'ACRDOCDA D
. . S ACRDATA=$G(^ACRDOC(ACRDOCDA,"TO"))
. . Q:$P(ACRDATA,U,14)<$P(ACRDATES,U)
. . Q:$P(ACRDATA,U,14)>$P(ACRDATES,U,2)
. . D ONE(ACRDOCDA,ACRDATES,ACRREF)
Q
ONE(ACRDOCDA,ACRDATES,ACRREF) ;
;----- GATHER DATA FOR ONE DOCUMENT AND PUT INTO ^TMP GLOBAL
;
N ACRDOCNO,ACRTVLR
;
;DOCUMENT NUMBER
S ACRDOCNO=$P($G(^ACRDOC(ACRDOCDA,0)),U)
;
;TRAVELER IEN
S ACRTVLR=$$TVLR(ACRDOCDA)
;
;TRAVEL DAYS
D TDAYS(ACRDOCDA,ACRDOCNO)
;
I $L(ACRDOCNO)>10 D Q ;ADD AMENDMENTS TO ORIGINAL DOCUMENT TOTALS
. D SETAMT(ACRDOCDA,ACRDOCNO)
. D SETTD(ACRDOCNO)
;
D SET(ACRDOCDA,ACRDOCNO,ACRTVLR)
D SETAMT(ACRDOCDA,ACRDOCNO)
D SETTD(ACRDOCNO)
Q
SET(ACRDOCDA,ACRDOCNO,ACRTVLR) ;
;----- SET DATA INTO ^TMP GLOBAL
;
N X
;
S X=$G(^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0))
S $P(X,U)=$$ASUFAC($$LOC(ACRTVLR))
S $P(X,U,2)=$$CAN(ACRDOCDA)
S $P(X,U,3)=ACRDOCNO
S $P(X,U,4)=$$NAME(ACRTVLR)
S $P(X,U,5)=$$ODS(ACRTVLR)
S $P(X,U,6)=$$ODSA(ACRTVLR)
S $P(X,U,7)=$$SEX(ACRTVLR)
S $P(X,U,8)=$$PAYPLAN(ACRTVLR)
S $P(X,U,9)=$$GRADE(ACRTVLR)
S $P(X,U,10)=$$SER(ACRTVLR)
S $P(X,U,14)=$P($$TVLF(ACRDOCDA),U)
S $P(X,U,15)=$P($$TVLF(ACRDOCDA),U,2)
S $P(X,U,16)=$P($$TVLT(ACRDOCDA),U)
S $P(X,U,17)=$P($$TVLT(ACRDOCDA),U,2)
S $P(X,U,21)=$$STAT(ACRDOCDA)
S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0)=X
S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),2,0)=$$PURP(ACRDOCDA)
Q
SETAMT(ACRDOCDA,ACRDOCNO) ;
;----- SET AMOUNTS INTO ^TMP GLOBAL
;
N X
;
S X=$G(^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0))
S $P(X,U,18)=$$DOL^ACRFUTL($P(X,U,18)+$$REQ(ACRDOCDA))
S $P(X,U,19)=$$DOL^ACRFUTL($P(X,U,19)+$$OBL(ACRDOCDA))
S $P(X,U,20)=$$DOL^ACRFUTL($P(X,U,20)+$$SPNT(ACRDOCDA))
S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0)=X
Q
SETTD(ACRDOCNO) ;
;----- SETS 1ST AND LAST TRAVEL DAYS INTO ^TMP GLOBAL
;
N ACRF,ACRL,ACRN,X
;
S X=$G(^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0))
S ACRF=$O(^TMP("ACR",$J,"D",$E(ACRDOCNO,1,10),0))
S ACRL=$O(^TMP("ACR",$J,"D",$E(ACRDOCNO,1,10),9999999),-1)
S ACRN=$$NTDAYS(ACRL,ACRF)
S $P(X,U,11)=$$SLDATE^ACRFUTL(ACRF)
S $P(X,U,12)=$$SLDATE^ACRFUTL(ACRL)
S $P(X,U,13)=ACRN
S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0)=X
Q
UNIX(ACRFILE) ;
;----- WRITE ^TMP GLOBAL TO UNIX FILE
;
N %FILE,ACRCNT,ACRDOCDA,ACROUT,X
Q:'$D(^TMP("ACR",$J,"T"))
D HFS(.ACROUT,.%FILE,ACRFILE)
Q:$G(ACROUT)
U %FILE
S ACRCNT=0
S ACRDOCDA=0
F S ACRDOCDA=$O(^TMP("ACR",$J,"T",ACRDOCDA)) Q:'ACRDOCDA D
. S ACRCNT=$G(ACRCNT)+1
. S X=$G(^TMP("ACR",$J,"T",ACRDOCDA,1,0))
. D WRITE(X)
. S X=$G(^TMP("ACR",$J,"T",ACRDOCDA,2,0))
. D WRITE(X)
. W !
U 0 W !!,ACRCNT_" Records have been put into file "_ACRFILE
D ^%ZISC
H 3
Q
WRITE(X) ;
;----- FORMAT AND WRITE DATA TO UNIX FILE
;
N I,Y
F I=1:1:$L(X,U) D
. S Y=$P(X,U,I)
. W """"
. W Y
. W """"
. W ","
Q
DATES(ACRDATES) ;
;----- ASK DATE RANGE
;
DLOOP ;----- DATE LOOP
;
N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="DO^::E"
S DIR("A")="Start with first TRAVEL BEGIN DATE"
S DIR("?")="The first BEGINNING DATE OF TRAVEL to include in the report"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S ACRBEG=Y
S DIR("A")="End with last TRAVEL BEGIN DATE"
S DIR("?")="The last BEGINNING DATE OF TRAVEL to include in the report"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S ACREND=Y
I ACREND<ACRBEG D G DLOOP
. W *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
S ACRDATES=ACRBEG_U_ACREND
Q
FILE(ACRFILE) ;
;----- ASK FILE NAME
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S ACRFILE=""
S DIR(0)="F"
S DIR("A")="Select OUTPUT FILE NAME"
S DIR("?")="The name of the OUTPUT FILE you want to put the data into"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
S ACRFILE=Y_".csv"
Q
HFS(ACROUT,%FILE,ACRFILE) ;
;----- CREATE AND OPEN FILE
;
N POP,X,Y,ZISH1,ZISH2,ZISH3,ZISH4
S ZISH1="FILE"
;S ZISH2="/usr/ACR/alb/" ;ACR*2.1*13.06 IM14144
S ZISH2=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*13.06 IM14144
S ZISH3=ACRFILE
S ZISH4="W"
D OPEN^%ZISH(ZISH1,ZISH2,ZISH3,ZISH4)
I POP D Q
. W "CANNOT OPEN FILE "_ZISH2_ZISH3
. S ACROUT=1
S %FILE=IO
Q
LOC(X) ;----- RETURNS INTERNAL LOCATION IEN OF TRAVELER OFFICIAL DUTY STATION
;
; X = TRAVELER IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRAU(X,1)),U)
Q Y
ASUFAC(D0) ;
;----- RETURN LOCATION ASUFAC CODE
;
; D0 = LOCATION IEN
;
N Y
S Y=""
I D0 X $G(^DD(9999999.06,.0799,9.2))
S Y=$P($G(Y(9999999.06,.0799,3)),U,10)
Q Y
CAN(X) ;----- RETURN EXTERNAL CAN NUMBER
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,"REQ")),U,10)
I Y S Y=$P($G(^ACRCAN(Y,0)),U)
I Y S Y=$P($G(^AUTTCAN(Y,0)),U)
Q Y
TVLR(X) ;----- RETURN TRAVELER IEN
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,"TO")),U,9)
Q Y
NAME(X) ;----- RETURN EXTERNAL TRAVELER NAME
;
; X = TRAVELER IEN
;
N Y
S Y=""
;I X S Y=$P($G(^VA(200,X,0)),U) ;ACR*2.1*19.02 IM16848
I X S Y=$$NAME2^ACRFUTL1(X) ;ACR*2.1*19.02 IM16848
Q Y
TDAYS(ACRDOCDA,ACRDOCNO) ;
;----- BUILDS TRAVEL DAY ARRAY
;
N X,Y,Z
S Y=""
S X=0
F S X=$O(^ACRTV("D",ACRDOCDA,X)) Q:'X D
. S Z=$P($G(^ACRTV(X,"DT")),U)
. Q:'Z
. S ^TMP("ACR",$J,"D",$E(ACRDOCNO,1,10),Z,0)=$$SLDATE^ACRFUTL(Z)
Q
NTDAYS(X1,X2) ;
;----- RETURN TRAVEL TRAVEL DAYS
;
N %Y,X,Y
S Y=""
D ^%DTC
I %Y S Y=X
Q Y
TVLF(X) ;----- RETURNS EXTERNAL TRAVEL FROM CITY^STATE
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S X=$P($G(^ACRDOC(X,13)),U)
I X S Y=$$CITY(X)
Q Y
TVLT(X) ;----- RETURNS EXTERNAL TRAVEL TO CITY^STATE
;
; X = DOCUMENT IEN
;
N Y,Z
S Y=""
I X S Z=$O(^ACRDOC(X,9,0))
I Z S Z=$P($G(^ACRDOC(X,9,Z,0)),U)
I Z S Y=$$CITY(Z)
Q Y
CITY(X) ;----- RETURNS EXTERNAL ARMS PER DIEM CITY^STATE
;
; X = CITY IEN
;
N Y
S Y=""
I X S X=$G(^ACRPD(X,0))
S Y=$P(X,U)
S X=$P(X,U,2)
I X S X=$P($G(^DIC(5,X,0)),U,2)
S Y=Y_U_X
Q Y
PURP(X) ;----- RETURN PURPOSE OF TRAVEL
;
; X = DOCUMENT IEN
;
N I,G,Y,Z
S Y=""
F G="JST","JST2" D
. S Z=$G(^ACROBL(X,G))
. F I=1:1:5 D
. . I $P(Z,U,I)]"" S Y=Y_" "_$P(Z,U,I)
Q Y
STAT(X) ;----- RETURNS DOCUMENT STATUS
;
; X = DOCUMENT IEN
;
N ACRREF,Y,Z
S Y=""
S Z=$G(^ACRDOC(X,0))
I $L($P(Z,U))'=10 Q Y
S ACRREF=$P(Z,U,13)
I ACRREF S ACRREF=$P($G(^AUTTDOCR(ACRREF,0)),U)
S Z=$G(^ACROBL(X,"APV"))
I ACRREF=130 S Z=$P(Z,U),Y="TO"
I ACRREF=600 S Z=$P(Z,U,8),Y="TV"
I $P($G(^ACRDOC(X,0)),U,14)["CANCELLED" S Z="C"
S Y=Y_$S(Z="A":" APPROVED",Z="D":" DISAPPROVED",Z="C":" CANCELLED",1:" PENDING")
Q Y
SEX(X) ;----- RETURNS GENDER
;
; X = TRAVELER
;
N Y
S Y=""
I X S Y=$P($G(^VA(200,X,1)),U,2)
Q Y
PAYPLAN(X) ;
;----- RETURNS PAY PLAN OF TRAVELER
;
; X = TRAVELER
;
N Y
S Y=""
I X S X=$G(^ACRAU(X,1))
S Y=$P(X,U,3)
Q Y
GRADE(X) ;----- RETURNS GRADE OF TRAVELER
;
; X = TRAVELER
;
N Y
S Y=""
I X S X=$G(^ACRAU(X,1))
S Y=$P(X,U,4)
Q Y
SER(X) ;----- RETURNS SERIES OF TRAVELER
;
; X = TRAVELER
;
N Y
S Y=""
I X S Y=$P($G(^ACRAU(X,1)),U,8)
Q Y
ODS(X) ;----- RETURNS OFFICAL DUTY STATION
;
; X = TRAVELER
;
N Y
S Y=""
I X S Y=$P($G(^ACRAU(X,1)),U)
I Y S Y=$P($G(^AUTTLOC(Y,0)),U)
I Y S Y=$P($G(^DIC(4,Y,0)),U)
Q Y
ODSA(X) ;----- RETURNS OFFICIAL DUTY STATION AREA
;
; X = TRAVELER
;
N Y
S Y=""
I X S Y=$P($G(^ACRAU(X,1)),U)
I Y S Y=$P($G(^AUTTLOC(Y,0)),U,4)
I Y S Y=$P($G(^AUTTAREA(Y,0)),U)
Q Y
REQ(X) ;----- RETURNS AMOUNT REQUESTED
;
; X = DOCUMENT IEN
N Y
S Y=""
I X S Y=$P($G(^ACROBL(X,0)),U)
Q Y
OBL(X) ;----- RETURNS AMOUNT OBLIGATED
;
; X = DOCUMENT IEN
N Y
S Y=""
I X S Y=$P($G(^ACROBL(X,"DT")),U,4)
Q Y
SPNT(X) ;----- RETURNS AMOUNT SPENT
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACROBL(X,"DT")),U,2)
Q Y
TXT ;----- PRINT OPTION TEXT
;
N I,X
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
ACRFFF3 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF TRAVEL INFORMATION [ 09/23/2005 4:18 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13,19**;NOV 05, 2001
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;Create Travel Information Flat File
+2 ;;
+3 ;;This option will gather all travel documents within the
+4 ;;specified date range and place them into a UNIX comma
+5 ;;delimited flat file which can then be imported into an
+6 ;;Access or Excel spreadsheet.
+7 ;;
+8 ;;Fields included in the flat file are:
+9 ;; 1 ASUFAC Code 12 Travel End Date
+10 ;; 2 CAN Number 13 Days in Travel
+11 ;; 3 Travel Order Number 14 Travel From City
+12 ;; 4 Traveler Name 15 Travel From State
+13 ;; 5 Official Duty Station 16 Travel To City
+14 ;; 6 ODS Area 17 Travel To State
+15 ;; 7 Gender 18 Amount Requested
+16 ;; 8 Pay Plan 19 Amount Obligated
+17 ;; 9 Grade 20 Amount Spent
+18 ;; 10 Series 21 Status
+19 ;; 11 Travel Begin Date 22 Purpose of Travel
+20 ;;$$END
+21 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW ACRDATES,ACRFILE
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 DO TXT
+8 ;
+9 DO DATES(.ACRDATES)
+10 IF $GET(ACRDATES)']""
QUIT
+11 ;
+12 DO FILE(.ACRFILE)
+13 IF $GET(ACRFILE)']""
QUIT
+14 ;
+15 WRITE " please wait..."
+16 ;
+17 DO GET(ACRDATES)
+18 ;
+19 IF '$DATA(^TMP("ACR",$JOB,"T"))
Begin DoDot:1
+20 WRITE !!,"No data found"
+21 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+22 ;
+23 DO UNIX(ACRFILE)
+24 ;
+25 ;K ^TMP("ACR",$J,"T")
+26 ;
+27 DO ^%ZISC
+28 ;
+29 DO PAUSE^ACRFWARN
+30 ;
+31 QUIT
GET(ACRDATES) ;
+1 ;----- LOOP THROUGH TRAVEL ORDERS AND PUT DATA INTO ^TMP GLOBAL
+2 ;
+3 NEW ACRDATA,ACRDOCDA,ACRREF,ACRTOREF,ACRTVREF
+4 ;
+5 KILL ^TMP("ACR",$JOB,"T")
+6 KILL ^TMP("ACR",$JOB,"D")
+7 ;
+8 SET ACRTOREF=$ORDER(^AUTTDOCR("B",130,0))
+9 SET ACRTVREF=$ORDER(^AUTTDOCR("B",600,0))
+10 FOR ACRREF=ACRTOREF,ACRTVREF
Begin DoDot:1
+11 SET ACRDOCDA=0
+12 FOR
SET ACRDOCDA=$ORDER(^ACRDOC("REF",ACRREF,ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:2
+13 SET ACRDATA=$GET(^ACRDOC(ACRDOCDA,"TO"))
+14 IF $PIECE(ACRDATA,U,14)<$PIECE(ACRDATES,U)
QUIT
+15 IF $PIECE(ACRDATA,U,14)>$PIECE(ACRDATES,U,2)
QUIT
+16 DO ONE(ACRDOCDA,ACRDATES,ACRREF)
End DoDot:2
End DoDot:1
+17 QUIT
ONE(ACRDOCDA,ACRDATES,ACRREF) ;
+1 ;----- GATHER DATA FOR ONE DOCUMENT AND PUT INTO ^TMP GLOBAL
+2 ;
+3 NEW ACRDOCNO,ACRTVLR
+4 ;
+5 ;DOCUMENT NUMBER
+6 SET ACRDOCNO=$PIECE($GET(^ACRDOC(ACRDOCDA,0)),U)
+7 ;
+8 ;TRAVELER IEN
+9 SET ACRTVLR=$$TVLR(ACRDOCDA)
+10 ;
+11 ;TRAVEL DAYS
+12 DO TDAYS(ACRDOCDA,ACRDOCNO)
+13 ;
+14 ;ADD AMENDMENTS TO ORIGINAL DOCUMENT TOTALS
IF $LENGTH(ACRDOCNO)>10
Begin DoDot:1
+15 DO SETAMT(ACRDOCDA,ACRDOCNO)
+16 DO SETTD(ACRDOCNO)
End DoDot:1
QUIT
+17 ;
+18 DO SET(ACRDOCDA,ACRDOCNO,ACRTVLR)
+19 DO SETAMT(ACRDOCDA,ACRDOCNO)
+20 DO SETTD(ACRDOCNO)
+21 QUIT
SET(ACRDOCDA,ACRDOCNO,ACRTVLR) ;
+1 ;----- SET DATA INTO ^TMP GLOBAL
+2 ;
+3 NEW X
+4 ;
+5 SET X=$GET(^TMP("ACR",$JOB,"T",$EXTRACT(ACRDOCNO,1,10),1,0))
+6 SET $PIECE(X,U)=$$ASUFAC($$LOC(ACRTVLR))
+7 SET $PIECE(X,U,2)=$$CAN(ACRDOCDA)
+8 SET $PIECE(X,U,3)=ACRDOCNO
+9 SET $PIECE(X,U,4)=$$NAME(ACRTVLR)
+10 SET $PIECE(X,U,5)=$$ODS(ACRTVLR)
+11 SET $PIECE(X,U,6)=$$ODSA(ACRTVLR)
+12 SET $PIECE(X,U,7)=$$SEX(ACRTVLR)
+13 SET $PIECE(X,U,8)=$$PAYPLAN(ACRTVLR)
+14 SET $PIECE(X,U,9)=$$GRADE(ACRTVLR)
+15 SET $PIECE(X,U,10)=$$SER(ACRTVLR)
+16 SET $PIECE(X,U,14)=$PIECE($$TVLF(ACRDOCDA),U)
+17 SET $PIECE(X,U,15)=$PIECE($$TVLF(ACRDOCDA),U,2)
+18 SET $PIECE(X,U,16)=$PIECE($$TVLT(ACRDOCDA),U)
+19 SET $PIECE(X,U,17)=$PIECE($$TVLT(ACRDOCDA),U,2)
+20 SET $PIECE(X,U,21)=$$STAT(ACRDOCDA)
+21 SET ^TMP("ACR",$JOB,"T",$EXTRACT(ACRDOCNO,1,10),1,0)=X
+22 SET ^TMP("ACR",$JOB,"T",$EXTRACT(ACRDOCNO,1,10),2,0)=$$PURP(ACRDOCDA)
+23 QUIT
SETAMT(ACRDOCDA,ACRDOCNO) ;
+1 ;----- SET AMOUNTS INTO ^TMP GLOBAL
+2 ;
+3 NEW X
+4 ;
+5 SET X=$GET(^TMP("ACR",$JOB,"T",$EXTRACT(ACRDOCNO,1,10),1,0))
+6 SET $PIECE(X,U,18)=$$DOL^ACRFUTL($PIECE(X,U,18)+$$REQ(ACRDOCDA))
+7 SET $PIECE(X,U,19)=$$DOL^ACRFUTL($PIECE(X,U,19)+$$OBL(ACRDOCDA))
+8 SET $PIECE(X,U,20)=$$DOL^ACRFUTL($PIECE(X,U,20)+$$SPNT(ACRDOCDA))
+9 SET ^TMP("ACR",$JOB,"T",$EXTRACT(ACRDOCNO,1,10),1,0)=X
+10 QUIT
SETTD(ACRDOCNO) ;
+1 ;----- SETS 1ST AND LAST TRAVEL DAYS INTO ^TMP GLOBAL
+2 ;
+3 NEW ACRF,ACRL,ACRN,X
+4 ;
+5 SET X=$GET(^TMP("ACR",$JOB,"T",$EXTRACT(ACRDOCNO,1,10),1,0))
+6 SET ACRF=$ORDER(^TMP("ACR",$JOB,"D",$EXTRACT(ACRDOCNO,1,10),0))
+7 SET ACRL=$ORDER(^TMP("ACR",$JOB,"D",$EXTRACT(ACRDOCNO,1,10),9999999),-1)
+8 SET ACRN=$$NTDAYS(ACRL,ACRF)
+9 SET $PIECE(X,U,11)=$$SLDATE^ACRFUTL(ACRF)
+10 SET $PIECE(X,U,12)=$$SLDATE^ACRFUTL(ACRL)
+11 SET $PIECE(X,U,13)=ACRN
+12 SET ^TMP("ACR",$JOB,"T",$EXTRACT(ACRDOCNO,1,10),1,0)=X
+13 QUIT
UNIX(ACRFILE) ;
+1 ;----- WRITE ^TMP GLOBAL TO UNIX FILE
+2 ;
+3 NEW %FILE,ACRCNT,ACRDOCDA,ACROUT,X
+4 IF '$DATA(^TMP("ACR",$JOB,"T"))
QUIT
+5 DO HFS(.ACROUT,.%FILE,ACRFILE)
+6 IF $GET(ACROUT)
QUIT
+7 USE %FILE
+8 SET ACRCNT=0
+9 SET ACRDOCDA=0
+10 FOR
SET ACRDOCDA=$ORDER(^TMP("ACR",$JOB,"T",ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:1
+11 SET ACRCNT=$GET(ACRCNT)+1
+12 SET X=$GET(^TMP("ACR",$JOB,"T",ACRDOCDA,1,0))
+13 DO WRITE(X)
+14 SET X=$GET(^TMP("ACR",$JOB,"T",ACRDOCDA,2,0))
+15 DO WRITE(X)
+16 WRITE !
End DoDot:1
+17 USE 0
WRITE !!,ACRCNT_" Records have been put into file "_ACRFILE
+18 DO ^%ZISC
+19 HANG 3
+20 QUIT
WRITE(X) ;
+1 ;----- FORMAT AND WRITE DATA TO UNIX FILE
+2 ;
+3 NEW I,Y
+4 FOR I=1:1:$LENGTH(X,U)
Begin DoDot:1
+5 SET Y=$PIECE(X,U,I)
+6 WRITE """"
+7 WRITE Y
+8 WRITE """"
+9 WRITE ","
End DoDot:1
+10 QUIT
DATES(ACRDATES) ;
+1 ;----- ASK DATE RANGE
+2 ;
DLOOP ;----- DATE LOOP
+1 ;
+2 NEW ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 WRITE !
+4 SET DIR(0)="DO^::E"
+5 SET DIR("A")="Start with first TRAVEL BEGIN DATE"
+6 SET DIR("?")="The first BEGINNING DATE OF TRAVEL to include in the report"
+7 DO ^DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+9 IF Y=""
QUIT
+10 SET ACRBEG=Y
+11 SET DIR("A")="End with last TRAVEL BEGIN DATE"
+12 SET DIR("?")="The last BEGINNING DATE OF TRAVEL to include in the report"
+13 DO ^DIR
+14 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+15 IF Y=""
QUIT
+16 SET ACREND=Y
+17 IF ACREND<ACRBEG
Begin DoDot:1
+18 WRITE *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
End DoDot:1
GOTO DLOOP
+19 SET ACRDATES=ACRBEG_U_ACREND
+20 QUIT
FILE(ACRFILE) ;
+1 ;----- ASK FILE NAME
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 SET ACRFILE=""
+5 SET DIR(0)="F"
+6 SET DIR("A")="Select OUTPUT FILE NAME"
+7 SET DIR("?")="The name of the OUTPUT FILE you want to put the data into"
+8 DO ^DIR
+9 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+10 SET ACRFILE=Y_".csv"
+11 QUIT
HFS(ACROUT,%FILE,ACRFILE) ;
+1 ;----- CREATE AND OPEN FILE
+2 ;
+3 NEW POP,X,Y,ZISH1,ZISH2,ZISH3,ZISH4
+4 SET ZISH1="FILE"
+5 ;S ZISH2="/usr/ACR/alb/" ;ACR*2.1*13.06 IM14144
+6 ;ACR*2.1*13.06 IM14144
SET ZISH2=$$ARMSDIR^ACRFSYS(1)
+7 SET ZISH3=ACRFILE
+8 SET ZISH4="W"
+9 DO OPEN^%ZISH(ZISH1,ZISH2,ZISH3,ZISH4)
+10 IF POP
Begin DoDot:1
+11 WRITE "CANNOT OPEN FILE "_ZISH2_ZISH3
+12 SET ACROUT=1
End DoDot:1
QUIT
+13 SET %FILE=IO
+14 QUIT
LOC(X) ;----- RETURNS INTERNAL LOCATION IEN OF TRAVELER OFFICIAL DUTY STATION
+1 ;
+2 ; X = TRAVELER IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRAU(X,1)),U)
+7 QUIT Y
ASUFAC(D0) ;
+1 ;----- RETURN LOCATION ASUFAC CODE
+2 ;
+3 ; D0 = LOCATION IEN
+4 ;
+5 NEW Y
+6 SET Y=""
+7 IF D0
XECUTE $GET(^DD(9999999.06,.0799,9.2))
+8 SET Y=$PIECE($GET(Y(9999999.06,.0799,3)),U,10)
+9 QUIT Y
CAN(X) ;----- RETURN EXTERNAL CAN NUMBER
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,"REQ")),U,10)
+7 IF Y
SET Y=$PIECE($GET(^ACRCAN(Y,0)),U)
+8 IF Y
SET Y=$PIECE($GET(^AUTTCAN(Y,0)),U)
+9 QUIT Y
TVLR(X) ;----- RETURN TRAVELER IEN
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,"TO")),U,9)
+7 QUIT Y
NAME(X) ;----- RETURN EXTERNAL TRAVELER NAME
+1 ;
+2 ; X = TRAVELER IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 ;I X S Y=$P($G(^VA(200,X,0)),U) ;ACR*2.1*19.02 IM16848
+7 ;ACR*2.1*19.02 IM16848
IF X
SET Y=$$NAME2^ACRFUTL1(X)
+8 QUIT Y
TDAYS(ACRDOCDA,ACRDOCNO) ;
+1 ;----- BUILDS TRAVEL DAY ARRAY
+2 ;
+3 NEW X,Y,Z
+4 SET Y=""
+5 SET X=0
+6 FOR
SET X=$ORDER(^ACRTV("D",ACRDOCDA,X))
IF 'X
QUIT
Begin DoDot:1
+7 SET Z=$PIECE($GET(^ACRTV(X,"DT")),U)
+8 IF 'Z
QUIT
+9 SET ^TMP("ACR",$JOB,"D",$EXTRACT(ACRDOCNO,1,10),Z,0)=$$SLDATE^ACRFUTL(Z)
End DoDot:1
+10 QUIT
NTDAYS(X1,X2) ;
+1 ;----- RETURN TRAVEL TRAVEL DAYS
+2 ;
+3 NEW %Y,X,Y
+4 SET Y=""
+5 DO ^%DTC
+6 IF %Y
SET Y=X
+7 QUIT Y
TVLF(X) ;----- RETURNS EXTERNAL TRAVEL FROM CITY^STATE
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET X=$PIECE($GET(^ACRDOC(X,13)),U)
+7 IF X
SET Y=$$CITY(X)
+8 QUIT Y
TVLT(X) ;----- RETURNS EXTERNAL TRAVEL TO CITY^STATE
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y,Z
+5 SET Y=""
+6 IF X
SET Z=$ORDER(^ACRDOC(X,9,0))
+7 IF Z
SET Z=$PIECE($GET(^ACRDOC(X,9,Z,0)),U)
+8 IF Z
SET Y=$$CITY(Z)
+9 QUIT Y
CITY(X) ;----- RETURNS EXTERNAL ARMS PER DIEM CITY^STATE
+1 ;
+2 ; X = CITY IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET X=$GET(^ACRPD(X,0))
+7 SET Y=$PIECE(X,U)
+8 SET X=$PIECE(X,U,2)
+9 IF X
SET X=$PIECE($GET(^DIC(5,X,0)),U,2)
+10 SET Y=Y_U_X
+11 QUIT Y
PURP(X) ;----- RETURN PURPOSE OF TRAVEL
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW I,G,Y,Z
+5 SET Y=""
+6 FOR G="JST","JST2"
Begin DoDot:1
+7 SET Z=$GET(^ACROBL(X,G))
+8 FOR I=1:1:5
Begin DoDot:2
+9 IF $PIECE(Z,U,I)]""
SET Y=Y_" "_$PIECE(Z,U,I)
End DoDot:2
End DoDot:1
+10 QUIT Y
STAT(X) ;----- RETURNS DOCUMENT STATUS
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW ACRREF,Y,Z
+5 SET Y=""
+6 SET Z=$GET(^ACRDOC(X,0))
+7 IF $LENGTH($PIECE(Z,U))'=10
QUIT Y
+8 SET ACRREF=$PIECE(Z,U,13)
+9 IF ACRREF
SET ACRREF=$PIECE($GET(^AUTTDOCR(ACRREF,0)),U)
+10 SET Z=$GET(^ACROBL(X,"APV"))
+11 IF ACRREF=130
SET Z=$PIECE(Z,U)
SET Y="TO"
+12 IF ACRREF=600
SET Z=$PIECE(Z,U,8)
SET Y="TV"
+13 IF $PIECE($GET(^ACRDOC(X,0)),U,14)["CANCELLED"
SET Z="C"
+14 SET Y=Y_$SELECT(Z="A":" APPROVED",Z="D":" DISAPPROVED",Z="C":" CANCELLED",1:" PENDING")
+15 QUIT Y
SEX(X) ;----- RETURNS GENDER
+1 ;
+2 ; X = TRAVELER
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^VA(200,X,1)),U,2)
+7 QUIT Y
PAYPLAN(X) ;
+1 ;----- RETURNS PAY PLAN OF TRAVELER
+2 ;
+3 ; X = TRAVELER
+4 ;
+5 NEW Y
+6 SET Y=""
+7 IF X
SET X=$GET(^ACRAU(X,1))
+8 SET Y=$PIECE(X,U,3)
+9 QUIT Y
GRADE(X) ;----- RETURNS GRADE OF TRAVELER
+1 ;
+2 ; X = TRAVELER
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET X=$GET(^ACRAU(X,1))
+7 SET Y=$PIECE(X,U,4)
+8 QUIT Y
SER(X) ;----- RETURNS SERIES OF TRAVELER
+1 ;
+2 ; X = TRAVELER
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRAU(X,1)),U,8)
+7 QUIT Y
ODS(X) ;----- RETURNS OFFICAL DUTY STATION
+1 ;
+2 ; X = TRAVELER
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRAU(X,1)),U)
+7 IF Y
SET Y=$PIECE($GET(^AUTTLOC(Y,0)),U)
+8 IF Y
SET Y=$PIECE($GET(^DIC(4,Y,0)),U)
+9 QUIT Y
ODSA(X) ;----- RETURNS OFFICIAL DUTY STATION AREA
+1 ;
+2 ; X = TRAVELER
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRAU(X,1)),U)
+7 IF Y
SET Y=$PIECE($GET(^AUTTLOC(Y,0)),U,4)
+8 IF Y
SET Y=$PIECE($GET(^AUTTAREA(Y,0)),U)
+9 QUIT Y
REQ(X) ;----- RETURNS AMOUNT REQUESTED
+1 ;
+2 ; X = DOCUMENT IEN
+3 NEW Y
+4 SET Y=""
+5 IF X
SET Y=$PIECE($GET(^ACROBL(X,0)),U)
+6 QUIT Y
OBL(X) ;----- RETURNS AMOUNT OBLIGATED
+1 ;
+2 ; X = DOCUMENT IEN
+3 NEW Y
+4 SET Y=""
+5 IF X
SET Y=$PIECE($GET(^ACROBL(X,"DT")),U,4)
+6 QUIT Y
SPNT(X) ;----- RETURNS AMOUNT SPENT
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACROBL(X,"DT")),U,2)
+7 QUIT Y
TXT ;----- PRINT OPTION TEXT
+1 ;
+2 NEW I,X
+3 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+4 QUIT
