ACRFIRSA ;IHS/OIRM/DSD/AEF/MRS - PRINT 1099s TO FLAT FILE [ 07/20/2006 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**8,13,20**;NOV 05, 2001
; NEW ROUTINE ACR*2.1*8.06
DESC ;;
;; This routine gathers vendor 1099 payment data and puts it into a
;; UNIX comma delimited file to be imported into the Convey package
;; for printing on the Convey created forms -- replaces the ACRF
;; 1099 PRINT ALL option for printing 1099's on pre-printed forms.
;;
;; NOTE: This routine assumes that all data checks and any
;; necessary edits have been made before this routine
;; is run. You will be asked if this is a test run or
;; if the Vendor file is to be updated.
;;
;; COLUMN LAYOUT:
;;
;; 1 VENDOR NAME 8 VENDOR STATE
;; 2 SHORT NAME 9 VENODR ZIP CODE
;; 3 VENDOR TIN# (9 DIGITS) 10 FOREIGN ADDRESS (1 or BLANK)
;; 4 TIN TYPE 11 CYEAR AMOUNT (BOX 7)
;; 5 VENDOR ADDRESS (LINE 1) 12 CYEAR AMOUNT (BOX 6)
;; 6 VENDOR ADDRESS(LINE 2) 13 CORRECTED (X or BLANK)
;; 7 VENDOR CITY
;;
;;$$END
;
; ACRYR = PAYMENT YEAR
; ACRNAME = VENDOR NAME
; ACRTIN = VENDOR TIN#
; ACRTYP = TIN TYPE = 2 = SSN; 1= EIN
; ACRADD1 = VENDOR ADDRESS 1
; ACRADD2 = VENDOR ADDRESS 2
; ACRCITY = VENDOR CITY
; ACRSTAB = VENDOR STATE ABBREVIATION
; ACRZIP = VENDOR ZIP CODE
; ACRFOR = FOREIGN ADDRESS = 1 if TRUE or NULL
; ACRCOR = CORRECTED FORM
; ACRVTYP = TYPE OF VENDOR (6 or 7)
; ACRAMT = VENDOR YTD PAID AMOUNT BOX 6 or 7
; ACRUP = 1 = UPDATE FILE; 2 = TEST PRINT ONLY
;
EN ;EP -- WRITE ALL VENDOR 1099S INTO FLAT FILE
;
N ACRYR
;
D ^XBKVAR ;----- SET SESSION VARIABLES
D HOME^%ZIS
D ^XBCLS ;----- CLEAR SCREEN
D TXT ;----- WRITE DESCRIPTION
K ACROUT
D PAUSE^ACRFWARN
Q:$D(ACROUT)
;
D ^XBCLS
D YR^ACRFIRSU(.ACRYR) ;----- ASK CALENDAR YEAR
Q:'$G(ACRYR)
;
S ACRUP=$$ASKUP^ACRFIRSU ;----- ASK UPDATE OR TEST
Q:'ACRUP
;
D DQ(ACRYR,ACRUP)
;
D PAUSE^ACRFWARN
Q
;
DQ(ACRYR,ACRUP) ;
;
; INCOMING VARIABLES:
; ACRYR = CALENDAR YEAR
; ACRUP = UPDATE 1099 VENDOR FILE OR TEST PRINT
;
; OTHER VARIABLES USED:
; ACRJ = $JOB NUMBER
;
N ACRJ
;
S ACRJ=$J
K ^TMP("ACR1099",ACRJ)
D ALPHA(ACRYR,ACRJ)
;
D WRITE(ACRYR,ACRJ,ACRUP)
;
Q
WRITE(ACRYR,ACRJ,ACRUP) ;
;----- LOOP THROUGH TMP("ACR1099" FILE AND WRITE 1099s INTO FLATE FILE
;
; INPUT:
; ACRYR = CALENDAR YEAR
; ACRJ = $JOB NUMBER
; ACRUP = UPDATE FILE FLAG
; ^TMP("ACR1099",ACRJ IS ALREADY SET
;
N %DEV,ZISH1,ZISH2 ;ACR*2.1*8.08
S ZISH1=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*8.08,ACR*2.1*13.06 IM14144
I ZISH1["alb"!(ZISH1["hqw") D ;ACR*2.1*8.08
.S ZISH1=ZISH1_"csv/" ;ACR*2.1*8.08
S ZISH2="vendor"_ACRYR_".csv" ;ACR*2.1*8.08
;D HFS^ACRFIRSU(ZISH1,ZISH2,"W",.%DEV) ;ACR*2.1*13.06 IM14144
D HFS^ACRFZISH(ZISH1,ZISH2,"W",.%DEV) ;ACR*2.1*13.06 IM14144
Q:'$D(%DEV)
;
N ACRNAME,ACRVEN,ACRCNT,ACRHDR
;
S ACRNAME=""
S ACRCNT=0
D HDR
F S ACRNAME=$O(^TMP("ACR1099",ACRJ,ACRNAME)) Q:ACRNAME']"" D
.S ACRVEN=0
.F S ACRVEN=$O(^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)) Q:'ACRVEN D
..S ACRDATA=^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)
..S ACRSTR=$$WRITE^ACRFIRSU(ACRDATA)
..U %DEV
..W ACRSTR,!
..S ACRCNT=ACRCNT+1
..I ACRUP=1 D UPDATE^ACRFIRSU(ACRVEN,ACRYR)
U IO(0) W !!?5,ACRCNT," records have been written into "_ZISH1_ZISH2
D CLOSE^%ZISH("FILE")
;
Q
ALPHA(ACRYR,ACRJ) ;
;----- BUILD ALPHABETIC ARRAY OF VENDORS IN ^TMP("ACR1099",ACRJ)
;
; INPUT:
; ACRYR = CALENDAR YEAR
; ACRJ = $JOB NUMBER
; NOTE: UNPOPULATED FIELDS ARE ALLOWED AS FILE WILL BE CHECKED
; AFTER UPLOADING INTO COTS
;
N ACRNAME,ACRVEN,ACRV0,ACRV11,ACRV13,Z,ACREIN,ACRVTYP
N ACRAMT,ACRCOR,ACRIRS,ACRPADD,ACRPTIN,ACRTYP,ACRVADD,ACRVTIN,DATA
S ACRVEN=0
F S ACRVEN=$O(^ACR1099V("C",ACRYR,ACRVEN)) Q:'ACRVEN D
. I '$D(^ACR1099V(ACRVEN,1,ACRYR)) Q
. ; START SETTING DATA STRING
. S ACRV0=$G(^AUTTVNDR(ACRVEN,0))
. S ACRV0=$$UPPER^ACRFUTL(ACRV0)
. S ACRV11=$G(^AUTTVNDR(ACRVEN,11))
. ;S ACRV13=$$UPPER^ACRFUTL(^AUTTVNDR(ACRVEN,13)) ;ACR*2.1*20.02 IM16042
. S ACRV13=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEN,13))) ;ACR*2.1*20.02 IM16042
. S ACRNAME=$$NAME(ACRV0)
. S ACREIN=$P(ACRV11,U)
. S ACRTIN=$E(ACREIN,2,10)
. S ACRTYP=$E(ACREIN,1)
. S ACRADD1=$P(ACRV13,U)
. S ACRADD2=$P(ACRV13,U,10)
. S ACRCITY=$P(ACRV13,U,2)
. ;S ACRSTAB=$$STATE^ACRFIRSU($P(ACRV13,U,3)) ;ACR*2.1*20.02 IM16042
. S ACRSTAB=$P(ACRV13,U,3) ;ACR*2.1*20.02 IM16042
. I ACRSTAB="" S ACRSTAB=56 ;UNKNOWN ;ACR*2.1*20.02 IM16042
. S ACRSTAB=$$STATE^ACRFIRSU(ACRSTAB) ;ACR*2.1*20.02 IM16042
. S ACRZIP=$P(ACRV13,U,4)
. S ACRV0=$G(^ACR1099V(ACRVEN,0))
. S ACRVTYP=$P(ACRV0,U,2)
. S ACRFOR=$P(ACRV0,U,4)
. S ACRCOR=""
. I $P($G(^ACR1099V(ACRVEN,1,ACRYR,0)),U,6)="Y" S ACRCOR="X"
. S ACRAMT=$$YTD(ACRVEN,ACRYR)
. Q:ACRAMT<600
. S Z=ACRNAME ;1 - FULL VENDOR NAME
. S Z=Z_U_$E(ACRNAME,1,4) ;2 - SHORT NAME
. S Z=Z_U_ACRTIN ;3 - VENDOR TIN
. S Z=Z_U_ACRTYP ;4 - TIN TYPE
. S Z=Z_U_ACRADD1 ;5 - ADDRESS
. S Z=Z_U_ACRADD2 ;6 - ADDRESS 2
. S Z=Z_U_ACRCITY ;7 - CITY
. S Z=Z_U_ACRSTAB ;8 - 2 CHAR STATE
. S Z=Z_U_ACRZIP ;9 - ZIP
. S Z=Z_U_ACRFOR ;10- FOREIGN ADDRESS FLAG
. I ACRVTYP=7 S Z=Z_U_ACRAMT_U_"" ;11- CY AMT 7
. I ACRVTYP=6 S Z=Z_U_""_U_ACRAMT ;12- CY AMT 6
. S Z=Z_U_ACRCOR ;13- CORRECTED FORM
. S ^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)=Z
Q
;
NAME(X) ;RETURNS VENDOR NAME
; --- INPUT
; X=DATA STRING
N Y
S Y=$P(X,U)
I $P(X,U,3)]"" S Y=$P(X,U,3) ;NAME KNOWN TO IRS
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
YTD(X,Y) ;LOCAL ENTRY
;--------------
N Z
S Z=$$YTD^ACRFIRSU(X,Y) ;11-YEAR-TO-DATE AMOUNT(6 or 7)
I Z<600 Q 0
I Z'["." S Z=Z_".00" Q Z
I $L($P(Z,".",2))=1 S Z=Z_"0"
Q Z
HDR ; SET HEADER INTO FLAT FILE
N ACRSTR
S ACRSTR="NAME"_U_"SHORT"_U_"TIN"_U_"TINTYPE"_U_"ADDRESS"
S ACRSTR=ACRSTR_U_"ADDRESS 2"_U_"CITY"_U_"STATE"_U_"ZIP"_U_"FOREIGN"
S ACRSTR=ACRSTR_U_"AMOUNT-7"_U_"AMOUNT-6"_U_"CORRECTED"
U %DEV
W $$WRITE^ACRFIRSU(ACRSTR)
W !
Q
ACRFIRSA ;IHS/OIRM/DSD/AEF/MRS - PRINT 1099s TO FLAT FILE [ 07/20/2006 4:18 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**8,13,20**;NOV 05, 2001
+2 ; NEW ROUTINE ACR*2.1*8.06
DESC ;;
+1 ;; This routine gathers vendor 1099 payment data and puts it into a
+2 ;; UNIX comma delimited file to be imported into the Convey package
+3 ;; for printing on the Convey created forms -- replaces the ACRF
+4 ;; 1099 PRINT ALL option for printing 1099's on pre-printed forms.
+5 ;;
+6 ;; NOTE: This routine assumes that all data checks and any
+7 ;; necessary edits have been made before this routine
+8 ;; is run. You will be asked if this is a test run or
+9 ;; if the Vendor file is to be updated.
+10 ;;
+11 ;; COLUMN LAYOUT:
+12 ;;
+13 ;; 1 VENDOR NAME 8 VENDOR STATE
+14 ;; 2 SHORT NAME 9 VENODR ZIP CODE
+15 ;; 3 VENDOR TIN# (9 DIGITS) 10 FOREIGN ADDRESS (1 or BLANK)
+16 ;; 4 TIN TYPE 11 CYEAR AMOUNT (BOX 7)
+17 ;; 5 VENDOR ADDRESS (LINE 1) 12 CYEAR AMOUNT (BOX 6)
+18 ;; 6 VENDOR ADDRESS(LINE 2) 13 CORRECTED (X or BLANK)
+19 ;; 7 VENDOR CITY
+20 ;;
+21 ;;$$END
+22 ;
+23 ; ACRYR = PAYMENT YEAR
+24 ; ACRNAME = VENDOR NAME
+25 ; ACRTIN = VENDOR TIN#
+26 ; ACRTYP = TIN TYPE = 2 = SSN; 1= EIN
+27 ; ACRADD1 = VENDOR ADDRESS 1
+28 ; ACRADD2 = VENDOR ADDRESS 2
+29 ; ACRCITY = VENDOR CITY
+30 ; ACRSTAB = VENDOR STATE ABBREVIATION
+31 ; ACRZIP = VENDOR ZIP CODE
+32 ; ACRFOR = FOREIGN ADDRESS = 1 if TRUE or NULL
+33 ; ACRCOR = CORRECTED FORM
+34 ; ACRVTYP = TYPE OF VENDOR (6 or 7)
+35 ; ACRAMT = VENDOR YTD PAID AMOUNT BOX 6 or 7
+36 ; ACRUP = 1 = UPDATE FILE; 2 = TEST PRINT ONLY
+37 ;
EN ;EP -- WRITE ALL VENDOR 1099S INTO FLAT FILE
+1 ;
+2 NEW ACRYR
+3 ;
+4 ;----- SET SESSION VARIABLES
DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;----- CLEAR SCREEN
DO ^XBCLS
+7 ;----- WRITE DESCRIPTION
DO TXT
+8 KILL ACROUT
+9 DO PAUSE^ACRFWARN
+10 IF $DATA(ACROUT)
QUIT
+11 ;
+12 DO ^XBCLS
+13 ;----- ASK CALENDAR YEAR
DO YR^ACRFIRSU(.ACRYR)
+14 IF '$GET(ACRYR)
QUIT
+15 ;
+16 ;----- ASK UPDATE OR TEST
SET ACRUP=$$ASKUP^ACRFIRSU
+17 IF 'ACRUP
QUIT
+18 ;
+19 DO DQ(ACRYR,ACRUP)
+20 ;
+21 DO PAUSE^ACRFWARN
+22 QUIT
+23 ;
DQ(ACRYR,ACRUP) ;
+1 ;
+2 ; INCOMING VARIABLES:
+3 ; ACRYR = CALENDAR YEAR
+4 ; ACRUP = UPDATE 1099 VENDOR FILE OR TEST PRINT
+5 ;
+6 ; OTHER VARIABLES USED:
+7 ; ACRJ = $JOB NUMBER
+8 ;
+9 NEW ACRJ
+10 ;
+11 SET ACRJ=$JOB
+12 KILL ^TMP("ACR1099",ACRJ)
+13 DO ALPHA(ACRYR,ACRJ)
+14 ;
+15 DO WRITE(ACRYR,ACRJ,ACRUP)
+16 ;
+17 QUIT
WRITE(ACRYR,ACRJ,ACRUP) ;
+1 ;----- LOOP THROUGH TMP("ACR1099" FILE AND WRITE 1099s INTO FLATE FILE
+2 ;
+3 ; INPUT:
+4 ; ACRYR = CALENDAR YEAR
+5 ; ACRJ = $JOB NUMBER
+6 ; ACRUP = UPDATE FILE FLAG
+7 ; ^TMP("ACR1099",ACRJ IS ALREADY SET
+8 ;
+9 ;ACR*2.1*8.08
NEW %DEV,ZISH1,ZISH2
+10 ;ACR*2.1*8.08,ACR*2.1*13.06 IM14144
SET ZISH1=$$ARMSDIR^ACRFSYS(1)
+11 ;ACR*2.1*8.08
IF ZISH1["alb"!(ZISH1["hqw")
Begin DoDot:1
+12 ;ACR*2.1*8.08
SET ZISH1=ZISH1_"csv/"
End DoDot:1
+13 ;ACR*2.1*8.08
SET ZISH2="vendor"_ACRYR_".csv"
+14 ;D HFS^ACRFIRSU(ZISH1,ZISH2,"W",.%DEV) ;ACR*2.1*13.06 IM14144
+15 ;ACR*2.1*13.06 IM14144
DO HFS^ACRFZISH(ZISH1,ZISH2,"W",.%DEV)
+16 IF '$DATA(%DEV)
QUIT
+17 ;
+18 NEW ACRNAME,ACRVEN,ACRCNT,ACRHDR
+19 ;
+20 SET ACRNAME=""
+21 SET ACRCNT=0
+22 DO HDR
+23 FOR
SET ACRNAME=$ORDER(^TMP("ACR1099",ACRJ,ACRNAME))
IF ACRNAME']""
QUIT
Begin DoDot:1
+24 SET ACRVEN=0
+25 FOR
SET ACRVEN=$ORDER(^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN))
IF 'ACRVEN
QUIT
Begin DoDot:2
+26 SET ACRDATA=^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)
+27 SET ACRSTR=$$WRITE^ACRFIRSU(ACRDATA)
+28 USE %DEV
+29 WRITE ACRSTR,!
+30 SET ACRCNT=ACRCNT+1
+31 IF ACRUP=1
DO UPDATE^ACRFIRSU(ACRVEN,ACRYR)
End DoDot:2
End DoDot:1
+32 USE IO(0)
WRITE !!?5,ACRCNT," records have been written into "_ZISH1_ZISH2
+33 DO CLOSE^%ZISH("FILE")
+34 ;
+35 QUIT
ALPHA(ACRYR,ACRJ) ;
+1 ;----- BUILD ALPHABETIC ARRAY OF VENDORS IN ^TMP("ACR1099",ACRJ)
+2 ;
+3 ; INPUT:
+4 ; ACRYR = CALENDAR YEAR
+5 ; ACRJ = $JOB NUMBER
+6 ; NOTE: UNPOPULATED FIELDS ARE ALLOWED AS FILE WILL BE CHECKED
+7 ; AFTER UPLOADING INTO COTS
+8 ;
+9 NEW ACRNAME,ACRVEN,ACRV0,ACRV11,ACRV13,Z,ACREIN,ACRVTYP
+10 NEW ACRAMT,ACRCOR,ACRIRS,ACRPADD,ACRPTIN,ACRTYP,ACRVADD,ACRVTIN,DATA
+11 SET ACRVEN=0
+12 FOR
SET ACRVEN=$ORDER(^ACR1099V("C",ACRYR,ACRVEN))
IF 'ACRVEN
QUIT
Begin DoDot:1
+13 IF '$DATA(^ACR1099V(ACRVEN,1,ACRYR))
QUIT
+14 ; START SETTING DATA STRING
+15 SET ACRV0=$GET(^AUTTVNDR(ACRVEN,0))
+16 SET ACRV0=$$UPPER^ACRFUTL(ACRV0)
+17 SET ACRV11=$GET(^AUTTVNDR(ACRVEN,11))
+18 ;S ACRV13=$$UPPER^ACRFUTL(^AUTTVNDR(ACRVEN,13)) ;ACR*2.1*20.02 IM16042
+19 ;ACR*2.1*20.02 IM16042
SET ACRV13=$$UPPER^ACRFUTL($GET(^AUTTVNDR(ACRVEN,13)))
+20 SET ACRNAME=$$NAME(ACRV0)
+21 SET ACREIN=$PIECE(ACRV11,U)
+22 SET ACRTIN=$EXTRACT(ACREIN,2,10)
+23 SET ACRTYP=$EXTRACT(ACREIN,1)
+24 SET ACRADD1=$PIECE(ACRV13,U)
+25 SET ACRADD2=$PIECE(ACRV13,U,10)
+26 SET ACRCITY=$PIECE(ACRV13,U,2)
+27 ;S ACRSTAB=$$STATE^ACRFIRSU($P(ACRV13,U,3)) ;ACR*2.1*20.02 IM16042
+28 ;ACR*2.1*20.02 IM16042
SET ACRSTAB=$PIECE(ACRV13,U,3)
+29 ;UNKNOWN ;ACR*2.1*20.02 IM16042
IF ACRSTAB=""
SET ACRSTAB=56
+30 ;ACR*2.1*20.02 IM16042
SET ACRSTAB=$$STATE^ACRFIRSU(ACRSTAB)
+31 SET ACRZIP=$PIECE(ACRV13,U,4)
+32 SET ACRV0=$GET(^ACR1099V(ACRVEN,0))
+33 SET ACRVTYP=$PIECE(ACRV0,U,2)
+34 SET ACRFOR=$PIECE(ACRV0,U,4)
+35 SET ACRCOR=""
+36 IF $PIECE($GET(^ACR1099V(ACRVEN,1,ACRYR,0)),U,6)="Y"
SET ACRCOR="X"
+37 SET ACRAMT=$$YTD(ACRVEN,ACRYR)
+38 IF ACRAMT<600
QUIT
+39 ;1 - FULL VENDOR NAME
SET Z=ACRNAME
+40 ;2 - SHORT NAME
SET Z=Z_U_$EXTRACT(ACRNAME,1,4)
+41 ;3 - VENDOR TIN
SET Z=Z_U_ACRTIN
+42 ;4 - TIN TYPE
SET Z=Z_U_ACRTYP
+43 ;5 - ADDRESS
SET Z=Z_U_ACRADD1
+44 ;6 - ADDRESS 2
SET Z=Z_U_ACRADD2
+45 ;7 - CITY
SET Z=Z_U_ACRCITY
+46 ;8 - 2 CHAR STATE
SET Z=Z_U_ACRSTAB
+47 ;9 - ZIP
SET Z=Z_U_ACRZIP
+48 ;10- FOREIGN ADDRESS FLAG
SET Z=Z_U_ACRFOR
+49 ;11- CY AMT 7
IF ACRVTYP=7
SET Z=Z_U_ACRAMT_U_""
+50 ;12- CY AMT 6
IF ACRVTYP=6
SET Z=Z_U_""_U_ACRAMT
+51 ;13- CORRECTED FORM
SET Z=Z_U_ACRCOR
+52 SET ^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)=Z
End DoDot:1
+53 QUIT
+54 ;
NAME(X) ;RETURNS VENDOR NAME
+1 ; --- INPUT
+2 ; X=DATA STRING
+3 NEW Y
+4 SET Y=$PIECE(X,U)
+5 ;NAME KNOWN TO IRS
IF $PIECE(X,U,3)]""
SET Y=$PIECE(X,U,3)
+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
YTD(X,Y) ;LOCAL ENTRY
+1 ;--------------
+2 NEW Z
+3 ;11-YEAR-TO-DATE AMOUNT(6 or 7)
SET Z=$$YTD^ACRFIRSU(X,Y)
+4 IF Z<600
QUIT 0
+5 IF Z'["."
SET Z=Z_".00"
QUIT Z
+6 IF $LENGTH($PIECE(Z,".",2))=1
SET Z=Z_"0"
+7 QUIT Z
HDR ; SET HEADER INTO FLAT FILE
+1 NEW ACRSTR
+2 SET ACRSTR="NAME"_U_"SHORT"_U_"TIN"_U_"TINTYPE"_U_"ADDRESS"
+3 SET ACRSTR=ACRSTR_U_"ADDRESS 2"_U_"CITY"_U_"STATE"_U_"ZIP"_U_"FOREIGN"
+4 SET ACRSTR=ACRSTR_U_"AMOUNT-7"_U_"AMOUNT-6"_U_"CORRECTED"
+5 USE %DEV
+6 WRITE $$WRITE^ACRFIRSU(ACRSTR)
+7 WRITE !
+8 QUIT
