ACRFIRS0 ;IHS/OIRM/DSD/AEF - 1099 RECORD A,B,C,F,T LAYOUTS; [ 02/13/2004 9:40 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**1,6,8**;NOV 05, 2001
; NEW ROUTINE CREATED FROM ACRFIRS2; ACR*2.1*8
;
; 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(ACRAREA,ACRTOT,ACRCNTB,ACRCNTR) ;EP ;ACR*2.1*6.01
;----- CREATE RECORD TYPE C (END OF PAYER)
;
;LAYOUT
;1 - 1 "C" 160-177 CONTROL TOTAL 9
;2 - 9 NUMBER OF PAYEES 178-195 CONTROL TOTAL A
;10 - 15 BLANK 196-213 CONTROL TOTAL B
;16 - 33 CONTROL TOTAL 1 214-231 CONTROL TOTAL C
;34 - 51 CONTROL TOTAL 2 232-249 CONTROL TOTAL D ;ACR*2.1*8.01
;52 - 69 CONTROL TOTAL 3 250-267 CONTROL TOTAL E ;ACR*2.1*8.01
;70 - 87 CONTROL TOTAL 4 268-449 BLANK ;ACR*2.1*8.01
;88 -105 CONTROL TOTAL 5 500-507 RECORD SEQUENCE# ;ACR*2.1*6.01
;106-123 CONTROL TOTAL 6 508-748 BLANK ;ACR*2.1*6.01
;124-141 CONTROL TOTAL 7 749-750 BLANK ;ACR*2.1*6.01
;142-159 CONTROL TOTAL 8
;
; INPUT:
; ACRAREA = PAYER NAME
; ACRTOT( = ARRAY CONTAINING PAYMENT AMOUNT CODE TOTALS
; ACRCNTB = RECORD B COUNT
; ACRCNTR = RECORD SEQUENCE NUMBER ; ACR*2.1*6.01
;
; OUTPUT:
; ACRCNTR = RECORD SEQUENCE COUNT ; ACR*2.1*6.01
;
N I,Z
S ACRCNTR=ACRCNTR+1 ; ACR*2.1*6.01
S $E(Z)="C"
S $E(Z,2,9)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0)
S $E(Z,10,15)=$$PAD^ACRFUTL("","R",6,"")
S $E(Z,16,33)=$$PAD^ACRFUTL(ACRTOT(1),"L",18,0)
S $E(Z,34,51)=$$PAD^ACRFUTL(ACRTOT(2),"L",18,0)
S $E(Z,52,69)=$$PAD^ACRFUTL(ACRTOT(3),"L",18,0)
S $E(Z,70,87)=$$PAD^ACRFUTL(ACRTOT(4),"L",18,0)
S $E(Z,88,105)=$$PAD^ACRFUTL(ACRTOT(5),"L",18,0)
S $E(Z,106,123)=$$PAD^ACRFUTL(ACRTOT(6),"L",18,0)
S $E(Z,124,141)=$$PAD^ACRFUTL(ACRTOT(7),"L",18,0)
S $E(Z,142,159)=$$PAD^ACRFUTL(ACRTOT(8),"L",18,0)
S $E(Z,160,177)=$$PAD^ACRFUTL(ACRTOT(9),"L",18,0)
S $E(Z,178,195)=$$PAD^ACRFUTL(ACRTOT("A"),"L",18,0)
S $E(Z,196,213)=$$PAD^ACRFUTL(ACRTOT("B"),"L",18,0)
S $E(Z,214,231)=$$PAD^ACRFUTL(ACRTOT("C"),"L",18,0)
S $E(Z,232,249)=$$PAD^ACRFUTL("","R",18,"") ;ACR*2.1*8.01
S $E(Z,250,267)=$$PAD^ACRFUTL("","R",18,"") ;ACR*2.1*8.01
S $E(Z,268,499)=$$PAD^ACRFUTL("","R",232,"") ;ACR*2.1*8.01
S $E(Z,500,507)=$$PAD^ACRFUTL(ACRCNTR,"L",8,0) ;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,"")
;
S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,1)=$E(Z,1,240)
S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,2)=$E(Z,241,480)
S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,3)=$E(Z,481,720)
S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,4)=$E(Z,721,750)
Q
RECORDF(ACRCNTA,ACRCNTR) ;EP ;ACR*2.1*6.01
;----- CREATE RECORD TYPE F (END OF TRANSMISSION)
;
;LAYOUT
;1 - 1 "F" 58-499 BLANK ;ACR*2.1*6.01
;2 - 9 NUMBER OF "A" RECORDS 500-507 RECORD SEQUENCE# ;ACR*2.1*6.01
;10 - 30 ZEROS 508-748 BLANK ;ACR*2.1*6.01
;31 - 49 BLANK 749-750 BLANK ;ACR*2.1*6.01
;50 - 57 TOTAL NUMBER OF PAYEES ;ACR*2.1*6.01
;
; INPUT:
; ACRCNTA = RECORD A COUNT
; ACRCNTR = RECORD SEQUENCE NUMBER ;ACR*2.1*6.01
;
; OUTPUT:
; ACRCNTR = RECORD SEQUENCE COUNT ;ACR*2.1*6.01
;
N I,Z
S ACRCNTR=ACRCNTR+1 ; ACR*2.1*6.01
S $E(Z)="F"
S $E(Z,2,9)=$$PAD^ACRFUTL(ACRCNTA,"L",8,0)
S $E(Z,10,30)=$$PAD^ACRFUTL("","L",21,0)
S $E(Z,31,49)=$$PAD^ACRFUTL("","R",19,"") ;ACR*2.1*6.01
S $E(Z,50,57)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0) ;ACR*2.1*6.01
S $E(Z,58,449)=$$PAD^ACRFUTL("","R",442,"") ;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,749)=$$PAD^ACRFUTL("","R",241,"") ;ACR*2.1*6.01
S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"") ;ACR*2.1*6.01
;
S ^TMP("ACRZ",$J,"RECORD","F",1)=$E(Z,1,240)
S ^TMP("ACRZ",$J,"RECORD","F",2)=$E(Z,241,480)
S ^TMP("ACRZ",$J,"RECORD","F",3)=$E(Z,481,720)
S ^TMP("ACRZ",$J,"RECORD","F",4)=$E(Z,721,750)
Q
RECORDT(ACRAREA,ACRPMYR,ACRCNTB) ;EP
;----- CREATE RECORD TYPE T (TRANSMITTER)
;
;LAYOUT ;NEW LAYOUT ACR*2.1*6.01,ACR*2.1*8.04
; 1- 1 "T" 344-358 CONTACT PHONE
; 2- 5 PAYMENT YEAR 359-393 CONTACT E-MAIL ADDRESS
; 6- 6 PRIOR YEAR DATA IND 394-395 CARTRDGE TAPE FILE IND (BNK)
; 7- 15 TRANSMITTER'S TIN 396-410 ELEC FILE IND (BLANKS)
; 16- 20 TRANSMITTER CTRL CODE 411-416 TRANSMITTER'S MEDIA NUMBER
; 21- 22 REPLACEMENT ALPHA CHAR 417-499 BLANK
; 23- 27 BLANK **** 500-507 RECORD SEQUENCE NUMBER (R)
; 28- 28 TEST FILE INDICATOR 508-517 BLANK
; 29- 29 FOREIGN ENTITY IND 518-518 VENDOR INDICATOR ("I")
; 30- 69 TRANSMITTER NAME 519-558 VENDOR NAME OF COTS SF (NR)
; 70-109 TRANSMITTER NAME, CONT 559-598 VENDOR MAILING ADDRESS (NR)
;110-149 COMPANY NAME 599-638 VENDOR CITY (NR)
;150-189 COMPANY NAME, CONT 639-640 VENDOR STATE (NR)
;190-229 COMPANY MAILING ADDR 641-649 VENDOR ZIP CODE (NR)
;230-269 COMPANY CITY 650-689 VENDOR CONTACT NAME (NR)
;270-271 COMPANY STATE 690-704 VENDOR CONTACT PHONE (NR)
;272-280 COMPANY ZIP CODE 705-739 VENDOR CONTACT EMAIL (NR)
;281-295 BLANK 740-740 FOREIGN VENDOR INDICATOR ;ACR*2.1*8.04
;296-303 TOTAL NUMBER OF PAYEES 741-748 BLANK ACR*2.1*8.04
;304-343 CONTACT NAME 749-750 BLANK
;
; INPUT:
; ACRAREA = PAYER NAME
; ACRPMYR = PAYMENT CALENDAR YEAR
; ACRCNTB = RECORD B COUNT
;
N DATA,I,Z,DATA1 ;ACR*2.1*6.01
S DATA=$$UPPER^ACRFUTL($G(^ACR1099P(ACRAREA,0))) ;ACR*2.1*6.01
S DATA1=$G(^ACR1099P(ACRAREA,1)) ;ACR*2.1*6.01
S $E(Z)="T"
S $E(Z,2,5)=ACRPMYR
S $E(Z,6)=$$PAD^ACRFUTL("","R",1,"")
S $E(Z,7,15)=$P(DATA,U,8)
S $E(Z,16,20)=$E($P(DATA,U,10),1,5)
S $E(Z,21,22)=$$PAD^ACRFUTL("","R",2,"")
S $E(Z,23,27)=$$PAD^ACRFUTL("","R",5,"")
S $E(Z,28)=$$PAD^ACRFUTL("","R",1,"")
S $E(Z,29)=$$PAD^ACRFUTL("","R",1,"")
S $E(Z,30,69)=$$PAD^ACRFUTL($P(DATA,U,2),"R",40,"")
S $E(Z,70,109)=$$PAD^ACRFUTL($P(DATA,U,3),"R",40,"")
S $E(Z,110,149)=$$PAD^ACRFUTL($P(DATA,U,2),"R",40,"")
S $E(Z,150,189)=$$PAD^ACRFUTL($P(DATA,U,3),"R",40,"")
S $E(Z,190,229)=$$PAD^ACRFUTL($P(DATA,U,4),"R",40,"")
S $E(Z,230,269)=$$PAD^ACRFUTL($P(DATA,U,5),"R",40,"")
S $E(Z,270,271)=$P(^DIC(5,$P(DATA,U,6),0),U,2)
S $E(Z,272,280)=$$PAD^ACRFUTL($TR($P(DATA,U,7),"-",""),"R",9,"")
S $E(Z,281,295)=$$PAD^ACRFUTL("","R",15,"")
S $E(Z,296,303)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0)
S $E(Z,304,343)=$$PAD^ACRFUTL($P(DATA,U,13),"R",40,"")
S $E(Z,344,358)=$$PAD^ACRFUTL($P(DATA,U,14),"R",15,"")
S $E(Z,359,393)=$$PAD^ACRFUTL($P(DATA1,U,2),"L",35,"") ;ACR*2.1*6.01
S $E(Z,394,395)=$$PAD^ACRFUTL("","R",2,"") ;ACR*2.1*6.01
S $E(Z,396,410)=$$PAD^ACRFUTL("","R",15,"") ;ACR*2.1*6.01
S $E(Z,411,416)=$$PAD^ACRFUTL("","R",6,"") ;ACR*2.1*6.01
S $E(Z,417,499)=$$PAD^ACRFUTL("","R",83,"") ;ACR*2.1*6.01
S $E(Z,500,507)=$$PAD^ACRFUTL(1,"L",8,0) ; T record always #1 ACR*2.1*6.01
S $E(Z,508,517)=$$PAD^ACRFUTL("","R",10,"") ;ACR*2.1*6.01
S $E(Z,518)="I" ;ACR*2.1*6.01
S $E(Z,519,558)=$$PAD^ACRFUTL("","R",40,"") ;ACR*2.1*6.01
S $E(Z,559,598)=$$PAD^ACRFUTL("","R",40,"") ;ACR*2.1*6.01
S $E(Z,599,638)=$$PAD^ACRFUTL("","R",40,"") ;ACR*2.1*6.01
S $E(Z,639,640)=$$PAD^ACRFUTL("","R",2,"") ;ACR*2.1*6.01
S $E(Z,641,649)=$$PAD^ACRFUTL("","R",9,"") ;ACR*2.1*6.01
S $E(Z,650,689)=$$PAD^ACRFUTL("","R",40,"") ;ACR*2.1*6.01
S $E(Z,690,704)=$$PAD^ACRFUTL("","R",15,"") ;ACR*2.1*6.01
S $E(Z,705,739)=$$PAD^ACRFUTL("","R",35,"") ;ACR*2.1*6.01
S $E(Z,740,740)=$$PAD^ACRFUTL("","R",1,"") ;ACR*2.1*8.01
S $E(Z,741,748)=$$PAD^ACRFUTL("","R",8,"") ;ACR*2.1*8.01
S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
;
S ^TMP("ACRZ",$J,"RECORD","T",1)=$E(Z,1,240)
S ^TMP("ACRZ",$J,"RECORD","T",2)=$E(Z,241,480)
S ^TMP("ACRZ",$J,"RECORD","T",3)=$E(Z,481,720)
S ^TMP("ACRZ",$J,"RECORD","T",4)=$E(Z,721,750)
Q
ACRFIRS0 ;IHS/OIRM/DSD/AEF - 1099 RECORD A,B,C,F,T LAYOUTS; [ 02/13/2004 9:40 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1,6,8**;NOV 05, 2001
+2 ; NEW ROUTINE CREATED FROM ACRFIRS2; ACR*2.1*8
+3 ;
+4 ; This routine is called by ACRFIRS1 to format 1099 record data
+5 ; into a ^TMP global using the record layouts specified in
+6 ; Department of the Treasury Internal Revenue Service
+7 ; Publication 1220 Catalog Number 61275P.
+8 ; Variables are set by ACRFIRS1.
+9 ; Note: All Apha characters must be in upper case
+10 ; EXCEPT e-mail addresses that might be case sensitive
+11 QUIT
RECORDC(ACRAREA,ACRTOT,ACRCNTB,ACRCNTR) ;EP ;ACR*2.1*6.01
+1 ;----- CREATE RECORD TYPE C (END OF PAYER)
+2 ;
+3 ;LAYOUT
+4 ;1 - 1 "C" 160-177 CONTROL TOTAL 9
+5 ;2 - 9 NUMBER OF PAYEES 178-195 CONTROL TOTAL A
+6 ;10 - 15 BLANK 196-213 CONTROL TOTAL B
+7 ;16 - 33 CONTROL TOTAL 1 214-231 CONTROL TOTAL C
+8 ;34 - 51 CONTROL TOTAL 2 232-249 CONTROL TOTAL D ;ACR*2.1*8.01
+9 ;52 - 69 CONTROL TOTAL 3 250-267 CONTROL TOTAL E ;ACR*2.1*8.01
+10 ;70 - 87 CONTROL TOTAL 4 268-449 BLANK ;ACR*2.1*8.01
+11 ;88 -105 CONTROL TOTAL 5 500-507 RECORD SEQUENCE# ;ACR*2.1*6.01
+12 ;106-123 CONTROL TOTAL 6 508-748 BLANK ;ACR*2.1*6.01
+13 ;124-141 CONTROL TOTAL 7 749-750 BLANK ;ACR*2.1*6.01
+14 ;142-159 CONTROL TOTAL 8
+15 ;
+16 ; INPUT:
+17 ; ACRAREA = PAYER NAME
+18 ; ACRTOT( = ARRAY CONTAINING PAYMENT AMOUNT CODE TOTALS
+19 ; ACRCNTB = RECORD B COUNT
+20 ; ACRCNTR = RECORD SEQUENCE NUMBER ; ACR*2.1*6.01
+21 ;
+22 ; OUTPUT:
+23 ; ACRCNTR = RECORD SEQUENCE COUNT ; ACR*2.1*6.01
+24 ;
+25 NEW I,Z
+26 ; ACR*2.1*6.01
SET ACRCNTR=ACRCNTR+1
+27 SET $EXTRACT(Z)="C"
+28 SET $EXTRACT(Z,2,9)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0)
+29 SET $EXTRACT(Z,10,15)=$$PAD^ACRFUTL("","R",6,"")
+30 SET $EXTRACT(Z,16,33)=$$PAD^ACRFUTL(ACRTOT(1),"L",18,0)
+31 SET $EXTRACT(Z,34,51)=$$PAD^ACRFUTL(ACRTOT(2),"L",18,0)
+32 SET $EXTRACT(Z,52,69)=$$PAD^ACRFUTL(ACRTOT(3),"L",18,0)
+33 SET $EXTRACT(Z,70,87)=$$PAD^ACRFUTL(ACRTOT(4),"L",18,0)
+34 SET $EXTRACT(Z,88,105)=$$PAD^ACRFUTL(ACRTOT(5),"L",18,0)
+35 SET $EXTRACT(Z,106,123)=$$PAD^ACRFUTL(ACRTOT(6),"L",18,0)
+36 SET $EXTRACT(Z,124,141)=$$PAD^ACRFUTL(ACRTOT(7),"L",18,0)
+37 SET $EXTRACT(Z,142,159)=$$PAD^ACRFUTL(ACRTOT(8),"L",18,0)
+38 SET $EXTRACT(Z,160,177)=$$PAD^ACRFUTL(ACRTOT(9),"L",18,0)
+39 SET $EXTRACT(Z,178,195)=$$PAD^ACRFUTL(ACRTOT("A"),"L",18,0)
+40 SET $EXTRACT(Z,196,213)=$$PAD^ACRFUTL(ACRTOT("B"),"L",18,0)
+41 SET $EXTRACT(Z,214,231)=$$PAD^ACRFUTL(ACRTOT("C"),"L",18,0)
+42 ;ACR*2.1*8.01
SET $EXTRACT(Z,232,249)=$$PAD^ACRFUTL("","R",18,"")
+43 ;ACR*2.1*8.01
SET $EXTRACT(Z,250,267)=$$PAD^ACRFUTL("","R",18,"")
+44 ;ACR*2.1*8.01
SET $EXTRACT(Z,268,499)=$$PAD^ACRFUTL("","R",232,"")
+45 ;ACR*2.1*6.01
SET $EXTRACT(Z,500,507)=$$PAD^ACRFUTL(ACRCNTR,"L",8,0)
+46 ;ACR*2.1*6.01
SET $EXTRACT(Z,508,748)=$$PAD^ACRFUTL("","R",241,"")
+47 SET $EXTRACT(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
+48 ;
+49 SET ^TMP("ACRZ",$JOB,"RECORD","C",ACRAREA,1)=$EXTRACT(Z,1,240)
+50 SET ^TMP("ACRZ",$JOB,"RECORD","C",ACRAREA,2)=$EXTRACT(Z,241,480)
+51 SET ^TMP("ACRZ",$JOB,"RECORD","C",ACRAREA,3)=$EXTRACT(Z,481,720)
+52 SET ^TMP("ACRZ",$JOB,"RECORD","C",ACRAREA,4)=$EXTRACT(Z,721,750)
+53 QUIT
RECORDF(ACRCNTA,ACRCNTR) ;EP ;ACR*2.1*6.01
+1 ;----- CREATE RECORD TYPE F (END OF TRANSMISSION)
+2 ;
+3 ;LAYOUT
+4 ;1 - 1 "F" 58-499 BLANK ;ACR*2.1*6.01
+5 ;2 - 9 NUMBER OF "A" RECORDS 500-507 RECORD SEQUENCE# ;ACR*2.1*6.01
+6 ;10 - 30 ZEROS 508-748 BLANK ;ACR*2.1*6.01
+7 ;31 - 49 BLANK 749-750 BLANK ;ACR*2.1*6.01
+8 ;50 - 57 TOTAL NUMBER OF PAYEES ;ACR*2.1*6.01
+9 ;
+10 ; INPUT:
+11 ; ACRCNTA = RECORD A COUNT
+12 ; ACRCNTR = RECORD SEQUENCE NUMBER ;ACR*2.1*6.01
+13 ;
+14 ; OUTPUT:
+15 ; ACRCNTR = RECORD SEQUENCE COUNT ;ACR*2.1*6.01
+16 ;
+17 NEW I,Z
+18 ; ACR*2.1*6.01
SET ACRCNTR=ACRCNTR+1
+19 SET $EXTRACT(Z)="F"
+20 SET $EXTRACT(Z,2,9)=$$PAD^ACRFUTL(ACRCNTA,"L",8,0)
+21 SET $EXTRACT(Z,10,30)=$$PAD^ACRFUTL("","L",21,0)
+22 ;ACR*2.1*6.01
SET $EXTRACT(Z,31,49)=$$PAD^ACRFUTL("","R",19,"")
+23 ;ACR*2.1*6.01
SET $EXTRACT(Z,50,57)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0)
+24 ;ACR*2.1*6.01
SET $EXTRACT(Z,58,449)=$$PAD^ACRFUTL("","R",442,"")
+25 ;ACR*2.1*6.01
SET $EXTRACT(Z,500,507)=$$PAD^ACRFUTL(ACRCNTR,"L",8,0)
+26 ;ACR*2.1*6.01
SET $EXTRACT(Z,508,749)=$$PAD^ACRFUTL("","R",241,"")
+27 ;ACR*2.1*6.01
SET $EXTRACT(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
+28 ;
+29 SET ^TMP("ACRZ",$JOB,"RECORD","F",1)=$EXTRACT(Z,1,240)
+30 SET ^TMP("ACRZ",$JOB,"RECORD","F",2)=$EXTRACT(Z,241,480)
+31 SET ^TMP("ACRZ",$JOB,"RECORD","F",3)=$EXTRACT(Z,481,720)
+32 SET ^TMP("ACRZ",$JOB,"RECORD","F",4)=$EXTRACT(Z,721,750)
+33 QUIT
RECORDT(ACRAREA,ACRPMYR,ACRCNTB) ;EP
+1 ;----- CREATE RECORD TYPE T (TRANSMITTER)
+2 ;
+3 ;LAYOUT ;NEW LAYOUT ACR*2.1*6.01,ACR*2.1*8.04
+4 ; 1- 1 "T" 344-358 CONTACT PHONE
+5 ; 2- 5 PAYMENT YEAR 359-393 CONTACT E-MAIL ADDRESS
+6 ; 6- 6 PRIOR YEAR DATA IND 394-395 CARTRDGE TAPE FILE IND (BNK)
+7 ; 7- 15 TRANSMITTER'S TIN 396-410 ELEC FILE IND (BLANKS)
+8 ; 16- 20 TRANSMITTER CTRL CODE 411-416 TRANSMITTER'S MEDIA NUMBER
+9 ; 21- 22 REPLACEMENT ALPHA CHAR 417-499 BLANK
+10 ; 23- 27 BLANK **** 500-507 RECORD SEQUENCE NUMBER (R)
+11 ; 28- 28 TEST FILE INDICATOR 508-517 BLANK
+12 ; 29- 29 FOREIGN ENTITY IND 518-518 VENDOR INDICATOR ("I")
+13 ; 30- 69 TRANSMITTER NAME 519-558 VENDOR NAME OF COTS SF (NR)
+14 ; 70-109 TRANSMITTER NAME, CONT 559-598 VENDOR MAILING ADDRESS (NR)
+15 ;110-149 COMPANY NAME 599-638 VENDOR CITY (NR)
+16 ;150-189 COMPANY NAME, CONT 639-640 VENDOR STATE (NR)
+17 ;190-229 COMPANY MAILING ADDR 641-649 VENDOR ZIP CODE (NR)
+18 ;230-269 COMPANY CITY 650-689 VENDOR CONTACT NAME (NR)
+19 ;270-271 COMPANY STATE 690-704 VENDOR CONTACT PHONE (NR)
+20 ;272-280 COMPANY ZIP CODE 705-739 VENDOR CONTACT EMAIL (NR)
+21 ;281-295 BLANK 740-740 FOREIGN VENDOR INDICATOR ;ACR*2.1*8.04
+22 ;296-303 TOTAL NUMBER OF PAYEES 741-748 BLANK ACR*2.1*8.04
+23 ;304-343 CONTACT NAME 749-750 BLANK
+24 ;
+25 ; INPUT:
+26 ; ACRAREA = PAYER NAME
+27 ; ACRPMYR = PAYMENT CALENDAR YEAR
+28 ; ACRCNTB = RECORD B COUNT
+29 ;
+30 ;ACR*2.1*6.01
NEW DATA,I,Z,DATA1
+31 ;ACR*2.1*6.01
SET DATA=$$UPPER^ACRFUTL($GET(^ACR1099P(ACRAREA,0)))
+32 ;ACR*2.1*6.01
SET DATA1=$GET(^ACR1099P(ACRAREA,1))
+33 SET $EXTRACT(Z)="T"
+34 SET $EXTRACT(Z,2,5)=ACRPMYR
+35 SET $EXTRACT(Z,6)=$$PAD^ACRFUTL("","R",1,"")
+36 SET $EXTRACT(Z,7,15)=$PIECE(DATA,U,8)
+37 SET $EXTRACT(Z,16,20)=$EXTRACT($PIECE(DATA,U,10),1,5)
+38 SET $EXTRACT(Z,21,22)=$$PAD^ACRFUTL("","R",2,"")
+39 SET $EXTRACT(Z,23,27)=$$PAD^ACRFUTL("","R",5,"")
+40 SET $EXTRACT(Z,28)=$$PAD^ACRFUTL("","R",1,"")
+41 SET $EXTRACT(Z,29)=$$PAD^ACRFUTL("","R",1,"")
+42 SET $EXTRACT(Z,30,69)=$$PAD^ACRFUTL($PIECE(DATA,U,2),"R",40,"")
+43 SET $EXTRACT(Z,70,109)=$$PAD^ACRFUTL($PIECE(DATA,U,3),"R",40,"")
+44 SET $EXTRACT(Z,110,149)=$$PAD^ACRFUTL($PIECE(DATA,U,2),"R",40,"")
+45 SET $EXTRACT(Z,150,189)=$$PAD^ACRFUTL($PIECE(DATA,U,3),"R",40,"")
+46 SET $EXTRACT(Z,190,229)=$$PAD^ACRFUTL($PIECE(DATA,U,4),"R",40,"")
+47 SET $EXTRACT(Z,230,269)=$$PAD^ACRFUTL($PIECE(DATA,U,5),"R",40,"")
+48 SET $EXTRACT(Z,270,271)=$PIECE(^DIC(5,$PIECE(DATA,U,6),0),U,2)
+49 SET $EXTRACT(Z,272,280)=$$PAD^ACRFUTL($TRANSLATE($PIECE(DATA,U,7),"-",""),"R",9,"")
+50 SET $EXTRACT(Z,281,295)=$$PAD^ACRFUTL("","R",15,"")
+51 SET $EXTRACT(Z,296,303)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0)
+52 SET $EXTRACT(Z,304,343)=$$PAD^ACRFUTL($PIECE(DATA,U,13),"R",40,"")
+53 SET $EXTRACT(Z,344,358)=$$PAD^ACRFUTL($PIECE(DATA,U,14),"R",15,"")
+54 ;ACR*2.1*6.01
SET $EXTRACT(Z,359,393)=$$PAD^ACRFUTL($PIECE(DATA1,U,2),"L",35,"")
+55 ;ACR*2.1*6.01
SET $EXTRACT(Z,394,395)=$$PAD^ACRFUTL("","R",2,"")
+56 ;ACR*2.1*6.01
SET $EXTRACT(Z,396,410)=$$PAD^ACRFUTL("","R",15,"")
+57 ;ACR*2.1*6.01
SET $EXTRACT(Z,411,416)=$$PAD^ACRFUTL("","R",6,"")
+58 ;ACR*2.1*6.01
SET $EXTRACT(Z,417,499)=$$PAD^ACRFUTL("","R",83,"")
+59 ; T record always #1 ACR*2.1*6.01
SET $EXTRACT(Z,500,507)=$$PAD^ACRFUTL(1,"L",8,0)
+60 ;ACR*2.1*6.01
SET $EXTRACT(Z,508,517)=$$PAD^ACRFUTL("","R",10,"")
+61 ;ACR*2.1*6.01
SET $EXTRACT(Z,518)="I"
+62 ;ACR*2.1*6.01
SET $EXTRACT(Z,519,558)=$$PAD^ACRFUTL("","R",40,"")
+63 ;ACR*2.1*6.01
SET $EXTRACT(Z,559,598)=$$PAD^ACRFUTL("","R",40,"")
+64 ;ACR*2.1*6.01
SET $EXTRACT(Z,599,638)=$$PAD^ACRFUTL("","R",40,"")
+65 ;ACR*2.1*6.01
SET $EXTRACT(Z,639,640)=$$PAD^ACRFUTL("","R",2,"")
+66 ;ACR*2.1*6.01
SET $EXTRACT(Z,641,649)=$$PAD^ACRFUTL("","R",9,"")
+67 ;ACR*2.1*6.01
SET $EXTRACT(Z,650,689)=$$PAD^ACRFUTL("","R",40,"")
+68 ;ACR*2.1*6.01
SET $EXTRACT(Z,690,704)=$$PAD^ACRFUTL("","R",15,"")
+69 ;ACR*2.1*6.01
SET $EXTRACT(Z,705,739)=$$PAD^ACRFUTL("","R",35,"")
+70 ;ACR*2.1*8.01
SET $EXTRACT(Z,740,740)=$$PAD^ACRFUTL("","R",1,"")
+71 ;ACR*2.1*8.01
SET $EXTRACT(Z,741,748)=$$PAD^ACRFUTL("","R",8,"")
+72 SET $EXTRACT(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
+73 ;
+74 SET ^TMP("ACRZ",$JOB,"RECORD","T",1)=$EXTRACT(Z,1,240)
+75 SET ^TMP("ACRZ",$JOB,"RECORD","T",2)=$EXTRACT(Z,241,480)
+76 SET ^TMP("ACRZ",$JOB,"RECORD","T",3)=$EXTRACT(Z,481,720)
+77 SET ^TMP("ACRZ",$JOB,"RECORD","T",4)=$EXTRACT(Z,721,750)
+78 QUIT
