Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFFF1

ACRFFF1.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. DESC ;----- ROUTINE DESCRIPTION
  1.  ;;
  1.  ;;This option will gather all Treasury schedules exported during the
  1.  ;;specified time range and put them into a comma delimited flat
  1.  ;;file which can then be exported into an Access or Excel spreadsheet.
  1.  ;;
  1.  ;;Fields included in the flat file:
  1.  ;;
  1.  ;;SCHEDULE NO, MONTH, AP, ECS, GL ACCT, APPROPRIATION, AMT3, AMT2
  1.  ;;
  1.  ;;$$END
  1.  Q
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  N ACRDATES,ACRFILE
  1.  D ^XBKVAR
  1.  D TXT
  1.  S ACRDATES=""
  1.  D EXP(.ACRDATES)
  1.  Q:'ACRDATES
  1.  D FILE(.ACRFILE)
  1.  Q:ACRFILE']""
  1.  W "    please wait... "
  1.  D GET(ACRDATES)
  1.  I '$D(^TMP("ACRF",$J,"A")) D  Q
  1.  . W !!,"No data found"
  1.  D UNIX(ACRFILE)
  1.  K ^TMP("ACRF",$J,"A")
  1.  D CLOSE^ACRFZISH("FILE")                  ; ACR*2.1*13.01 IM13574
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. EXP(ACRDATES)      ;
  1.  ;----- ASK EXPORT DATE RANGE
  1.  ;
  1. DLOOP ;
  1.  N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="DO^::E"
  1.  S DIR("A")="Begin with EXPORT DATE"
  1.  S DIR("?")="The date that the payment batch was exported"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  S ACRBEG=Y
  1.  S DIR("A")="End with EXPORT DATE"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  S ACREND=Y
  1.  I ACREND<ACRBEG D  G DLOOP
  1.  . W *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
  1.  S ACRDATES=ACRBEG_U_ACREND
  1.  Q
  1. GET(ACRDATES)      ;
  1.  ;----- GATHER DATA AND PUT IN ^TMP GLOBAL
  1.  ;
  1.  N D0,D1,D2,ACRDATE,ACREND
  1.  K ^TMP("ACRF",$J,"A")
  1.  S ACRDATE=$P(ACRDATES,U)
  1.  S ACRDATE=ACRDATE-1
  1.  S ACREND=$P(ACRDATES,U,2)
  1.  F  S ACRDATE=$O(^AFSLAFP("EXP",ACRDATE)) Q:ACRDATE>ACREND  Q:'ACRDATE  D
  1.  . S D0=0
  1.  . F  S D0=$O(^AFSLAFP("EXP",ACRDATE,D0)) Q:'D0  D
  1.  . . S D1=0
  1.  . . F  S D1=$O(^AFSLAFP("EXP",ACRDATE,D0,D1)) Q:'D1  D
  1.  . . . Q:$$BATCH^ACRFPAYE(D0,D1)="G"   ;DO NOT INCLUDE DHR-ONLY BATCHES ACR*2.1*5.02
  1.  . . . S D2=0
  1.  . . . F  S D2=$O(^AFSLAFP(D0,1,D1,1,D2)) Q:'D2  D
  1.  . . . . D SET(D0,D1,D2)
  1.  Q
  1. SET(D0,D1,D2)      ;
  1.  ;----- SET DATA INTO ^TMP GLOBAL
  1.  ;
  1.  N ACRAMT2,ACRAMT3,ACRAP,ACRAPP,ACREXP,ACRGL,ACRMON,ACRSCHNO,ACRTYP,X,Y
  1.  S ACRAPP=$P($G(^AFSLAFP(D0,1,D1,1,D2,1)),U,21)
  1.  Q:'ACRAPP
  1.  I $L(ACRAPP)=7 D
  1.  . S ACRAPP=$E(ACRAPP,1,2)_"  "_$E(ACRAPP,3)_"  "_$E(ACRAPP,4,7)
  1.  I $L(ACRAPP)=9&(ACRAPP["/") D
  1.  . S ACRAPP=$E(ACRAPP,1,2)_"  "_$E(ACRAPP,3,9)
  1.  S ACRSCHNO=$P($G(^AFSLAFP(D0,1,D1,2)),U,6)
  1.  Q:'ACRSCHNO
  1.  S ACREXP=$P($G(^AFSLAFP(D0,1,D1,2)),U)
  1.  S Y=ACREXP
  1.  X ^DD("DD")
  1.  S ACRMON=$E(Y,1,3)
  1.  S ACRAP=""
  1.  I $L(ACRSCHNO)=6 S ACRAP=$E(ACRSCHNO,1,2)
  1.  I $L(ACRSCHNO)=10 S ACRAP=$E(ACRSCHNO,5,6)
  1.  S ACRTYP="ECS"
  1.  S ACRGL="101.2"
  1.  S ACRAMT3=$$NET^ACRFSSU(D0,D1,D2)      ;*** ACR*2.1*5.02
  1.  S ACRAMT2="0.00"
  1.  S ^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,D2,0)=ACRSCHNO_U_ACRMON_U_ACRAP_U_ACRTYP_U_ACRGL_U_ACRAPP_U_ACRAMT3_U_ACRAMT2
  1.  I '$D(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0)) D
  1.  . S ^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0)=ACRSCHNO_U_ACRMON_U_ACRAP_U_ACRTYP_U_ACRGL_U_ACRAPP_U_U_ACRAMT2
  1.  S $P(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0),U,7)=$P($G(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0)),U,7)+ACRAMT3
  1.  Q
  1. UNIX(ACRFILE)      ;
  1.  ;----- WRITE ^TMP GLOBAL TO UNIX FILE
  1.  ;
  1.  N %DEV,ACRAPP,ACRCNT,ACROUT,ACRSCHNO,X,ACRPATH  ;ACR*2.1*13.06 IM14144
  1.  Q:'$D(^TMP("ACRF",$J,"A"))
  1.  S ACRPATH=$$PATH^ACRFFF1                        ;ACR*2.1*13.06 IM14144
  1.  Q:ACRPATH']""
  1.  D HFS^ACRFZISH(ACRPATH,ACRFILE,"W",.%DEV)       ;VERBOSE ACR*2.1*13.01 IM13574
  1.  Q:$G(%DEV)']""
  1.  U %DEV
  1.  S ACRCNT=0
  1.  S ACRAPP=""
  1.  F  S ACRAPP=$O(^TMP("ACRF",$J,"A",ACRAPP)) Q:ACRAPP']""  D
  1.  . S ACRSCHNO=0
  1.  . F  S ACRSCHNO=$O(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO)) Q:'ACRSCHNO  D
  1.  . . S X=$G(^TMP("ACRF",$J,"A",ACRAPP,ACRSCHNO,0))
  1.  . . S ACRCNT=$G(ACRCNT)+1
  1.  . . D WRITE(X,ACRCNT)
  1.  U 0 W !!,"Records have been put into file "_ACRPATH_ACRFILE ;ACR*2.1*13.06 IM14144
  1.  ;D CLOSE^ACRFZISH("FILE")         ;ACR*2.1*13.01 IM13574;Commented out ACR*2.1*17.10 IM17309
  1.  H 3
  1.  Q
  1. WRITE(X,ACRCNT)    ;
  1.  ;----- FORMAT AND WRITE DATA TO UNIX FILE
  1.  ;
  1.  N Y
  1.  S ACRCNT=$G(ACRCNT)+1
  1.  S Y=$P(X,U)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W ","
  1.  S Y=$P(X,U,2)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W ","
  1.  S Y=$P(X,U,3)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W ","
  1.  S Y=$P(X,U,4)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W ","
  1.  S Y=$P(X,U,5)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W ","
  1.  S Y=$P(X,U,6)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W ","
  1.  S Y=$P(X,U,7)
  1.  S Y=$J(Y,12,2)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W ","
  1.  S Y=$P(X,U,8)
  1.  S Y=$J(Y,12,2)
  1.  W """"
  1.  W Y
  1.  W """"
  1.  W !
  1.  Q
  1. FILE(ACRFILE)      ;
  1.  ;----- ASK FILE NAME
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S ACRFILE=""
  1.  S DIR(0)="F"
  1.  S DIR("A")="Select FILE NAME"
  1.  S DIR("?")="The name of the file you want to put the data into"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  S ACRFILE=Y_".csv"
  1.  Q
  1. TXT ;----- PRINT OPTION TEXT
  1.  ;
  1.  F I=1:1 S X=$P($T(DESC+I),";",3)  Q:X["$$END"  W !,X
  1.  Q
  1. PATH() ;EP;              ; NEW;ACR*2.1*13.06 IM14144
  1.  ;   -  MODIFIED TO ACCOMMODATE ABQ & HQ UNIQUE DIRECTORY NAMES
  1.  ;
  1.  N X,Z
  1.  S X=$$ARMSDIR^ACRFSYS(1)
  1.  S Z=$E(X)                     ;GET DELIMITER - NT COMPATIBLE
  1.  I X'["afsdata" S X=X_"csv"_Z  ;MOD FOR ABQ/HQW
  1.  Q X