ACRFFF5 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF TRAINING INFORMATION [ 09/23/2005 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**13,19**;NOV 05, 2001
;
DESC ;----- ROUTINE DESCRIPTION
;;Create Training Information Flat File
;;
;;This option will gather all training 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. CAN Number 13. Training Hours (Duty)
;; 2. Training Order Number 14. Tuition & Fees
;; 3. Attendee Name 15. Books & Other
;; 4. Official Duty Station 16. Travel Order Number
;; 5. ODS Area 17. Travel From (City, State)
;; 6. Gender 18. Travel To (City, State)
;; 7. Pay Plan 19. Transportation Cost
;; 8. Grade 20. Per Diem
;; 9. Series 21. Other Expenses
;; 10. Training Begin Date 22. Travel Mgt. Fee
;; 11. Training End Date 23. Training Order Status
;; 12. Training Course Title
;;$$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,"G")) D Q
. W !!,"No data found"
. D PAUSE^ACRFWARN
;
D UNIX(ACRFILE)
;
;K ^TMP("ACR",$J)
;
D ^%ZISC
;
D PAUSE^ACRFWARN
;
Q
GET(ACRDATES) ;
;----- LOOP THROUGH TRAINING ORDERS AND PUT DATA INTO ^TMP GLOBAL
;
N ACRDATA,ACRDOCDA,ACRDOCNO,ACRREF,ACRTONO
;
K ^TMP("ACR",$J)
;
S ACRREF=$O(^AUTTDOCR("B",148,0))
S ACRDOCDA=0
F S ACRDOCDA=$O(^ACRDOC("REF",ACRREF,ACRDOCDA)) Q:'ACRDOCDA D
. S ACRDATA=$G(^ACRDOC(ACRDOCDA,"TRNG"))
. Q:$P(ACRDATA,U,11)<$P(ACRDATES,U)
. Q:$P(ACRDATA,U,11)>$P(ACRDATES,U,2)
. D ONE(ACRDOCDA)
;
Q
ONE(ACRDOCDA) ;
;----- GATHER DATA FOR ONE DOCUMENT AND PUT INTO ^TMP GLOBAL
;
; ACRATT = ATTENDEE IEN
; ACRDOCDA = TRAINING DOCUMENT IEN
; ACRDOCNO = TRAINING DOCUMENT NUMBER
; ACRTODA = TRAVEL DOCUMENT IEN
; ACRTONO = TRAVEL DOCUMENT NUMBER
;
N ACRDOCNO,ACRTODA,ACRTONO,Z
;
S ACRDOCNO=$$DOCNO(ACRDOCDA)
S ACRATT=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
S ACRTODA=$P($G(^ACRDOC(ACRDOCDA,"TRNGTO")),U)
S ACRTONO=""
I ACRTODA D
. S ACRTONO=$P($G(^ACRDOC(ACRTODA,0)),U)
;
;TUITION & FEES, BOOKS & OTHER, PER DIEM, ETC.
I ACRDOCDA D AMTS(ACRDOCDA)
I ACRTODA D AMTS(ACRTODA)
;
;
;----- SET DATA INTO ^TMP GLOBAL
;
S $P(Z,U)=$$CAN(ACRDOCDA)
S $P(Z,U,2)=ACRDOCNO
S $P(Z,U,3)=$$NAME(ACRDOCDA)
S $P(Z,U,4)=$$ODS(ACRATT)
S $P(Z,U,5)=$$ODSA(ACRATT)
S $P(Z,U,6)=$$SEX(ACRATT)
S $P(Z,U,7)=$$PAYPLAN(ACRATT)
S $P(Z,U,8)=$$GRADE(ACRATT)
S $P(Z,U,9)=$$SER(ACRATT)
S $P(Z,U,10)=$$BEG(ACRDOCDA)
S $P(Z,U,11)=$$END(ACRDOCDA)
S $P(Z,U,12)=$$TITLE(ACRDOCDA)
S $P(Z,U,13)=$$HRS(ACRDOCDA)
I ACRDOCNO]"" D
. S $P(Z,U,14)=$G(^TMP("ACR",$J,"AMT",ACRDOCNO,"Tuition & Fees",0))
. S $P(Z,U,15)=$G(^TMP("ACR",$J,"AMT",ACRDOCNO,"Books & Other",0))
I ACRTONO]"" D
. S $P(Z,U,16)=ACRTONO
. S $P(Z,U,17)=$$TVLF(ACRTODA)
. S $P(Z,U,18)=$$TVLT(ACRTODA)
. S $P(Z,U,19)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Travel-DHHS",0))
. S $P(Z,U,20)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Per Diem-DHHS",0))
. S $P(Z,U,21)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Other Exp-DHHS",0))
. S $P(Z,U,22)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Travel Mgt Fee",0))
S $P(Z,U,23)=$$STAT(ACRDOCDA)
;
S ^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),ACRDOCNO,0)=Z
;
I '$D(^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0)) D Q
. S ^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0)=Z
;
S Y=$G(^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0))
I $$DT($P(Z,U,10))>0,$$DT($P(Z,U,10))<$$DT($P(Y,U,10)) S $P(Y,U,10)=$P(Z,U,10) ;TRAINING BEGIN DATE
I $$DT($P(Z,U,11))>0,$$DT($P(Z,U,11))>$$DT($P(Y,U,11)) S $P(Y,U,11)=$P(Z,U,11) ;TRAINING END DATE
S $P(Y,U,14)=$P(Y,U,14)+$P(Z,U,14) ;TUITION & FEES
S $P(Y,U,15)=$P(Y,U,15)+$P(Z,U,15) ;BOOKS & OTHER
S $P(Y,U,19)=$P(Y,U,19)+$P(Z,U,19) ;TRANSPORTATION COST
S $P(Y,U,20)=$P(Y,U,20)+$P(Z,U,20) ;PER DIEM
S $P(Y,U,21)=$P(Y,U,21)+$P(Z,U,21) ;OTHER EXPENSES
S $P(Y,U,22)=$P(Y,U,22)+$P(Z,U,22) ;TRAVEL MGT FEE
;
S ^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0)=Y
Q
UNIX(ACRFILE) ;
;----- WRITE ^TMP GLOBAL TO UNIX FILE
;
N %FILE,ACRCNT,ACRDOCDA,ACROUT,X
Q:'$D(^TMP("ACR",$J,"G"))
D HFS(.ACROUT,.%FILE,ACRFILE)
Q:$G(ACROUT)
U %FILE
S ACRCNT=0
S ACRDOCDA=""
F S ACRDOCDA=$O(^TMP("ACR",$J,"G",ACRDOCDA)) Q:ACRDOCDA']"" D
. S X=$G(^TMP("ACR",$J,"G",ACRDOCDA,0))
. S ACRCNT=$G(ACRCNT)+1
. 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 TRAINING BEGIN DATE"
S DIR("?")="The first BEGINNING DATE OF TRAINING 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 TRAINING BEGIN DATE"
S DIR("?")="The last BEGINNING DATE OF TRAINING 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
CAN(ACRDOCDA) ;
;----- RETURN EXTERNAL CAN NUMBER
;
N Y
S Y=""
S Y=$P($G(^ACRDOC(ACRDOCDA,"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
NAME(ACRDOCDA) ;
;----- RETURN EXTERNAL TRAINEE NAME
;
N Y
S Y=""
S Y=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
;I Y S Y=$P($G(^VA(200,Y,0)),U) ;ACR*2.1*19.02 IM16848
I Y S Y=$$NAME2^ACRFUTL1(Y) ;ACR*2.1*19.02 IM16848
Q Y
AMTS(ACRDOCDA) ;
;----- BUILDS TUITION & FEES, BOOKS & OTHER, TRAVEL, PER DIEM,
; OTHER EXP, TRAVEL MGT FEE ARRAY
;
N ACRAMT,ACRD0,ACRDATA,ACRDOCNO,ACRKW,X
;
S ACRDOCNO=$P($G(^ACRDOC(ACRDOCDA,0)),U)
Q:ACRDOCNO']""
S ACRD0=0
F S ACRD0=$O(^ACRSS("C",ACRDOCDA,ACRD0)) Q:'ACRD0 D
. S ACRKW=$P($G(^ACRSS(ACRD0,"NMS")),U,5)
. Q:ACRKW']""
. S ACRDATA=$G(^ACRSS(ACRD0,"DT"))
. S ACRAMT=$P(ACRDATA,U,4)
. I $P($G(^ACRSS(ACRD0,"APV")),U,2)="A" D
. . S ACRAMT=$P(ACRDATA,U,9)
. S ^TMP("ACR",$J,"AMT",ACRDOCNO,ACRKW,0)=ACRAMT
Q
STAT(ACRDOCDA) ;
;----- RETURNS DOCUMENT STATUS
;
N Y
S Y=$P($G(^ACROBL(ACRDOCDA,"APV")),U)
S Y="350 "_$S(Y="A":"APPROVED",Y="D":"DISAPPROVED",Y="C":"CANCELLED",1:"PENDING")
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
DT(X) ;----- RETURNS FM DATE
;
; X = EXTERNAL DATE, IE., 01/10/2002
;
N Y
S %DT=""
D ^%DT
Q Y
DOCNO(X) ;----- RETURNS DOCUMENT NUMBER
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,0)),U)
Q Y
TVLF(X) ;----- RETURNS EXTERNAL TRAVEL FROM CITY, STATE
;
; X = DOCUMENT IEN
;
N Y,Z
S Y=""
I X S Z=$P($G(^ACRDOC(X,13)),U)
S Y=$$CITY(Z)
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 = PER DIEM 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)
I X]"",Y]"" S Y=Y_", "_X
Q Y
ODS(X) ;----- RETURNS OFFICIAL 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
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
BEG(X) ;----- RETURNS TRAINING BEGIN DATE
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,11)
I Y S Y=$$SLDATE^ACRFUTL(Y)
Q Y
END(X) ;----- RETURNS TRAINING END DATE
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,12)
I Y S Y=$$SLDATE^ACRFUTL(Y)
Q Y
TITLE(X) ;----- RETURNS TRAINING COURSE TITLE
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,18)
Q Y
HRS(X) ;----- RETURNS TRAINING HOURS (DUTY)
;
; X = DOCUMENT IEN
;
N Y
S Y=""
I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,9)
Q Y
ACRFFF5 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF TRAINING 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 Training Information Flat File
+2 ;;
+3 ;;This option will gather all training 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. CAN Number 13. Training Hours (Duty)
+10 ;; 2. Training Order Number 14. Tuition & Fees
+11 ;; 3. Attendee Name 15. Books & Other
+12 ;; 4. Official Duty Station 16. Travel Order Number
+13 ;; 5. ODS Area 17. Travel From (City, State)
+14 ;; 6. Gender 18. Travel To (City, State)
+15 ;; 7. Pay Plan 19. Transportation Cost
+16 ;; 8. Grade 20. Per Diem
+17 ;; 9. Series 21. Other Expenses
+18 ;; 10. Training Begin Date 22. Travel Mgt. Fee
+19 ;; 11. Training End Date 23. Training Order Status
+20 ;; 12. Training Course Title
+21 ;;$$END
+22 ;
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,"G"))
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)
+26 ;
+27 DO ^%ZISC
+28 ;
+29 DO PAUSE^ACRFWARN
+30 ;
+31 QUIT
GET(ACRDATES) ;
+1 ;----- LOOP THROUGH TRAINING ORDERS AND PUT DATA INTO ^TMP GLOBAL
+2 ;
+3 NEW ACRDATA,ACRDOCDA,ACRDOCNO,ACRREF,ACRTONO
+4 ;
+5 KILL ^TMP("ACR",$JOB)
+6 ;
+7 SET ACRREF=$ORDER(^AUTTDOCR("B",148,0))
+8 SET ACRDOCDA=0
+9 FOR
SET ACRDOCDA=$ORDER(^ACRDOC("REF",ACRREF,ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:1
+10 SET ACRDATA=$GET(^ACRDOC(ACRDOCDA,"TRNG"))
+11 IF $PIECE(ACRDATA,U,11)<$PIECE(ACRDATES,U)
QUIT
+12 IF $PIECE(ACRDATA,U,11)>$PIECE(ACRDATES,U,2)
QUIT
+13 DO ONE(ACRDOCDA)
End DoDot:1
+14 ;
+15 QUIT
ONE(ACRDOCDA) ;
+1 ;----- GATHER DATA FOR ONE DOCUMENT AND PUT INTO ^TMP GLOBAL
+2 ;
+3 ; ACRATT = ATTENDEE IEN
+4 ; ACRDOCDA = TRAINING DOCUMENT IEN
+5 ; ACRDOCNO = TRAINING DOCUMENT NUMBER
+6 ; ACRTODA = TRAVEL DOCUMENT IEN
+7 ; ACRTONO = TRAVEL DOCUMENT NUMBER
+8 ;
+9 NEW ACRDOCNO,ACRTODA,ACRTONO,Z
+10 ;
+11 SET ACRDOCNO=$$DOCNO(ACRDOCDA)
+12 SET ACRATT=$PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
+13 SET ACRTODA=$PIECE($GET(^ACRDOC(ACRDOCDA,"TRNGTO")),U)
+14 SET ACRTONO=""
+15 IF ACRTODA
Begin DoDot:1
+16 SET ACRTONO=$PIECE($GET(^ACRDOC(ACRTODA,0)),U)
End DoDot:1
+17 ;
+18 ;TUITION & FEES, BOOKS & OTHER, PER DIEM, ETC.
+19 IF ACRDOCDA
DO AMTS(ACRDOCDA)
+20 IF ACRTODA
DO AMTS(ACRTODA)
+21 ;
+22 ;
+23 ;----- SET DATA INTO ^TMP GLOBAL
+24 ;
+25 SET $PIECE(Z,U)=$$CAN(ACRDOCDA)
+26 SET $PIECE(Z,U,2)=ACRDOCNO
+27 SET $PIECE(Z,U,3)=$$NAME(ACRDOCDA)
+28 SET $PIECE(Z,U,4)=$$ODS(ACRATT)
+29 SET $PIECE(Z,U,5)=$$ODSA(ACRATT)
+30 SET $PIECE(Z,U,6)=$$SEX(ACRATT)
+31 SET $PIECE(Z,U,7)=$$PAYPLAN(ACRATT)
+32 SET $PIECE(Z,U,8)=$$GRADE(ACRATT)
+33 SET $PIECE(Z,U,9)=$$SER(ACRATT)
+34 SET $PIECE(Z,U,10)=$$BEG(ACRDOCDA)
+35 SET $PIECE(Z,U,11)=$$END(ACRDOCDA)
+36 SET $PIECE(Z,U,12)=$$TITLE(ACRDOCDA)
+37 SET $PIECE(Z,U,13)=$$HRS(ACRDOCDA)
+38 IF ACRDOCNO]""
Begin DoDot:1
+39 SET $PIECE(Z,U,14)=$GET(^TMP("ACR",$JOB,"AMT",ACRDOCNO,"Tuition & Fees",0))
+40 SET $PIECE(Z,U,15)=$GET(^TMP("ACR",$JOB,"AMT",ACRDOCNO,"Books & Other",0))
End DoDot:1
+41 IF ACRTONO]""
Begin DoDot:1
+42 SET $PIECE(Z,U,16)=ACRTONO
+43 SET $PIECE(Z,U,17)=$$TVLF(ACRTODA)
+44 SET $PIECE(Z,U,18)=$$TVLT(ACRTODA)
+45 SET $PIECE(Z,U,19)=$GET(^TMP("ACR",$JOB,"AMT",ACRTONO,"Travel-DHHS",0))
+46 SET $PIECE(Z,U,20)=$GET(^TMP("ACR",$JOB,"AMT",ACRTONO,"Per Diem-DHHS",0))
+47 SET $PIECE(Z,U,21)=$GET(^TMP("ACR",$JOB,"AMT",ACRTONO,"Other Exp-DHHS",0))
+48 SET $PIECE(Z,U,22)=$GET(^TMP("ACR",$JOB,"AMT",ACRTONO,"Travel Mgt Fee",0))
End DoDot:1
+49 SET $PIECE(Z,U,23)=$$STAT(ACRDOCDA)
+50 ;
+51 SET ^TMP("ACR",$JOB,"G",$EXTRACT(ACRDOCNO,1,10),ACRDOCNO,0)=Z
+52 ;
+53 IF '$DATA(^TMP("ACR",$JOB,"G",$EXTRACT(ACRDOCNO,1,10),0))
Begin DoDot:1
+54 SET ^TMP("ACR",$JOB,"G",$EXTRACT(ACRDOCNO,1,10),0)=Z
End DoDot:1
QUIT
+55 ;
+56 SET Y=$GET(^TMP("ACR",$JOB,"G",$EXTRACT(ACRDOCNO,1,10),0))
+57 ;TRAINING BEGIN DATE
IF $$DT($PIECE(Z,U,10))>0
IF $$DT($PIECE(Z,U,10))<$$DT($PIECE(Y,U,10))
SET $PIECE(Y,U,10)=$PIECE(Z,U,10)
+58 ;TRAINING END DATE
IF $$DT($PIECE(Z,U,11))>0
IF $$DT($PIECE(Z,U,11))>$$DT($PIECE(Y,U,11))
SET $PIECE(Y,U,11)=$PIECE(Z,U,11)
+59 ;TUITION & FEES
SET $PIECE(Y,U,14)=$PIECE(Y,U,14)+$PIECE(Z,U,14)
+60 ;BOOKS & OTHER
SET $PIECE(Y,U,15)=$PIECE(Y,U,15)+$PIECE(Z,U,15)
+61 ;TRANSPORTATION COST
SET $PIECE(Y,U,19)=$PIECE(Y,U,19)+$PIECE(Z,U,19)
+62 ;PER DIEM
SET $PIECE(Y,U,20)=$PIECE(Y,U,20)+$PIECE(Z,U,20)
+63 ;OTHER EXPENSES
SET $PIECE(Y,U,21)=$PIECE(Y,U,21)+$PIECE(Z,U,21)
+64 ;TRAVEL MGT FEE
SET $PIECE(Y,U,22)=$PIECE(Y,U,22)+$PIECE(Z,U,22)
+65 ;
+66 SET ^TMP("ACR",$JOB,"G",$EXTRACT(ACRDOCNO,1,10),0)=Y
+67 QUIT
UNIX(ACRFILE) ;
+1 ;----- WRITE ^TMP GLOBAL TO UNIX FILE
+2 ;
+3 NEW %FILE,ACRCNT,ACRDOCDA,ACROUT,X
+4 IF '$DATA(^TMP("ACR",$JOB,"G"))
QUIT
+5 DO HFS(.ACROUT,.%FILE,ACRFILE)
+6 IF $GET(ACROUT)
QUIT
+7 USE %FILE
+8 SET ACRCNT=0
+9 SET ACRDOCDA=""
+10 FOR
SET ACRDOCDA=$ORDER(^TMP("ACR",$JOB,"G",ACRDOCDA))
IF ACRDOCDA']""
QUIT
Begin DoDot:1
+11 SET X=$GET(^TMP("ACR",$JOB,"G",ACRDOCDA,0))
+12 SET ACRCNT=$GET(ACRCNT)+1
+13 DO WRITE(X)
+14 WRITE !
End DoDot:1
+15 USE 0
WRITE !!,ACRCNT_" Records have been put into file "_ACRFILE
+16 DO ^%ZISC
+17 HANG 3
+18 QUIT
WRITE(X) ;
+1 ;----- FORMAT AND WRITE DATA TO UNIX FILE
+2 ;
+3 NEW I,Y
+4 ;
+5 FOR I=1:1:$LENGTH(X,U)
Begin DoDot:1
+6 SET Y=$PIECE(X,U,I)
+7 WRITE """"
+8 WRITE Y
+9 WRITE """"
+10 WRITE ","
End DoDot:1
+11 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 TRAINING BEGIN DATE"
+6 SET DIR("?")="The first BEGINNING DATE OF TRAINING 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 TRAINING BEGIN DATE"
+12 SET DIR("?")="The last BEGINNING DATE OF TRAINING 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
CAN(ACRDOCDA) ;
+1 ;----- RETURN EXTERNAL CAN NUMBER
+2 ;
+3 NEW Y
+4 SET Y=""
+5 SET Y=$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ")),U,10)
+6 IF Y
SET Y=$PIECE($GET(^ACRCAN(Y,0)),U)
+7 IF Y
SET Y=$PIECE($GET(^AUTTCAN(Y,0)),U)
+8 QUIT Y
NAME(ACRDOCDA) ;
+1 ;----- RETURN EXTERNAL TRAINEE NAME
+2 ;
+3 NEW Y
+4 SET Y=""
+5 SET Y=$PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
+6 ;I Y S Y=$P($G(^VA(200,Y,0)),U) ;ACR*2.1*19.02 IM16848
+7 ;ACR*2.1*19.02 IM16848
IF Y
SET Y=$$NAME2^ACRFUTL1(Y)
+8 QUIT Y
AMTS(ACRDOCDA) ;
+1 ;----- BUILDS TUITION & FEES, BOOKS & OTHER, TRAVEL, PER DIEM,
+2 ; OTHER EXP, TRAVEL MGT FEE ARRAY
+3 ;
+4 NEW ACRAMT,ACRD0,ACRDATA,ACRDOCNO,ACRKW,X
+5 ;
+6 SET ACRDOCNO=$PIECE($GET(^ACRDOC(ACRDOCDA,0)),U)
+7 IF ACRDOCNO']""
QUIT
+8 SET ACRD0=0
+9 FOR
SET ACRD0=$ORDER(^ACRSS("C",ACRDOCDA,ACRD0))
IF 'ACRD0
QUIT
Begin DoDot:1
+10 SET ACRKW=$PIECE($GET(^ACRSS(ACRD0,"NMS")),U,5)
+11 IF ACRKW']""
QUIT
+12 SET ACRDATA=$GET(^ACRSS(ACRD0,"DT"))
+13 SET ACRAMT=$PIECE(ACRDATA,U,4)
+14 IF $PIECE($GET(^ACRSS(ACRD0,"APV")),U,2)="A"
Begin DoDot:2
+15 SET ACRAMT=$PIECE(ACRDATA,U,9)
End DoDot:2
+16 SET ^TMP("ACR",$JOB,"AMT",ACRDOCNO,ACRKW,0)=ACRAMT
End DoDot:1
+17 QUIT
STAT(ACRDOCDA) ;
+1 ;----- RETURNS DOCUMENT STATUS
+2 ;
+3 NEW Y
+4 SET Y=$PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U)
+5 SET Y="350 "_$SELECT(Y="A":"APPROVED",Y="D":"DISAPPROVED",Y="C":"CANCELLED",1:"PENDING")
+6 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
DT(X) ;----- RETURNS FM DATE
+1 ;
+2 ; X = EXTERNAL DATE, IE., 01/10/2002
+3 ;
+4 NEW Y
+5 SET %DT=""
+6 DO ^%DT
+7 QUIT Y
DOCNO(X) ;----- RETURNS DOCUMENT NUMBER
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,0)),U)
+7 QUIT Y
TVLF(X) ;----- RETURNS EXTERNAL TRAVEL FROM CITY, STATE
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y,Z
+5 SET Y=""
+6 IF X
SET Z=$PIECE($GET(^ACRDOC(X,13)),U)
+7 SET Y=$$CITY(Z)
+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 = PER DIEM 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 IF X]""
IF Y]""
SET Y=Y_", "_X
+11 QUIT Y
ODS(X) ;----- RETURNS OFFICIAL 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
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) ;----- RETURNS PAY PLAN 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,3)
+8 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
BEG(X) ;----- RETURNS TRAINING BEGIN DATE
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,"TRNG")),U,11)
+7 IF Y
SET Y=$$SLDATE^ACRFUTL(Y)
+8 QUIT Y
END(X) ;----- RETURNS TRAINING END DATE
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,"TRNG")),U,12)
+7 IF Y
SET Y=$$SLDATE^ACRFUTL(Y)
+8 QUIT Y
TITLE(X) ;----- RETURNS TRAINING COURSE TITLE
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,"TRNG")),U,18)
+7 QUIT Y
HRS(X) ;----- RETURNS TRAINING HOURS (DUTY)
+1 ;
+2 ; X = DOCUMENT IEN
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^ACRDOC(X,"TRNG")),U,9)
+7 QUIT Y
