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