- ACRFIRS2 ;IHS/OIRM/DSD/AEF - 1099 RECORD A,B,C,F,T LAYOUTS; [ 07/20/2006 3:48 PM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1,6,8,20**;NOV 05, 2001
- ;
- ; This routine is called by ACRFIRS1 to format 1099 record data
- ; into a ^TMP global using the record layouts specified in
- ; Department of the Treasury Internal Revenue Service
- ; Publication 1220 Catalog Number 61275P.
- ; Variables are set by ACRFIRS1.
- ; Note: All Apha characters must be in upper case
- ; EXCEPT e-mail addresses that might be case sensitive
- Q
- ;RECORDC, RECORDF, RECORDT SUBROUTINES MOVED TO ACRFIRS0;ACR*2.1*8.07
- ;
- RECORDA(ACRAREA,ACRPMYR,ACRCNTA) ;EP
- ;----- CREATE RECORD TYPE A (PAYER)
- ;
- ;LAYOUT
- ;1 - 1 "A" 52 - 52 FOREIGN ENTITY INDICATOR
- ;2 - 5 YEAR 53 - 92 FIRST PAYER NAME LINE
- ;6 - 11 BLANK 93 -132 SECOND PAYER NAME LINE
- ;12 - 20 PAYER'S TIN# 133-133 TRANSFER AGENT INDICATOR
- ;21 - 24 PAYER NAME CONTROL 134-173 PAYER SHIPPING ADDRESS
- ;25 - 25 LAST FILING INDICATOR 174-213 PAYER CITY
- ;26 - 26 COMB FED/STATE FILER 214-215 PAYER STATE
- ;27 - 27 TYPE OF RETURN 216-224 PAYER ZIP CODE
- ;28 - 41 AMOUNT CODES ;ACR*2.1*8.01
- ;42 - 47 BLANK ;ARC*2.1*8.01 225-239 PAYER'S PHONE & EXT
- ;48 - 48 ORIGINAL FILE IND 240-499 BLANK ;ACR*2.1*6.01
- ;49 - 49 REPLACEMENT FILE IND 500-507 RECORD SEQUENCE # ;ACR*2.1*6.01
- ;50 - 50 CORRECTION FILE IND 508-748 BLANK ;ACR*2.1*6.01
- ;51 - 51 BLANK 749-750 BLANK OR CR/LF ;ACR*2.1*6.01
- ;
- ; INPUT:
- ; ACRAREA = PAYER NAME
- ; ACRPMYR = PAYMENT CALENDAR YEAR
- ;
- ; RETURNS:
- ; ACRCNTA = RECORD A COUNT
- ;
- N DATA,I,X,Z
- S DATA=$$UPPER^ACRFUTL(^ACR1099P(ACRAREA,0)) ; ACR*2.1*6.02
- S $E(Z)="A"
- S $E(Z,2,5)=ACRPMYR
- S $E(Z,6,11)=$$PAD^ACRFUTL("","R",6,"")
- S $E(Z,12,20)=$P(DATA,U,8)
- S $E(Z,21,24)=$$PAD^ACRFUTL($P(DATA,U,9),"R",4,"")
- S $E(Z,25)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,26)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,27)="A"
- S $E(Z,28,41)=$$PAD^ACRFUTL($P(DATA,U,11),"R",14,"") ;ACR*2.1*8.01
- S $E(Z,42,47)=$$PAD^ACRFUTL("","R",6,"") ;ACR*2.1*8.01
- ;S $E(Z,28,39)=$$PAD^ACRFUTL($P(DATA,U,11),"R",12,"") ;ACR*2.1*20.11 IM19398
- ;S $E(Z,40,47)=$$PAD^ACRFUTL("","R",8,"") ;ACR*2.1*20.11 IM19398
- S $E(Z,48)=1
- S $E(Z,49)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,50)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,51)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,52)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,53,92)=$$PAD^ACRFUTL($P(DATA,U,2),"R",40,"")
- S $E(Z,93,132)=$$PAD^ACRFUTL($P(DATA,U,3),"R",40,"")
- S $E(Z,133)=0
- S $E(Z,134,173)=$$PAD^ACRFUTL($P(DATA,U,4),"R",40,"")
- S $E(Z,174,213)=$$PAD^ACRFUTL($P(DATA,U,5),"R",40,"")
- S $E(Z,214,215)=$P($G(^DIC(5,$P(DATA,U,6),0)),U,2)
- S $E(Z,216,224)=$$PAD^ACRFUTL($TR($P(DATA,U,7),"-",""),"R",9,"")
- S $E(Z,225,239)=$$PAD^ACRFUTL($P(DATA,U,12),"R",15,"")
- S $E(Z,240,499)=$$PAD^ACRFUTL("","R",260,"") ;ACR*2.1*6.01
- S $E(Z,500,507)=$$PAD^ACRFUTL(2,"L",8,0) ;"A"RECORD ALWAYS 2 ;ACR*2.1*6.01
- S $E(Z,508,748)=$$PAD^ACRFUTL("","R",241,"") ;ACR*2.1*6.01
- S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"") ;ACR*2.1*6.01
- S ACRCNTA=$G(ACRCNTA)+1
- ;
- S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,1)=$E(Z,1,240)
- S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,2)=$E(Z,241,480)
- S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,3)=$E(Z,481,720)
- S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,4)=$E(Z,721,750)
- Q
- RECORDB(ACRPMYR,ACRNAME,ACRTIN,ACRVEND0,ACRAMT,ACRAMTCD,ACRADD,ACRCITY,ACRSTAB,ACRZIP,ACRCNTB,ACRTOT,ACRCNTR,ACRFOR) ;EP ;ACR*2.1*6.01,ACR*2.1*8.05
- ;----- CREATE RECORD TYPE B (PAYEE)
- ; FOR 1099-MISC
- ;LAYOUT:
- ;1 - 1 "B" 247-247 FOREIGN COUNTRY INDICATOR
- ;2 - 5 PAYMENT YEAR 248-287 FIRST PAYEE NAME LINE
- ;6 - 6 CORRECTED RETURN IND 288-327 SECOND PAYEE NAME LINE
- ;7 - 10 NAME CONTROL 328-367 BLANK
- ;11 - 11 TYPE OF TIN 368-407 PAYEE MAILING ADDRESS
- ;12 - 20 PAYEE'S TIN 408-447 BLANK
- ;21 - 40 PAYER'S ACCOUNT NO 448-487 PAYEE CITY
- ;41 - 44 PAYER'S OFFICE CODE 488-489 PAYEE STATE
- ;45 - 54 BLANK 490-498 PAYEE ZIP CODE
- ;55 - 66 PAYMENT AMOUNT 1 499-499 BLANK ;ACR*2.1*6.01
- ;67 - 78 PAYMENT AMOUNT 2 500-507 RECORD SEQUENCE NUMBER ;ACR*2.1*6.01
- ;79 - 90 PAYMENT AMOUNT 3 508-543 BLANK ;ACR*2.1*6.01
- ;91 -102 PAYMENT AMOUNT 4 544-544 SECOND TIN NOTICE (OPTIONAL) ;ACR*2.1*6.01
- ;103-114 PAYMENT AMOUNT 5 545-546 BLANKS ;ACR*2.1*6.01
- ;115-126 PAYMENT AMOUNT 6 547-547 DIRECT SALES INDICATOR ;ACR*2.1*6.01
- ;127-138 PAYMENT AMOUNT 7 545-546 BLANKS
- ;139-150 PAYMENT AMOUNT 8 547-547 DIRECT SALES INDICATOR
- ;151-162 PAYMENT AMOUNT 9 548-662 BLANK
- ;163-174 PAYMENT AMOUNT A 663-722 SPECIAL DATA ENTRIES
- ;175-186 PAYMENT AMOUNT B ;ACR*2.1*8.02
- ; 723-734 STATE INCOME TAX WITHHELD
- ;187-198 PAYMENT AMOUNT C 735-746 LOCAL INCOME TAX WITHHELD
- ;199-210 PAYMENT AMOUNT D (BLANK FOR 1099) ;ACR*2.1*8.02
- ; 747-748 COMBINED FEDERAL/STATE CODE
- ;211-222 PAYMENT AMOUNT E (BLANK FOR 1099) ;ACR*2.1*8.02
- ; 749-750 BLANK
- ;223-246 RESERVED (BLANK) ;ACR*2.1*8.02
- ;
- ; INPUT:
- ; ACRPMYR = PAYMENT CALENDAR YEAR
- ; ACRNAME = PAYEE NAME
- ; ACRTIN = PAYEE TAX ID NUMBER
- ; ACRVEND0 = VENDOR IEN
- ; ACRAMT = PAYMENT AMOUNT
- ; ACRAMTCD = PAYMENT AMOUNT CODE
- ; ACRADD = PAYEE ADDRESS
- ; ACRCITY = PAYEE CITY
- ; ACRSTAB = PAYEE STATE
- ; ACRZIP = PAYEE ZIP
- ; ACRCNTR = RECORD SEQUENCE NUMBER ; ACR*2.1*6.01
- ;
- ; RETURNS:
- ; ACRCNTB = RECORD B COUNT
- ; ACRCNTR = RECORD SEQUENCE COUNT ; ACR*2.1*6.01
- ; ACRTOT( = ARRAY CONTAINING PAYMENT AMOUNT CODE TOTALS
- ;
- N I,X,Z,ACRTMP
- S ACRCNTR=ACRCNTR+1 ;ACR*2.1*6.01
- S $E(Z)="B"
- S $E(Z,2,5)=ACRPMYR
- S $E(Z,6)=$$PAD^ACRFUTL("","R",1,"") ;corrected return indicator
- S $E(Z,7,10)=$$PAD^ACRFUTL($$NCTL^ACRFIRS1(ACRNAME),"R",4,"")
- S $E(Z,11)=$E(ACRTIN)
- S $E(Z,12,20)=$E(ACRTIN,2,10)
- S ACRTMP=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEND0,19))) ;ACR*2.1*6.01
- S $E(Z,21,40)=$$PAD^ACRFUTL($P(ACRTMP,U,3),"R",20,"") ;ACR*2.1*6.01
- S $E(Z,41,44)=$$PAD^ACRFUTL("","R",4,"")
- S $E(Z,45,54)=$$PAD^ACRFUTL("","R",10,"")
- S $E(Z,55,198)=$$PAD^ACRFUTL(0,"L",144,0)
- S ACRAMT=$$PAD^ACRFUTL(+ACRAMT,"L",12,0)
- I ACRAMTCD[1 D
- . S ACRTOT(1)=$G(ACRTOT(1))+ACRAMT
- . S $E(Z,55,66)=ACRAMT
- I ACRAMTCD[2 D
- . S ACRTOT(2)=$G(ACRTOT(2))+ACRAMT
- . S $E(Z,67,78)=ACRAMT
- I ACRAMTCD[3 D
- . S ACRTOT(3)=$G(ACRTOT(3))+ACRAMT
- . S $E(Z,79,90)=ACRAMT
- I ACRAMTCD[4 D
- . S ACRTOT(4)=$G(ACRTOT(4))+ACRAMT
- . S $E(Z,91,102)=ACRAMT
- I ACRAMTCD[5 D
- . S ACRTOT(5)=$G(ACRTOT(5))+ACRAMT
- . S $E(Z,103,114)=ACRAMT
- I ACRAMTCD[6 D
- . S ACRTOT(6)=$G(ACRTOT(6))+ACRAMT
- . S $E(Z,115,126)=ACRAMT
- I ACRAMTCD[7 D
- . S ACRTOT(7)=$G(ACRTOT(7))+ACRAMT
- . S $E(Z,127,138)=ACRAMT
- I ACRAMTCD[8 D
- . S ACRTOT(8)=$G(ACRTOT(8))+ACRAMT
- . S $E(Z,139,150)=ACRAMT
- I ACRAMTCD[9 D
- . S ACRTOT(9)=$G(ACRTOT(9))+ACRAMT
- . S $E(Z,151,162)=ACRAMT
- I ACRAMTCD["A" D
- . S ACRTOT("A")=$G(ACRTOT("A"))+ACRAMT
- . S $E(Z,163,174)=ACRAMT
- I ACRAMTCD["B" D
- . S ACRTOT("B")=$G(ACRTOT("B"))+ACRAMT
- . S $E(Z,175,186)=ACRAMT
- I ACRAMTCD["C" D
- . S ACRTOT("C")=$G(ACRTOT("C"))+ACRAMT
- . S $E(Z,187,198)=ACRAMT
- S $E(Z,199,210)=$$PAD^ACRFUTL("","R",12,"") ;ACR*2.1*8.02
- S $E(Z,211,222)=$$PAD^ACRFUTL("","R",12,"") ;ACR*2.1*8.02
- S $E(Z,223,246)=$$PAD^ACRFUTL("","R",24,"") ;ACR*2.1*8.02
- S $E(Z,247)=$$PAD^ACRFUTL(ACRFOR,"R",1,"") ;ACR*2.1*8.05
- S $E(Z,248,287)=$$PAD^ACRFUTL(ACRNAME,"R",40,"")
- S $E(Z,288,327)=$$PAD^ACRFUTL("","R",40,"")
- S $E(Z,328,367)=$$PAD^ACRFUTL("","R",40,"")
- S $E(Z,368,407)=$$PAD^ACRFUTL(ACRADD,"R",40,"")
- S $E(Z,408,447)=$$PAD^ACRFUTL("","R",40,"")
- S $E(Z,448,487)=$$PAD^ACRFUTL(ACRCITY,"R",40,"")
- S $E(Z,488,489)=ACRSTAB
- S $E(Z,490,498)=$$PAD^ACRFUTL($TR(ACRZIP,"-",""),"R",9,"")
- S $E(Z,499)="" ;ACR*2.1*6.01
- S $E(Z,500,507)=$$PAD^ACRFUTL(ACRCNTR,"L",8,0) ;ACR*2.1*6.01
- S $E(Z,508,543)=$$PAD^ACRFUTL("","R",36,"") ;ACR*2.1*6.01
- S $E(Z,544)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,545,546)=$$PAD^ACRFUTL("","R",2,"")
- S $E(Z,547)=$$PAD^ACRFUTL("","R",1,"")
- S $E(Z,548,662)=$$PAD^ACRFUTL("","R",115,"")
- S $E(Z,663,722)=$$PAD^ACRFUTL("","R",60,"")
- S $E(Z,723,734)=$$PAD^ACRFUTL(0,"L",12,0)
- S $E(Z,735,746)=$$PAD^ACRFUTL(0,"L",12,0)
- S $E(Z,747,748)=$$PAD^ACRFUTL("","R",2,"")
- S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
- S ACRCNTB=$G(ACRCNTB)+1
- ;
- S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,1)=$E(Z,1,240)
- S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,2)=$E(Z,241,480)
- S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,3)=$E(Z,481,720)
- S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,4)=$E(Z,721,750)
- Q
- ACRFIRS2 ;IHS/OIRM/DSD/AEF - 1099 RECORD A,B,C,F,T LAYOUTS; [ 07/20/2006 3:48 PM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1,6,8,20**;NOV 05, 2001
- +2 ;
- +3 ; This routine is called by ACRFIRS1 to format 1099 record data
- +4 ; into a ^TMP global using the record layouts specified in
- +5 ; Department of the Treasury Internal Revenue Service
- +6 ; Publication 1220 Catalog Number 61275P.
- +7 ; Variables are set by ACRFIRS1.
- +8 ; Note: All Apha characters must be in upper case
- +9 ; EXCEPT e-mail addresses that might be case sensitive
- +10 QUIT
- +11 ;RECORDC, RECORDF, RECORDT SUBROUTINES MOVED TO ACRFIRS0;ACR*2.1*8.07
- +12 ;
- RECORDA(ACRAREA,ACRPMYR,ACRCNTA) ;EP
- +1 ;----- CREATE RECORD TYPE A (PAYER)
- +2 ;
- +3 ;LAYOUT
- +4 ;1 - 1 "A" 52 - 52 FOREIGN ENTITY INDICATOR
- +5 ;2 - 5 YEAR 53 - 92 FIRST PAYER NAME LINE
- +6 ;6 - 11 BLANK 93 -132 SECOND PAYER NAME LINE
- +7 ;12 - 20 PAYER'S TIN# 133-133 TRANSFER AGENT INDICATOR
- +8 ;21 - 24 PAYER NAME CONTROL 134-173 PAYER SHIPPING ADDRESS
- +9 ;25 - 25 LAST FILING INDICATOR 174-213 PAYER CITY
- +10 ;26 - 26 COMB FED/STATE FILER 214-215 PAYER STATE
- +11 ;27 - 27 TYPE OF RETURN 216-224 PAYER ZIP CODE
- +12 ;28 - 41 AMOUNT CODES ;ACR*2.1*8.01
- +13 ;42 - 47 BLANK ;ARC*2.1*8.01 225-239 PAYER'S PHONE & EXT
- +14 ;48 - 48 ORIGINAL FILE IND 240-499 BLANK ;ACR*2.1*6.01
- +15 ;49 - 49 REPLACEMENT FILE IND 500-507 RECORD SEQUENCE # ;ACR*2.1*6.01
- +16 ;50 - 50 CORRECTION FILE IND 508-748 BLANK ;ACR*2.1*6.01
- +17 ;51 - 51 BLANK 749-750 BLANK OR CR/LF ;ACR*2.1*6.01
- +18 ;
- +19 ; INPUT:
- +20 ; ACRAREA = PAYER NAME
- +21 ; ACRPMYR = PAYMENT CALENDAR YEAR
- +22 ;
- +23 ; RETURNS:
- +24 ; ACRCNTA = RECORD A COUNT
- +25 ;
- +26 NEW DATA,I,X,Z
- +27 ; ACR*2.1*6.02
- SET DATA=$$UPPER^ACRFUTL(^ACR1099P(ACRAREA,0))
- +28 SET $EXTRACT(Z)="A"
- +29 SET $EXTRACT(Z,2,5)=ACRPMYR
- +30 SET $EXTRACT(Z,6,11)=$$PAD^ACRFUTL("","R",6,"")
- +31 SET $EXTRACT(Z,12,20)=$PIECE(DATA,U,8)
- +32 SET $EXTRACT(Z,21,24)=$$PAD^ACRFUTL($PIECE(DATA,U,9),"R",4,"")
- +33 SET $EXTRACT(Z,25)=$$PAD^ACRFUTL("","R",1,"")
- +34 SET $EXTRACT(Z,26)=$$PAD^ACRFUTL("","R",1,"")
- +35 SET $EXTRACT(Z,27)="A"
- +36 ;ACR*2.1*8.01
- SET $EXTRACT(Z,28,41)=$$PAD^ACRFUTL($PIECE(DATA,U,11),"R",14,"")
- +37 ;ACR*2.1*8.01
- SET $EXTRACT(Z,42,47)=$$PAD^ACRFUTL("","R",6,"")
- +38 ;S $E(Z,28,39)=$$PAD^ACRFUTL($P(DATA,U,11),"R",12,"") ;ACR*2.1*20.11 IM19398
- +39 ;S $E(Z,40,47)=$$PAD^ACRFUTL("","R",8,"") ;ACR*2.1*20.11 IM19398
- +40 SET $EXTRACT(Z,48)=1
- +41 SET $EXTRACT(Z,49)=$$PAD^ACRFUTL("","R",1,"")
- +42 SET $EXTRACT(Z,50)=$$PAD^ACRFUTL("","R",1,"")
- +43 SET $EXTRACT(Z,51)=$$PAD^ACRFUTL("","R",1,"")
- +44 SET $EXTRACT(Z,52)=$$PAD^ACRFUTL("","R",1,"")
- +45 SET $EXTRACT(Z,53,92)=$$PAD^ACRFUTL($PIECE(DATA,U,2),"R",40,"")
- +46 SET $EXTRACT(Z,93,132)=$$PAD^ACRFUTL($PIECE(DATA,U,3),"R",40,"")
- +47 SET $EXTRACT(Z,133)=0
- +48 SET $EXTRACT(Z,134,173)=$$PAD^ACRFUTL($PIECE(DATA,U,4),"R",40,"")
- +49 SET $EXTRACT(Z,174,213)=$$PAD^ACRFUTL($PIECE(DATA,U,5),"R",40,"")
- +50 SET $EXTRACT(Z,214,215)=$PIECE($GET(^DIC(5,$PIECE(DATA,U,6),0)),U,2)
- +51 SET $EXTRACT(Z,216,224)=$$PAD^ACRFUTL($TRANSLATE($PIECE(DATA,U,7),"-",""),"R",9,"")
- +52 SET $EXTRACT(Z,225,239)=$$PAD^ACRFUTL($PIECE(DATA,U,12),"R",15,"")
- +53 ;ACR*2.1*6.01
- SET $EXTRACT(Z,240,499)=$$PAD^ACRFUTL("","R",260,"")
- +54 ;"A"RECORD ALWAYS 2 ;ACR*2.1*6.01
- SET $EXTRACT(Z,500,507)=$$PAD^ACRFUTL(2,"L",8,0)
- +55 ;ACR*2.1*6.01
- SET $EXTRACT(Z,508,748)=$$PAD^ACRFUTL("","R",241,"")
- +56 ;ACR*2.1*6.01
- SET $EXTRACT(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
- +57 SET ACRCNTA=$GET(ACRCNTA)+1
- +58 ;
- +59 SET ^TMP("ACRZ",$JOB,"RECORD","A",ACRAREA,1)=$EXTRACT(Z,1,240)
- +60 SET ^TMP("ACRZ",$JOB,"RECORD","A",ACRAREA,2)=$EXTRACT(Z,241,480)
- +61 SET ^TMP("ACRZ",$JOB,"RECORD","A",ACRAREA,3)=$EXTRACT(Z,481,720)
- +62 SET ^TMP("ACRZ",$JOB,"RECORD","A",ACRAREA,4)=$EXTRACT(Z,721,750)
- +63 QUIT
- RECORDB(ACRPMYR,ACRNAME,ACRTIN,ACRVEND0,ACRAMT,ACRAMTCD,ACRADD,ACRCITY,ACRSTAB,ACRZIP,ACRCNTB,ACRTOT,ACRCNTR,ACRFOR) ;EP ;ACR*2.1*6.01,ACR*2.1*8.05
- +1 ;----- CREATE RECORD TYPE B (PAYEE)
- +2 ; FOR 1099-MISC
- +3 ;LAYOUT:
- +4 ;1 - 1 "B" 247-247 FOREIGN COUNTRY INDICATOR
- +5 ;2 - 5 PAYMENT YEAR 248-287 FIRST PAYEE NAME LINE
- +6 ;6 - 6 CORRECTED RETURN IND 288-327 SECOND PAYEE NAME LINE
- +7 ;7 - 10 NAME CONTROL 328-367 BLANK
- +8 ;11 - 11 TYPE OF TIN 368-407 PAYEE MAILING ADDRESS
- +9 ;12 - 20 PAYEE'S TIN 408-447 BLANK
- +10 ;21 - 40 PAYER'S ACCOUNT NO 448-487 PAYEE CITY
- +11 ;41 - 44 PAYER'S OFFICE CODE 488-489 PAYEE STATE
- +12 ;45 - 54 BLANK 490-498 PAYEE ZIP CODE
- +13 ;55 - 66 PAYMENT AMOUNT 1 499-499 BLANK ;ACR*2.1*6.01
- +14 ;67 - 78 PAYMENT AMOUNT 2 500-507 RECORD SEQUENCE NUMBER ;ACR*2.1*6.01
- +15 ;79 - 90 PAYMENT AMOUNT 3 508-543 BLANK ;ACR*2.1*6.01
- +16 ;91 -102 PAYMENT AMOUNT 4 544-544 SECOND TIN NOTICE (OPTIONAL) ;ACR*2.1*6.01
- +17 ;103-114 PAYMENT AMOUNT 5 545-546 BLANKS ;ACR*2.1*6.01
- +18 ;115-126 PAYMENT AMOUNT 6 547-547 DIRECT SALES INDICATOR ;ACR*2.1*6.01
- +19 ;127-138 PAYMENT AMOUNT 7 545-546 BLANKS
- +20 ;139-150 PAYMENT AMOUNT 8 547-547 DIRECT SALES INDICATOR
- +21 ;151-162 PAYMENT AMOUNT 9 548-662 BLANK
- +22 ;163-174 PAYMENT AMOUNT A 663-722 SPECIAL DATA ENTRIES
- +23 ;175-186 PAYMENT AMOUNT B ;ACR*2.1*8.02
- +24 ; 723-734 STATE INCOME TAX WITHHELD
- +25 ;187-198 PAYMENT AMOUNT C 735-746 LOCAL INCOME TAX WITHHELD
- +26 ;199-210 PAYMENT AMOUNT D (BLANK FOR 1099) ;ACR*2.1*8.02
- +27 ; 747-748 COMBINED FEDERAL/STATE CODE
- +28 ;211-222 PAYMENT AMOUNT E (BLANK FOR 1099) ;ACR*2.1*8.02
- +29 ; 749-750 BLANK
- +30 ;223-246 RESERVED (BLANK) ;ACR*2.1*8.02
- +31 ;
- +32 ; INPUT:
- +33 ; ACRPMYR = PAYMENT CALENDAR YEAR
- +34 ; ACRNAME = PAYEE NAME
- +35 ; ACRTIN = PAYEE TAX ID NUMBER
- +36 ; ACRVEND0 = VENDOR IEN
- +37 ; ACRAMT = PAYMENT AMOUNT
- +38 ; ACRAMTCD = PAYMENT AMOUNT CODE
- +39 ; ACRADD = PAYEE ADDRESS
- +40 ; ACRCITY = PAYEE CITY
- +41 ; ACRSTAB = PAYEE STATE
- +42 ; ACRZIP = PAYEE ZIP
- +43 ; ACRCNTR = RECORD SEQUENCE NUMBER ; ACR*2.1*6.01
- +44 ;
- +45 ; RETURNS:
- +46 ; ACRCNTB = RECORD B COUNT
- +47 ; ACRCNTR = RECORD SEQUENCE COUNT ; ACR*2.1*6.01
- +48 ; ACRTOT( = ARRAY CONTAINING PAYMENT AMOUNT CODE TOTALS
- +49 ;
- +50 NEW I,X,Z,ACRTMP
- +51 ;ACR*2.1*6.01
- SET ACRCNTR=ACRCNTR+1
- +52 SET $EXTRACT(Z)="B"
- +53 SET $EXTRACT(Z,2,5)=ACRPMYR
- +54 ;corrected return indicator
- SET $EXTRACT(Z,6)=$$PAD^ACRFUTL("","R",1,"")
- +55 SET $EXTRACT(Z,7,10)=$$PAD^ACRFUTL($$NCTL^ACRFIRS1(ACRNAME),"R",4,"")
- +56 SET $EXTRACT(Z,11)=$EXTRACT(ACRTIN)
- +57 SET $EXTRACT(Z,12,20)=$EXTRACT(ACRTIN,2,10)
- +58 ;ACR*2.1*6.01
- SET ACRTMP=$$UPPER^ACRFUTL($GET(^AUTTVNDR(ACRVEND0,19)))
- +59 ;ACR*2.1*6.01
- SET $EXTRACT(Z,21,40)=$$PAD^ACRFUTL($PIECE(ACRTMP,U,3),"R",20,"")
- +60 SET $EXTRACT(Z,41,44)=$$PAD^ACRFUTL("","R",4,"")
- +61 SET $EXTRACT(Z,45,54)=$$PAD^ACRFUTL("","R",10,"")
- +62 SET $EXTRACT(Z,55,198)=$$PAD^ACRFUTL(0,"L",144,0)
- +63 SET ACRAMT=$$PAD^ACRFUTL(+ACRAMT,"L",12,0)
- +64 IF ACRAMTCD[1
- Begin DoDot:1
- +65 SET ACRTOT(1)=$GET(ACRTOT(1))+ACRAMT
- +66 SET $EXTRACT(Z,55,66)=ACRAMT
- End DoDot:1
- +67 IF ACRAMTCD[2
- Begin DoDot:1
- +68 SET ACRTOT(2)=$GET(ACRTOT(2))+ACRAMT
- +69 SET $EXTRACT(Z,67,78)=ACRAMT
- End DoDot:1
- +70 IF ACRAMTCD[3
- Begin DoDot:1
- +71 SET ACRTOT(3)=$GET(ACRTOT(3))+ACRAMT
- +72 SET $EXTRACT(Z,79,90)=ACRAMT
- End DoDot:1
- +73 IF ACRAMTCD[4
- Begin DoDot:1
- +74 SET ACRTOT(4)=$GET(ACRTOT(4))+ACRAMT
- +75 SET $EXTRACT(Z,91,102)=ACRAMT
- End DoDot:1
- +76 IF ACRAMTCD[5
- Begin DoDot:1
- +77 SET ACRTOT(5)=$GET(ACRTOT(5))+ACRAMT
- +78 SET $EXTRACT(Z,103,114)=ACRAMT
- End DoDot:1
- +79 IF ACRAMTCD[6
- Begin DoDot:1
- +80 SET ACRTOT(6)=$GET(ACRTOT(6))+ACRAMT
- +81 SET $EXTRACT(Z,115,126)=ACRAMT
- End DoDot:1
- +82 IF ACRAMTCD[7
- Begin DoDot:1
- +83 SET ACRTOT(7)=$GET(ACRTOT(7))+ACRAMT
- +84 SET $EXTRACT(Z,127,138)=ACRAMT
- End DoDot:1
- +85 IF ACRAMTCD[8
- Begin DoDot:1
- +86 SET ACRTOT(8)=$GET(ACRTOT(8))+ACRAMT
- +87 SET $EXTRACT(Z,139,150)=ACRAMT
- End DoDot:1
- +88 IF ACRAMTCD[9
- Begin DoDot:1
- +89 SET ACRTOT(9)=$GET(ACRTOT(9))+ACRAMT
- +90 SET $EXTRACT(Z,151,162)=ACRAMT
- End DoDot:1
- +91 IF ACRAMTCD["A"
- Begin DoDot:1
- +92 SET ACRTOT("A")=$GET(ACRTOT("A"))+ACRAMT
- +93 SET $EXTRACT(Z,163,174)=ACRAMT
- End DoDot:1
- +94 IF ACRAMTCD["B"
- Begin DoDot:1
- +95 SET ACRTOT("B")=$GET(ACRTOT("B"))+ACRAMT
- +96 SET $EXTRACT(Z,175,186)=ACRAMT
- End DoDot:1
- +97 IF ACRAMTCD["C"
- Begin DoDot:1
- +98 SET ACRTOT("C")=$GET(ACRTOT("C"))+ACRAMT
- +99 SET $EXTRACT(Z,187,198)=ACRAMT
- End DoDot:1
- +100 ;ACR*2.1*8.02
- SET $EXTRACT(Z,199,210)=$$PAD^ACRFUTL("","R",12,"")
- +101 ;ACR*2.1*8.02
- SET $EXTRACT(Z,211,222)=$$PAD^ACRFUTL("","R",12,"")
- +102 ;ACR*2.1*8.02
- SET $EXTRACT(Z,223,246)=$$PAD^ACRFUTL("","R",24,"")
- +103 ;ACR*2.1*8.05
- SET $EXTRACT(Z,247)=$$PAD^ACRFUTL(ACRFOR,"R",1,"")
- +104 SET $EXTRACT(Z,248,287)=$$PAD^ACRFUTL(ACRNAME,"R",40,"")
- +105 SET $EXTRACT(Z,288,327)=$$PAD^ACRFUTL("","R",40,"")
- +106 SET $EXTRACT(Z,328,367)=$$PAD^ACRFUTL("","R",40,"")
- +107 SET $EXTRACT(Z,368,407)=$$PAD^ACRFUTL(ACRADD,"R",40,"")
- +108 SET $EXTRACT(Z,408,447)=$$PAD^ACRFUTL("","R",40,"")
- +109 SET $EXTRACT(Z,448,487)=$$PAD^ACRFUTL(ACRCITY,"R",40,"")
- +110 SET $EXTRACT(Z,488,489)=ACRSTAB
- +111 SET $EXTRACT(Z,490,498)=$$PAD^ACRFUTL($TRANSLATE(ACRZIP,"-",""),"R",9,"")
- +112 ;ACR*2.1*6.01
- SET $EXTRACT(Z,499)=""
- +113 ;ACR*2.1*6.01
- SET $EXTRACT(Z,500,507)=$$PAD^ACRFUTL(ACRCNTR,"L",8,0)
- +114 ;ACR*2.1*6.01
- SET $EXTRACT(Z,508,543)=$$PAD^ACRFUTL("","R",36,"")
- +115 SET $EXTRACT(Z,544)=$$PAD^ACRFUTL("","R",1,"")
- +116 SET $EXTRACT(Z,545,546)=$$PAD^ACRFUTL("","R",2,"")
- +117 SET $EXTRACT(Z,547)=$$PAD^ACRFUTL("","R",1,"")
- +118 SET $EXTRACT(Z,548,662)=$$PAD^ACRFUTL("","R",115,"")
- +119 SET $EXTRACT(Z,663,722)=$$PAD^ACRFUTL("","R",60,"")
- +120 SET $EXTRACT(Z,723,734)=$$PAD^ACRFUTL(0,"L",12,0)
- +121 SET $EXTRACT(Z,735,746)=$$PAD^ACRFUTL(0,"L",12,0)
- +122 SET $EXTRACT(Z,747,748)=$$PAD^ACRFUTL("","R",2,"")
- +123 SET $EXTRACT(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
- +124 SET ACRCNTB=$GET(ACRCNTB)+1
- +125 ;
- +126 SET ^TMP("ACRZ",$JOB,"RECORD","B",ACRAREA,ACRVEND0,1)=$EXTRACT(Z,1,240)
- +127 SET ^TMP("ACRZ",$JOB,"RECORD","B",ACRAREA,ACRVEND0,2)=$EXTRACT(Z,241,480)
- +128 SET ^TMP("ACRZ",$JOB,"RECORD","B",ACRAREA,ACRVEND0,3)=$EXTRACT(Z,481,720)
- +129 SET ^TMP("ACRZ",$JOB,"RECORD","B",ACRAREA,ACRVEND0,4)=$EXTRACT(Z,721,750)
- +130 QUIT
