ACRFFF1 ;IHS/OIRM/DSD/AEF - ECS SCHEDULE FLAT FILE [ 05/09/2005 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,13,17**;NOV 05, 2001
;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This option will gather all Treasury schedules exported during the
;;specified time range and put them into a comma delimited flat
;;file which can then be exported into an Access or Excel spreadsheet.
;;
;;Fields included in the flat file:
;;
;;SCHEDULE NO, MONTH, AP, ECS, GL ACCT, APPROPRIATION, AMT3, AMT2
;;
;;$$END
Q
;
EN ;EP -- MAIN ENTRY POINT
;
N ACRDATES,ACRFILE
D ^XBKVAR
D TXT
S ACRDATES=""
D EXP(.ACRDATES)
Q:'ACRDATES
D FILE(.ACRFILE)
Q:ACRFILE']""
W " please wait... "
D GET(ACRDATES)
I '$D(^TMP("ACRF",$J,"A")) D Q
. W !!,"No data found"
D UNIX(ACRFILE)
K ^TMP("ACRF",$J,"A")
D CLOSE^ACRFZISH("FILE") ; ACR*2.1*13.01 IM13574
D PAUSE^ACRFWARN
Q
EXP(ACRDATES) ;
;----- ASK EXPORT DATE RANGE
;
DLOOP ;
N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="DO^::E"
S DIR("A")="Begin with EXPORT DATE"
S DIR("?")="The date that the payment batch was exported"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
S ACRBEG=Y
S DIR("A")="End with EXPORT DATE"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
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
GET(ACRDATES) ;
;----- GATHER DATA AND PUT IN ^TMP GLOBAL
;
N D0,D1,D2,ACRDATE,ACREND
K ^TMP("ACRF",$J,"A")
S ACRDATE=$P(ACRDATES,U)
S ACRDATE=ACRDATE-1
S ACREND=$P(ACRDATES,U,2)
F S ACRDATE=$O(^AFSLAFP("EXP",ACRDATE)) Q:ACRDATE>ACREND Q:'ACRDATE D
. S D0=0
. F S D0=$O(^AFSLAFP("EXP",ACRDATE,D0)) Q:'D0 D
. . S D1=0
. . F S D1=$O(^AFSLAFP("EXP",ACRDATE,D0,D1)) Q:'D1 D
. . . Q:$$BATCH^ACRFPAYE(D0,D1)="G" ;DO NOT INCLUDE DHR-ONLY BATCHES ACR*2.1*5.02
. . . S D2=0
. . . F S D2=$O(^AFSLAFP(D0,1,D1,1,D2)) Q:'D2 D
. . . . D SET(D0,D1,D2)
Q
SET(D0,D1,D2) ;
;----- SET DATA INTO ^TMP GLOBAL
;
N ACRAMT2,ACRAMT3,ACRAP,ACRAPP,ACREXP,ACRGL,ACRMON,ACRSCHNO,ACRTYP,X,Y
S ACRAPP=$P($G(^AFSLAFP(D0,1,D1,1,D2,1)),U,21)
Q:'ACRAPP
I $L(ACRAPP)=7 D
. S ACRAPP=$E(ACRAPP,1,2)_" "_$E(ACRAPP,3)_" "_$E(ACRAPP,4,7)
I $L(ACRAPP)=9&(ACRAPP["/") D
. S ACRAPP=$E(ACRAPP,1,2)_" "_$E(ACRAPP,3,9)
S ACRSCHNO=$P($G(^AFSLAFP(D0,1,D1,2)),U,6)
Q:'ACRSCHNO
S ACREXP=$P($G(^AFSLAFP(D0,1,D1,2)),U)
S Y=ACREXP
X ^DD("DD")
S ACRMON=$E(Y,1,3)
S ACRAP=""
I $L(ACRSCHNO)=6 S ACRAP=$E(ACRSCHNO,1,2)
I $L(ACRSCHNO)=10 S ACRAP=$E(ACRSCHNO,5,6)
S ACRTYP="ECS"
S ACRGL="101.2"
S ACRAMT3=$$NET^ACRFSSU(D0,D1,D2) ;*** ACR*2.1*5.02
S ACRAMT2="0.00"
S ^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,D2,0)=ACRSCHNO_U_ACRMON_U_ACRAP_U_ACRTYP_U_ACRGL_U_ACRAPP_U_ACRAMT3_U_ACRAMT2
I '$D(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0)) D
. S ^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0)=ACRSCHNO_U_ACRMON_U_ACRAP_U_ACRTYP_U_ACRGL_U_ACRAPP_U_U_ACRAMT2
S $P(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0),U,7)=$P($G(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0)),U,7)+ACRAMT3
Q
UNIX(ACRFILE) ;
;----- WRITE ^TMP GLOBAL TO UNIX FILE
;
N %DEV,ACRAPP,ACRCNT,ACROUT,ACRSCHNO,X,ACRPATH ;ACR*2.1*13.06 IM14144
Q:'$D(^TMP("ACRF",$J,"A"))
S ACRPATH=$$PATH^ACRFFF1 ;ACR*2.1*13.06 IM14144
Q:ACRPATH']""
D HFS^ACRFZISH(ACRPATH,ACRFILE,"W",.%DEV) ;VERBOSE ACR*2.1*13.01 IM13574
Q:$G(%DEV)']""
U %DEV
S ACRCNT=0
S ACRAPP=""
F S ACRAPP=$O(^TMP("ACRF",$J,"A",ACRAPP)) Q:ACRAPP']"" D
. S ACRSCHNO=0
. F S ACRSCHNO=$O(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO)) Q:'ACRSCHNO D
. . S X=$G(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0))
. . S ACRCNT=$G(ACRCNT)+1
. . D WRITE(X,ACRCNT)
U 0 W !!,"Records have been put into file "_ACRPATH_ACRFILE ;ACR*2.1*13.06 IM14144
;D CLOSE^ACRFZISH("FILE") ;ACR*2.1*13.01 IM13574;Commented out ACR*2.1*17.10 IM17309
H 3
Q
WRITE(X,ACRCNT) ;
;----- FORMAT AND WRITE DATA TO UNIX FILE
;
N Y
S ACRCNT=$G(ACRCNT)+1
S Y=$P(X,U)
W """"
W Y
W """"
W ","
S Y=$P(X,U,2)
W """"
W Y
W """"
W ","
S Y=$P(X,U,3)
W """"
W Y
W """"
W ","
S Y=$P(X,U,4)
W """"
W Y
W """"
W ","
S Y=$P(X,U,5)
W """"
W Y
W """"
W ","
S Y=$P(X,U,6)
W """"
W Y
W """"
W ","
S Y=$P(X,U,7)
S Y=$J(Y,12,2)
W """"
W Y
W """"
W ","
S Y=$P(X,U,8)
S Y=$J(Y,12,2)
W """"
W Y
W """"
W !
Q
FILE(ACRFILE) ;
;----- ASK FILE NAME
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S ACRFILE=""
S DIR(0)="F"
S DIR("A")="Select FILE NAME"
S DIR("?")="The name of the file you want to put the data into"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
S ACRFILE=Y_".csv"
Q
TXT ;----- PRINT OPTION TEXT
;
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
PATH() ;EP; ; NEW;ACR*2.1*13.06 IM14144
; - MODIFIED TO ACCOMMODATE ABQ & HQ UNIQUE DIRECTORY NAMES
;
N X,Z
S X=$$ARMSDIR^ACRFSYS(1)
S Z=$E(X) ;GET DELIMITER - NT COMPATIBLE
I X'["afsdata" S X=X_"csv"_Z ;MOD FOR ABQ/HQW
Q X
ACRFFF1 ;IHS/OIRM/DSD/AEF - ECS SCHEDULE FLAT FILE [ 05/09/2005 4:18 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,13,17**;NOV 05, 2001
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This option will gather all Treasury schedules exported during the
+3 ;;specified time range and put them into a comma delimited flat
+4 ;;file which can then be exported into an Access or Excel spreadsheet.
+5 ;;
+6 ;;Fields included in the flat file:
+7 ;;
+8 ;;SCHEDULE NO, MONTH, AP, ECS, GL ACCT, APPROPRIATION, AMT3, AMT2
+9 ;;
+10 ;;$$END
+11 QUIT
+12 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW ACRDATES,ACRFILE
+3 DO ^XBKVAR
+4 DO TXT
+5 SET ACRDATES=""
+6 DO EXP(.ACRDATES)
+7 IF 'ACRDATES
QUIT
+8 DO FILE(.ACRFILE)
+9 IF ACRFILE']""
QUIT
+10 WRITE " please wait... "
+11 DO GET(ACRDATES)
+12 IF '$DATA(^TMP("ACRF",$JOB,"A"))
Begin DoDot:1
+13 WRITE !!,"No data found"
End DoDot:1
QUIT
+14 DO UNIX(ACRFILE)
+15 KILL ^TMP("ACRF",$JOB,"A")
+16 ; ACR*2.1*13.01 IM13574
DO CLOSE^ACRFZISH("FILE")
+17 DO PAUSE^ACRFWARN
+18 QUIT
EXP(ACRDATES) ;
+1 ;----- ASK EXPORT DATE RANGE
+2 ;
DLOOP ;
+1 NEW ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="DO^::E"
+4 SET DIR("A")="Begin with EXPORT DATE"
+5 SET DIR("?")="The date that the payment batch was exported"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+8 SET ACRBEG=Y
+9 SET DIR("A")="End with EXPORT DATE"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+12 SET ACREND=Y
+13 IF ACREND<ACRBEG
Begin DoDot:1
+14 WRITE *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
End DoDot:1
GOTO DLOOP
+15 SET ACRDATES=ACRBEG_U_ACREND
+16 QUIT
GET(ACRDATES) ;
+1 ;----- GATHER DATA AND PUT IN ^TMP GLOBAL
+2 ;
+3 NEW D0,D1,D2,ACRDATE,ACREND
+4 KILL ^TMP("ACRF",$JOB,"A")
+5 SET ACRDATE=$PIECE(ACRDATES,U)
+6 SET ACRDATE=ACRDATE-1
+7 SET ACREND=$PIECE(ACRDATES,U,2)
+8 FOR
SET ACRDATE=$ORDER(^AFSLAFP("EXP",ACRDATE))
IF ACRDATE>ACREND
QUIT
IF 'ACRDATE
QUIT
Begin DoDot:1
+9 SET D0=0
+10 FOR
SET D0=$ORDER(^AFSLAFP("EXP",ACRDATE,D0))
IF 'D0
QUIT
Begin DoDot:2
+11 SET D1=0
+12 FOR
SET D1=$ORDER(^AFSLAFP("EXP",ACRDATE,D0,D1))
IF 'D1
QUIT
Begin DoDot:3
+13 ;DO NOT INCLUDE DHR-ONLY BATCHES ACR*2.1*5.02
IF $$BATCH^ACRFPAYE(D0,D1)="G"
QUIT
+14 SET D2=0
+15 FOR
SET D2=$ORDER(^AFSLAFP(D0,1,D1,1,D2))
IF 'D2
QUIT
Begin DoDot:4
+16 DO SET(D0,D1,D2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
SET(D0,D1,D2) ;
+1 ;----- SET DATA INTO ^TMP GLOBAL
+2 ;
+3 NEW ACRAMT2,ACRAMT3,ACRAP,ACRAPP,ACREXP,ACRGL,ACRMON,ACRSCHNO,ACRTYP,X,Y
+4 SET ACRAPP=$PIECE($GET(^AFSLAFP(D0,1,D1,1,D2,1)),U,21)
+5 IF 'ACRAPP
QUIT
+6 IF $LENGTH(ACRAPP)=7
Begin DoDot:1
+7 SET ACRAPP=$EXTRACT(ACRAPP,1,2)_" "_$EXTRACT(ACRAPP,3)_" "_$EXTRACT(ACRAPP,4,7)
End DoDot:1
+8 IF $LENGTH(ACRAPP)=9&(ACRAPP["/")
Begin DoDot:1
+9 SET ACRAPP=$EXTRACT(ACRAPP,1,2)_" "_$EXTRACT(ACRAPP,3,9)
End DoDot:1
+10 SET ACRSCHNO=$PIECE($GET(^AFSLAFP(D0,1,D1,2)),U,6)
+11 IF 'ACRSCHNO
QUIT
+12 SET ACREXP=$PIECE($GET(^AFSLAFP(D0,1,D1,2)),U)
+13 SET Y=ACREXP
+14 XECUTE ^DD("DD")
+15 SET ACRMON=$EXTRACT(Y,1,3)
+16 SET ACRAP=""
+17 IF $LENGTH(ACRSCHNO)=6
SET ACRAP=$EXTRACT(ACRSCHNO,1,2)
+18 IF $LENGTH(ACRSCHNO)=10
SET ACRAP=$EXTRACT(ACRSCHNO,5,6)
+19 SET ACRTYP="ECS"
+20 SET ACRGL="101.2"
+21 ;*** ACR*2.1*5.02
SET ACRAMT3=$$NET^ACRFSSU(D0,D1,D2)
+22 SET ACRAMT2="0.00"
+23 SET ^TMP("ACRF",$JOB,"A",ACRAPP,ACRSCHNO,D2,0)=ACRSCHNO_U_ACRMON_U_ACRAP_U_ACRTYP_U_ACRGL_U_ACRAPP_U_ACRAMT3_U_ACRAMT2
+24 IF '$DATA(^TMP("ACRF",$JOB,"A",ACRAPP,ACRSCHNO,0))
Begin DoDot:1
+25 SET ^TMP("ACRF",$JOB,"A",ACRAPP,ACRSCHNO,0)=ACRSCHNO_U_ACRMON_U_ACRAP_U_ACRTYP_U_ACRGL_U_ACRAPP_U_U_ACRAMT2
End DoDot:1
+26 SET $PIECE(^TMP("ACRF",$JOB,"A",ACRAPP,ACRSCHNO,0),U,7)=$PIECE($GET(^TMP("ACRF",$JOB,"A",ACRAPP,ACRSCHNO,0)),U,7)+ACRAMT3
+27 QUIT
UNIX(ACRFILE) ;
+1 ;----- WRITE ^TMP GLOBAL TO UNIX FILE
+2 ;
+3 ;ACR*2.1*13.06 IM14144
NEW %DEV,ACRAPP,ACRCNT,ACROUT,ACRSCHNO,X,ACRPATH
+4 IF '$DATA(^TMP("ACRF",$JOB,"A"))
QUIT
+5 ;ACR*2.1*13.06 IM14144
SET ACRPATH=$$PATH^ACRFFF1
+6 IF ACRPATH']""
QUIT
+7 ;VERBOSE ACR*2.1*13.01 IM13574
DO HFS^ACRFZISH(ACRPATH,ACRFILE,"W",.%DEV)
+8 IF $GET(%DEV)']""
QUIT
+9 USE %DEV
+10 SET ACRCNT=0
+11 SET ACRAPP=""
+12 FOR
SET ACRAPP=$ORDER(^TMP("ACRF",$JOB,"A",ACRAPP))
IF ACRAPP']""
QUIT
Begin DoDot:1
+13 SET ACRSCHNO=0
+14 FOR
SET ACRSCHNO=$ORDER(^TMP("ACRF",$JOB,"A",ACRAPP,ACRSCHNO))
IF 'ACRSCHNO
QUIT
Begin DoDot:2
+15 SET X=$GET(^TMP("ACRF",$JOB,"A",ACRAPP,ACRSCHNO,0))
+16 SET ACRCNT=$GET(ACRCNT)+1
+17 DO WRITE(X,ACRCNT)
End DoDot:2
End DoDot:1
+18 ;ACR*2.1*13.06 IM14144
USE 0
WRITE !!,"Records have been put into file "_ACRPATH_ACRFILE
+19 ;D CLOSE^ACRFZISH("FILE") ;ACR*2.1*13.01 IM13574;Commented out ACR*2.1*17.10 IM17309
+20 HANG 3
+21 QUIT
WRITE(X,ACRCNT) ;
+1 ;----- FORMAT AND WRITE DATA TO UNIX FILE
+2 ;
+3 NEW Y
+4 SET ACRCNT=$GET(ACRCNT)+1
+5 SET Y=$PIECE(X,U)
+6 WRITE """"
+7 WRITE Y
+8 WRITE """"
+9 WRITE ","
+10 SET Y=$PIECE(X,U,2)
+11 WRITE """"
+12 WRITE Y
+13 WRITE """"
+14 WRITE ","
+15 SET Y=$PIECE(X,U,3)
+16 WRITE """"
+17 WRITE Y
+18 WRITE """"
+19 WRITE ","
+20 SET Y=$PIECE(X,U,4)
+21 WRITE """"
+22 WRITE Y
+23 WRITE """"
+24 WRITE ","
+25 SET Y=$PIECE(X,U,5)
+26 WRITE """"
+27 WRITE Y
+28 WRITE """"
+29 WRITE ","
+30 SET Y=$PIECE(X,U,6)
+31 WRITE """"
+32 WRITE Y
+33 WRITE """"
+34 WRITE ","
+35 SET Y=$PIECE(X,U,7)
+36 SET Y=$JUSTIFY(Y,12,2)
+37 WRITE """"
+38 WRITE Y
+39 WRITE """"
+40 WRITE ","
+41 SET Y=$PIECE(X,U,8)
+42 SET Y=$JUSTIFY(Y,12,2)
+43 WRITE """"
+44 WRITE Y
+45 WRITE """"
+46 WRITE !
+47 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 FILE NAME"
+7 SET DIR("?")="The name of the 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
TXT ;----- PRINT OPTION TEXT
+1 ;
+2 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+3 QUIT
PATH() ;EP; ; NEW;ACR*2.1*13.06 IM14144
+1 ; - MODIFIED TO ACCOMMODATE ABQ & HQ UNIQUE DIRECTORY NAMES
+2 ;
+3 NEW X,Z
+4 SET X=$$ARMSDIR^ACRFSYS(1)
+5 ;GET DELIMITER - NT COMPATIBLE
SET Z=$EXTRACT(X)
+6 ;MOD FOR ABQ/HQW
IF X'["afsdata"
SET X=X_"csv"_Z
+7 QUIT X
