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

ACRFIRSF.m

Go to the documentation of this file. 
  1. ACRFIRSF ;IHS/OIRM/DSD/AEF - IRS 1099 VENDOR FLAT FILE [ 10/27/2004   4:18 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
  1.  ;LOCAL REPORTS
  1.  ;
  1.  ;
  1. DESC ;----- WHAT THIS ROUTINE DOES
  1.  ;;
  1.  ;;You must use option TRNS Prepare Staging File for EXPORT & PRINT
  1.  ;;process located on the ZIRS IRS 1099 Menu before running this
  1.  ;;option.
  1.  ;;
  1.  ;;This option will gather all vendor payments for the specified 
  1.  ;;tax year and put them into a comma delimited UNIX file
  1.  ;;which can then be imported into an Excel or Access spreadsheet.
  1.  ;;
  1.  ;;Fields included in the UNIX file include:
  1.  ;;VENDOR NAME,VENDOR EIN,MAILING ADDRESS-1,MAILING ADDRESS-2,MAILING
  1.  ;;ADDRESS-CITY,MAILING ADDRESS-STATE,MAILING ADDRESS-ZIP,PMT CODE,
  1.  ;;PMT AMOUNT,TAX YEAR
  1.  ;;
  1.  ;;$$END
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  N ACRYR,ACRFILE
  1.  D ^XBKVAR
  1.  D TXT
  1.  D YEAR(.ACRYR)
  1.  Q:'ACRYR
  1.  D FILE(.ACRFILE)
  1.  Q:ACRFILE']""
  1.  W "   please wait... "
  1.  D GET(.ACRYR)
  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 ^%ZISC                                   ; ACR*2.1*13.02 IM13574
  1.  D CLOSE^ACRFZISH("FILE")                    ; ACR*2.1*13.02 IM13574
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. YEAR(ACRYR)        ;
  1.  ;----- ASK CALENDAR YEAR
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S ACRYR=""
  1.  S DIR(0)="N"
  1.  S DIR("A")="Select TAX YEAR"
  1.  S DIR("B")=($E(DT,1,3)+1700)-1
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  S ACRYR=Y
  1.  Q
  1. GET(ACRYR)         ;
  1.  ;----- GATHER DATA AND PUT INTO ^TMP GLOBAL
  1.  ;
  1.  N ACRADD1,ACRADD2,ACRCITY,ACRCNT,ACRDATA,ACREIN,ACRNAME,ACRSTATE,ACRTYP,ACRVND,ACRYTD,ACRZIP
  1.  S (ACRCNT,ACRVND)=0
  1.  F  S ACRVND=$O(^ACR1099V("C",ACRYR,ACRVND)) Q:'ACRVND  D
  1.  . S ACRCNT=ACRCNT+1
  1.  . S ACRNAME=$P($G(^AUTTVNDR(ACRVND,0)),U)
  1.  . S ACREIN=$P($G(^AUTTVNDR(ACRVND,11)),U)
  1.  . S ACRDATA=$G(^AUTTVNDR(ACRVND,13))
  1.  . S ACRADD1=$P(ACRDATA,U)
  1.  . S ACRADD2=$P(ACRDATA,U,10)
  1.  . S ACRCITY=$P(ACRDATA,U,2)
  1.  . S ACRSTATE=$P(ACRDATA,U,3)
  1.  . I ACRSTATE]"" S ACRSTATE=$P($G(^DIC(5,ACRSTATE,0)),U,2)
  1.  . S ACRZIP=$P(ACRDATA,U,4)
  1.  . S ACRTYP=$P($G(^ACR1099V(ACRVND,0)),U,2)
  1.  . S ACRYTD=$P($G(^ACR1099V(ACRVND,1,ACRYR,0)),U,2)
  1.  . S ACRYTD=$J(ACRYTD,$L(ACRYTD),2)
  1.  . S ^TMP("ACRF",$J,"A",ACRCNT,0)=ACRNAME_U_ACREIN_U_ACRADD1_U_ACRADD2_U_ACRCITY_U_ACRSTATE_U_ACRZIP_U_ACRTYP_U_ACRYTD_U_ACRYR
  1.  Q
  1. UNIX(ACRFILE)      ;
  1.  ;----- WRITE ^TMP GLOBAL TO UNIX FILE
  1.  ;
  1.  ;N %DEV,ACRCNT,ACRDATA,ACROUT,I,J,X              ; ACR*2.1*13.06 IM14144
  1.  ;Q:'$D(^TMP("ACRF",$J,"A"))                      ; ACR*2.1*13.06 IM14144
  1.  ;D HFS(.ACROUT,.%DEV,ACRFILE)                    ; ACR*2.1*13.06 IM14144
  1.  N %DEV,ACRCNT,ACRDATA,ACROUT,I,J,X,ACRPATH       ; ACR*2.1*13.06 IM14144
  1.  Q:'$D(^TMP("ACRF",$J,"A"))
  1.  S ACRPATH=$$ARMSDIR^ACRFSYS(1)                   ; ACR*2.1*13.06 IM14144
  1.  Q:ACRPATH']""                                    ; ACR*2.1*13.06 IM14144
  1.  D OPEN^ACRFZISH(ACRPATH,ACRFILE,"W",.%DEV) ;VERBOSE ; ACR*2.1*13.06 IM14144
  1.  I $G(%DEV)']"" S ACROUT=1                        ; ACR*2.1*13.06 IM13574
  1.  Q:$G(ACROUT)
  1.  U %DEV
  1.  S (ACRCNT,I)=0
  1.  F  S I=$O(^TMP("ACRF",$J,"A",I)) Q:'I  D
  1.  . S ACRCNT=ACRCNT+1
  1.  . S ACRDATA=^TMP("ACRF",$J,"A",I,0)
  1.  . F J=1:1:$L(ACRDATA,U) D
  1.  . . S X=$P(ACRDATA,U,J)
  1.  . . D WRITE(X)
  1.  . W !
  1.  ;U 0 W !!,"Records have been put into UNIX file /usr/spool/afsdata/"_ACRFILE ;ACR*2.1*13.06 IM14144
  1.  U 0 W !!,"Records have been put into file "_ACRPATH_ACRFILE ;ACR*2.1*13.06 IM14144
  1.  D CLOSE^ACRFZISH("")                      ;ACR*2.1*13.02 IM13574
  1.  D PAUSE^ACRFWARN                          ;ACR*2.1*13.02 IM13574
  1.  Q
  1. WRITE(X) ;----- FORMAT AND WRITE DATA TO UNIX FILE
  1.  ;
  1.  W """"
  1.  W X
  1.  W """"
  1.  W ","
  1.  Q
  1. FILE(ACRFILE)      ;
  1.  ;----- ASK UNIX FILE NAME
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S ACRFILE=""
  1.  S DIR(0)="F"
  1.  S DIR("A")="Select UNIX FILE NAME"
  1.  S DIR("?")="The name of the UNIX 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. HFS(ACROUT,%DEV,ACRFILE)     ; - REMOVE OBSOLETE SUB-ROUTINE  ;ACR*2.1*13.06 IM14144
  1.  ;----- CREATE AND OPEN UNIX FILE
  1.  ;
  1.  ;N X,Y,ZISH1,ZISH2,ZISH3
  1.  ;S ZISH1="/usr/spool/afsdata/"
  1.  ;S ZISH2=ACRFILE
  1.  ;S ZISH3="W"
  1.  ;S Y=$$OPEN^ZISHMSMU(ZISH1,ZISH2,ZISH3)
  1.  ;I Y D  Q
  1.  ;. W !,"CANNOT OPEN FILE "_ZISH1_ZISH2
  1.  ;. S ACROUT=1
  1.  S %DEV=IO
  1.  Q
  1. TXT ;----- PRINT OPTION TEXT
  1.  ;
  1.  N I,X
  1.  F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END"  W !,X
  1.  Q