ACRFEXP5 ;IHS/OIRM/DSD/AEF - EXPORT TO ECS FILE [ 01/27/2005 1:36 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,15**;NOV 05, 2001
;
;ACR*2.1*2.01;NEW ROUTINE
;
;The formats for the ECS payment records herein are described in
;US Treasury document 'Electronic Certification System, Formats
;And Notes For Mainframe Alternate Data Entry Methods For ECS
;Production PC', P7.6 Revision 8, dated October 26, 1998.
;
REC01(ACRSCH,ACRRFC,ACRALC,ACRECS,ACRACH,ACRBTYP) ;EP
;----- CHECK TRANSMISSION HEADER RECORD 01
;RECORD LAYOUT:
; 1-2 RECORD TYPE "01" 43-45 RFC IDENTIFIER
; 3-8 TRANSMISSION NUMBER 46-53 ALC
; 9-22 SCHEDULE NUMBER 54-65 DOS FILENAME
;23-34 DATE/TIME 66-416 FILLER
;35-38 FPA ID 417-417 PAYMENT TYPE
;39-40 FPA PC # 418-418 PAYMENT APPLICATION
;41-42 FILLER 419-440 BLANK FILL
;
;INPUT:
;ACRSCH =TREASURY SCHEDULE NUMBER
;ACRRFC =REGIONAL FINANCE CENTER
;ACRALC =AGENCY LOCATION CODE
;ACRECS =TREASURY ECS FILE NAME
;ACRACH =PAYMENT FORMAT
;ACRBTYP=BATCH TYPE
;
N Z
S $E(Z,1,2)="01"
S $E(Z,3,8)=$$PAD^ACRFUTL("","R",6,"")
S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
S $E(Z,23,34)=$$PAD^ACRFUTL("","R",12,"")
S $E(Z,35,38)=$$PAD^ACRFUTL("","R",4,"")
S $E(Z,39,40)=$$PAD^ACRFUTL("","R",2,"")
S $E(Z,41,42)=$$PAD^ACRFUTL("","R",2,"")
S $E(Z,43,45)=$$PAD^ACRFUTL(ACRRFC,"R",3,"")
S $E(Z,46,53)=$$PAD^ACRFUTL(ACRALC,"R",8,"")
S $E(Z,54,65)=$$PAD^ACRFUTL($G(ACRECS)_"."_$G(ACRRFC),"R",12,"")
S $E(Z,66,416)=$$PAD^ACRFUTL("","R",351,"")
S $E(Z,417)=$$PAD^ACRFUTL($S(ACRACH="A":"A",ACRACH="B":"A",ACRACH="C":"C",ACRACH="N":"C",1:""),"R",1,"")
S $E(Z,418)=$$PAD^ACRFUTL($S(ACRBTYP="V":"V",ACRACH="C"&(ACRBTYP="T"):"M",ACRACH="N"&(ACRBTYP="T"):"M",ACRACH="A"&(ACRBTYP="T"):"T",ACRACH="B"&(ACRBTYP="T"):"T",1:""),"R",1,"")
S $E(Z,419,440)=$$PAD^ACRFUTL("","R",22,"")
;
W Z
Q
REC02(ACRSCH,ACRALC) ;EP
;----- AGENCY LOCATION CODE (ALC) CONTROL RECORD 02
;
; ACR*2.1*15.01 IM15981
; Moved code to ACRFEXP6 because ACRFEXP5 is too large
;
D REC02^ACRFEXP6(ACRSCH,ACRALC)
Q
;
REC03(ACRSCH,ACRADD1,ACRADD2,ACRADD3,ACRPHON) ;EP
;----- AGENCY BILLING ADDRESS CONTROL RECORD 03
;
; ACR*2.1*15.01 IM15981
; Moved code to ACRFEXP6 because ACRFEXP5 is too large
;
D REC03^ACRFEXP6(ACRSCH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAPHON)
Q
;
RECA04(ACRPCNT,ACRSCH,ACRATYP,ACRSSN,ACRAMT,ACRNAME,ACRRTN,ACRDAN,ACRAPPN,ACRPDFOR,ACRBTYP) ;EP
;----- ACH 04 PAYMENT RECORD
;
;RECORD LAYOUT:
; 1-2 RECORD TYPE "04" 96-112 DEPOSITOR ACCT NO.
; 3-8 PAYMENT NUMBER 113-216 FILLER
; 9-22 SCHEDULE NUMBER 217-217 PAYMENT TYPE
;23-23 ACCOUNT TYPE 218-233 ACCOUNT SYMBOL
;24-32 PAYEE ID/TIN 234-283 FILLER
;33-35 FILLER 284-363 PAYMENT ID LINE
;36-46 ZERO FILL 364-410 FILLER
;47-56 PAYMENT AMOUNT 411-413 ADDENDUM FORMAT
;57-57 RECORD CODE "B" 414-414 1099 REPORTING ELIG
;58-79 PAYEE NAME 415-415 TOP OFFSET ELIG
;80-80 ALLOTMENT CODE 416-423 ASAID
;81-86 FILLER 424-431 ACOID
;87-95 ROUTING TRANSIT NUMBER 432-440 MAC
;
;INPUT:
;ACRPCNT =PAYMENT NO
;ACRSCH =TREAS SCHED NO
;ACRATYP =ENCLOSURE CODE
;ACRSSN =VENDOR EIN OR TRAVELER SSN
;ACRAMT =PAYMENT AMOUNT
;ACRNAME =PAYEE NAME
;ACRRTN =BANK ROUTING TRANSIT NUMBER
;ACRDAN =DEPOSITOR ACCOUNT NUMBER
;ACRAPPN =APPROPRIATION
;ACRPDFOR=ACH ADDENDUM/INVOICE NUMBER
;ACRBTYP =BATCH TYPE
;
N Z
S $E(Z,1,2)="04"
S $E(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
S $E(Z,23)=ACRATYP
S $E(Z,24,32)=ACRSSN
S $E(Z,33,35)=$$PAD^ACRFUTL("","R",3,"")
S $E(Z,36,46)=$$PAD^ACRFUTL(0,"R",11,0)
S $E(Z,47,56)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL(ACRAMT),".",""),"L",10,0)
S $E(Z,57)="B"
S $E(Z,58,79)=$$PAD^ACRFUTL(ACRNAME,"R",22,"")
S $E(Z,80)=$$PAD^ACRFUTL("","R",1,"")
S $E(Z,81,86)=$$PAD^ACRFUTL("","R",6,"")
S $E(Z,87,95)=$$PAD^ACRFUTL(ACRRTN,"R",9,"")
S $E(Z,96,112)=$$PAD^ACRFUTL(ACRDAN,"R",17,"")
S $E(Z,113,216)=$$PAD^ACRFUTL("","R","",104)
S $E(Z,217)=$$PAD^ACRFUTL("","R",1,"")
S $E(Z,218,233)=$$PAD^ACRFUTL(ACRAPPN,"R",16,"")
S $E(Z,234,283)=$$PAD^ACRFUTL("","L","",50)
S $E(Z,284,363)=$$PAD^ACRFUTL(ACRPDFOR,"R",80,"")
S $E(Z,364,410)=$$PAD^ACRFUTL("","R",47,"")
S $E(Z,411,413)=$$PAD^ACRFUTL($S(ACRBTYP="V":"CCD",ACRBTYP="T":"PPD",1:""),"R",3,"")
S $E(Z,414)="N"
;S $E(Z,415)="Y" ;ACR*2.1*15.01 IM15981
;S $E(Z,415)=$S(ACRBTYP="T":"N",1:"Y") ;ACR*2.1*15.01 IM15981
S $E(Z,415)="Y" ;ACR*2.1*15.01 IM15981
S $E(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
;
W Z
Q
RECC04(ACRPCNT,ACRSCH,ACRAMT,ACRNAME,ACRADD,ACRAPPN,ACRSSN,ACRNID,ACRID) ;EP
;----- CHECK 04 PAYMENT RECORD
;
;RECORD LAYOUT:
; 1-2 RECORD TYPE "04" 218-218 TYPE OF PAYMENT
; 3-8 PAYMENT NUMBER 219-234 ACCOUNT SYMBOL
; 9-22 SCHEDULE NUMBER 235-243 VENDOR EIN/TRAVELER SSN
; 23-23 ENCLOSURE CODE 244-283 FILLER
; 24-30 FILLER 284-285 NUMBER OF PAYMENT ID LINES
; 31-31 ZERO FILL 286-340 PAYMENT ID LINE 1
; 32-41 PAYMENT AMOUNT 341-395 PAYMENT ID LINE 2
; 42-51 AGENCY ID 396-413 FILLER
; 52-52 RECORD CODE "B" 414-414 1099 REPORTING ELIG
; 53-87 PAYEE NAME 415-415 TOP OFFSET ELIG
; 88-122 ADDRESS LINE 1 416-423 ASAID
;123-157 ADDRESS LINE 2 424-431 ACOID
;158-187 ADDRESS LINE 3 432-440 MAC
;188-217 ADDRESS LINE 4
;
;INPUT:
;ACRPCNT=RECORD NUMBER
;ACRSCH =TREAS SCHED NO
;ACRAMT =PAYMENT AMOUNT
;ACRNAME=PAYEE NAME
;ACRADD =ARRAY CONTAINING ADDRESS LINES
;ACRAPPN=APPROPRIATION
;ACRSSN =VENDOR EIN/TRAVELER SSN
;ACRNID =NUMBER OF PAYMENT ID LINES
;ACRID =ARRAY CONTAINING PAYMENT ID LINES
;
N Z
S $E(Z,1,2)="04"
S $E(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
S $E(Z,23)=2
S $E(Z,24,30)=$$PAD^ACRFUTL("","R",7,"")
S $E(Z,31)=0
S $E(Z,32,41)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL(ACRAMT),".",""),"L",10,0)
S $E(Z,42,51)=$$PAD^ACRFUTL("IHS","R",10,"")
S $E(Z,52)="B"
S $E(Z,53,87)=$$PAD^ACRFUTL(ACRNAME,"R",35,"")
S $E(Z,88,122)=$$PAD^ACRFUTL($G(ACRADD(1)),"R",35,"")
S $E(Z,123,157)=$$PAD^ACRFUTL($G(ACRADD(2)),"R",35,"")
S $E(Z,158,187)=$$PAD^ACRFUTL($G(ACRADD(3)),"R",30,"")
S $E(Z,188,217)=$$PAD^ACRFUTL($G(ACRADD(4)),"R",30,"")
S $E(Z,218)="A"
S $E(Z,219,234)=$$PAD^ACRFUTL(ACRAPPN,"R",16,"")
S $E(Z,235,243)=$$PAD^ACRFUTL(ACRSSN,"R",9,"")
S $E(Z,244,283)=$$PAD^ACRFUTL("","R",40,"")
S $E(Z,284,285)=$$PAD^ACRFUTL(ACRNID,"L",2,0)
S $E(Z,286,340)=$$PAD^ACRFUTL($G(ACRID(1)),"R",55,"")
S $E(Z,341,395)=$$PAD^ACRFUTL($G(ACRID(2)),"R",55,"")
S $E(Z,396,413)=$$PAD^ACRFUTL("","R",18,"")
S $E(Z,414)="N"
;S $E(Z,415)="Y" ;ACR*2.1*15.01 IM15981
;S $E(Z,415)=$S(ACRBTYP="T":"N",1:"Y") ;ACR*2.1*15.01 IM15981
S $E(Z,415)="Y" ;ACR*2.1*15.01 IM15981
S $E(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
;
W Z
Q
RECC05(ACRPCNT,ACRSCH,ACRID) ;EP
;----- CHECK 05 NCR ENCLOSURE RECORD
;
;RECORD LAYOUT:
; 1-2 RECORD TYPE "05" 243-297 PAYMENT ID LINE 7
; 3-8 PAYMENT NUMBER 298-352 PAYMENT ID LINE 8
; 9-22 SCHEDULE NUMBER 353-415 FILLER
; 23-77 PAYMENT ID LINE 3 416-423 ASAID
; 78-132 PAYMENT ID LINE 4 424-431 ACOID
;133-187 PAYMENT ID LINE 5 432-440 MAC
;188-242 PAYMENT ID LINE 6
;
;INPUT:
;ACRPCNT=PAYMENT NUMBER
;ACRSCH =TREAS SCHED NO
;ACRID =ARRAY CONTAINING PAYMENT ID LINES
;
N Z
S $E(Z,1,2)="05"
S $E(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
S $E(Z,23,77)=$$PAD^ACRFUTL($G(ACRID(3)),"R",55,"")
S $E(Z,78,132)=$$PAD^ACRFUTL($G(ACRID(4)),"R",55,"")
S $E(Z,133,187)=$$PAD^ACRFUTL($G(ACRID(5)),"R",55,"")
S $E(Z,188,242)=$$PAD^ACRFUTL($G(ACRID(6)),"R",55,"")
S $E(Z,243,297)=$$PAD^ACRFUTL($G(ACRID(7)),"R",55,"")
S $E(Z,298,352)=$$PAD^ACRFUTL($G(ACRID(8)),"R",55,"")
S $E(Z,353,415)=$$PAD^ACRFUTL("","R",63,"")
S $E(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
;
W Z
Q
RECC06(ACRPCNT,ACRSCH,ACRID) ;EP
;----- CHECK 06 NCR ENCLOSURE RECORD
;
;RECORD LAYOUT:
; 1-2 RECORD TYPE "06" 243-297 PAYMENT ID LINE 13
; 3-8 PAYMENT NUMBER 298-352 PAYMENT ID LINE 14
; 9-22 SCHEDULE NUMBER 353-415 FILLER
; 23-77 PAYMENT ID LINE 9 416-423 ASAID
; 78-132 PAYMENT ID LINE 10 424-431 ACOID
;133-187 PAYMENT ID LINE 11 432-440 MAC
;188-242 PAYMENT ID LINE 12
;
;INPUT:
;ACRPCNT=PAYMENT NUMBER
;ACRSCH =TREAS SCHED NO
;ACRID =PAYMENT ID LINE ARRAY
;
N Z
S $E(Z,1,2)="06"
S $E(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
S $E(Z,23,77)=$$PAD^ACRFUTL($G(ACRID(9)),"R",55,"")
S $E(Z,78,132)=$$PAD^ACRFUTL($G(ACRID(10)),"R",55,"")
S $E(Z,133,187)=$$PAD^ACRFUTL($G(ACRID(11)),"R",55,"")
S $E(Z,188,242)=$$PAD^ACRFUTL($G(ACRID(12)),"R",55,"")
S $E(Z,243,297)=$$PAD^ACRFUTL($G(ACRID(13)),"R",55,"")
S $E(Z,298,352)=$$PAD^ACRFUTL($G(ACRID(14)),"R",55,"")
S $E(Z,353,415)=$$PAD^ACRFUTL("","R",63,"")
S $E(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
S $E(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
;
W Z
Q
REC09(ACRPCNT,ACRSCH,ACRTAMT,ACRAPPN,ACRCNT) ;EP
;----- SCHEDULE CONTROL RECORD 09
;
; ACR*2.1*15.01 IM15981
; Moved code to ACRFEXP6 because ACRFEXP5 is too large
;
D REC09^ACRFEXP6(ACRPCNT,ACRSCH,ACRTAMT,.ACRAPPN,.ACRCNT)
Q
REC99(ACRCNT,ACRSCH) ;EP
;----- SCHEDULE TRAILER RECORD 99
;
; ACR*2.1*15.01 IM15981
; Moved code to ACRFEXP6 because ACRFEXP5 is too large
;
D REC99^ACRFEXP6(.ACRCNT,ACRSCH)
Q
ACRFEXP5 ;IHS/OIRM/DSD/AEF - EXPORT TO ECS FILE [ 01/27/2005 1:36 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,15**;NOV 05, 2001
+2 ;
+3 ;ACR*2.1*2.01;NEW ROUTINE
+4 ;
+5 ;The formats for the ECS payment records herein are described in
+6 ;US Treasury document 'Electronic Certification System, Formats
+7 ;And Notes For Mainframe Alternate Data Entry Methods For ECS
+8 ;Production PC', P7.6 Revision 8, dated October 26, 1998.
+9 ;
REC01(ACRSCH,ACRRFC,ACRALC,ACRECS,ACRACH,ACRBTYP) ;EP
+1 ;----- CHECK TRANSMISSION HEADER RECORD 01
+2 ;RECORD LAYOUT:
+3 ; 1-2 RECORD TYPE "01" 43-45 RFC IDENTIFIER
+4 ; 3-8 TRANSMISSION NUMBER 46-53 ALC
+5 ; 9-22 SCHEDULE NUMBER 54-65 DOS FILENAME
+6 ;23-34 DATE/TIME 66-416 FILLER
+7 ;35-38 FPA ID 417-417 PAYMENT TYPE
+8 ;39-40 FPA PC # 418-418 PAYMENT APPLICATION
+9 ;41-42 FILLER 419-440 BLANK FILL
+10 ;
+11 ;INPUT:
+12 ;ACRSCH =TREASURY SCHEDULE NUMBER
+13 ;ACRRFC =REGIONAL FINANCE CENTER
+14 ;ACRALC =AGENCY LOCATION CODE
+15 ;ACRECS =TREASURY ECS FILE NAME
+16 ;ACRACH =PAYMENT FORMAT
+17 ;ACRBTYP=BATCH TYPE
+18 ;
+19 NEW Z
+20 SET $EXTRACT(Z,1,2)="01"
+21 SET $EXTRACT(Z,3,8)=$$PAD^ACRFUTL("","R",6,"")
+22 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
+23 SET $EXTRACT(Z,23,34)=$$PAD^ACRFUTL("","R",12,"")
+24 SET $EXTRACT(Z,35,38)=$$PAD^ACRFUTL("","R",4,"")
+25 SET $EXTRACT(Z,39,40)=$$PAD^ACRFUTL("","R",2,"")
+26 SET $EXTRACT(Z,41,42)=$$PAD^ACRFUTL("","R",2,"")
+27 SET $EXTRACT(Z,43,45)=$$PAD^ACRFUTL(ACRRFC,"R",3,"")
+28 SET $EXTRACT(Z,46,53)=$$PAD^ACRFUTL(ACRALC,"R",8,"")
+29 SET $EXTRACT(Z,54,65)=$$PAD^ACRFUTL($GET(ACRECS)_"."_$GET(ACRRFC),"R",12,"")
+30 SET $EXTRACT(Z,66,416)=$$PAD^ACRFUTL("","R",351,"")
+31 SET $EXTRACT(Z,417)=$$PAD^ACRFUTL($SELECT(ACRACH="A":"A",ACRACH="B":"A",ACRACH="C":"C",ACRACH="N":"C",1:""),"R",1,"")
+32 SET $EXTRACT(Z,418)=$$PAD^ACRFUTL($SELECT(ACRBTYP="V":"V",ACRACH="C"&(ACRBTYP="T"):"M",ACRACH="N"&(ACRBTYP="T"):"M",ACRACH="A"&(ACRBTYP="T"):"T",ACRACH="B"&(ACRBTYP="T"):"T",1:""),"R",1,"")
+33 SET $EXTRACT(Z,419,440)=$$PAD^ACRFUTL("","R",22,"")
+34 ;
+35 WRITE Z
+36 QUIT
REC02(ACRSCH,ACRALC) ;EP
+1 ;----- AGENCY LOCATION CODE (ALC) CONTROL RECORD 02
+2 ;
+3 ; ACR*2.1*15.01 IM15981
+4 ; Moved code to ACRFEXP6 because ACRFEXP5 is too large
+5 ;
+6 DO REC02^ACRFEXP6(ACRSCH,ACRALC)
+7 QUIT
+8 ;
REC03(ACRSCH,ACRADD1,ACRADD2,ACRADD3,ACRPHON) ;EP
+1 ;----- AGENCY BILLING ADDRESS CONTROL RECORD 03
+2 ;
+3 ; ACR*2.1*15.01 IM15981
+4 ; Moved code to ACRFEXP6 because ACRFEXP5 is too large
+5 ;
+6 DO REC03^ACRFEXP6(ACRSCH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAPHON)
+7 QUIT
+8 ;
RECA04(ACRPCNT,ACRSCH,ACRATYP,ACRSSN,ACRAMT,ACRNAME,ACRRTN,ACRDAN,ACRAPPN,ACRPDFOR,ACRBTYP) ;EP
+1 ;----- ACH 04 PAYMENT RECORD
+2 ;
+3 ;RECORD LAYOUT:
+4 ; 1-2 RECORD TYPE "04" 96-112 DEPOSITOR ACCT NO.
+5 ; 3-8 PAYMENT NUMBER 113-216 FILLER
+6 ; 9-22 SCHEDULE NUMBER 217-217 PAYMENT TYPE
+7 ;23-23 ACCOUNT TYPE 218-233 ACCOUNT SYMBOL
+8 ;24-32 PAYEE ID/TIN 234-283 FILLER
+9 ;33-35 FILLER 284-363 PAYMENT ID LINE
+10 ;36-46 ZERO FILL 364-410 FILLER
+11 ;47-56 PAYMENT AMOUNT 411-413 ADDENDUM FORMAT
+12 ;57-57 RECORD CODE "B" 414-414 1099 REPORTING ELIG
+13 ;58-79 PAYEE NAME 415-415 TOP OFFSET ELIG
+14 ;80-80 ALLOTMENT CODE 416-423 ASAID
+15 ;81-86 FILLER 424-431 ACOID
+16 ;87-95 ROUTING TRANSIT NUMBER 432-440 MAC
+17 ;
+18 ;INPUT:
+19 ;ACRPCNT =PAYMENT NO
+20 ;ACRSCH =TREAS SCHED NO
+21 ;ACRATYP =ENCLOSURE CODE
+22 ;ACRSSN =VENDOR EIN OR TRAVELER SSN
+23 ;ACRAMT =PAYMENT AMOUNT
+24 ;ACRNAME =PAYEE NAME
+25 ;ACRRTN =BANK ROUTING TRANSIT NUMBER
+26 ;ACRDAN =DEPOSITOR ACCOUNT NUMBER
+27 ;ACRAPPN =APPROPRIATION
+28 ;ACRPDFOR=ACH ADDENDUM/INVOICE NUMBER
+29 ;ACRBTYP =BATCH TYPE
+30 ;
+31 NEW Z
+32 SET $EXTRACT(Z,1,2)="04"
+33 SET $EXTRACT(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
+34 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
+35 SET $EXTRACT(Z,23)=ACRATYP
+36 SET $EXTRACT(Z,24,32)=ACRSSN
+37 SET $EXTRACT(Z,33,35)=$$PAD^ACRFUTL("","R",3,"")
+38 SET $EXTRACT(Z,36,46)=$$PAD^ACRFUTL(0,"R",11,0)
+39 SET $EXTRACT(Z,47,56)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL(ACRAMT),".",""),"L",10,0)
+40 SET $EXTRACT(Z,57)="B"
+41 SET $EXTRACT(Z,58,79)=$$PAD^ACRFUTL(ACRNAME,"R",22,"")
+42 SET $EXTRACT(Z,80)=$$PAD^ACRFUTL("","R",1,"")
+43 SET $EXTRACT(Z,81,86)=$$PAD^ACRFUTL("","R",6,"")
+44 SET $EXTRACT(Z,87,95)=$$PAD^ACRFUTL(ACRRTN,"R",9,"")
+45 SET $EXTRACT(Z,96,112)=$$PAD^ACRFUTL(ACRDAN,"R",17,"")
+46 SET $EXTRACT(Z,113,216)=$$PAD^ACRFUTL("","R","",104)
+47 SET $EXTRACT(Z,217)=$$PAD^ACRFUTL("","R",1,"")
+48 SET $EXTRACT(Z,218,233)=$$PAD^ACRFUTL(ACRAPPN,"R",16,"")
+49 SET $EXTRACT(Z,234,283)=$$PAD^ACRFUTL("","L","",50)
+50 SET $EXTRACT(Z,284,363)=$$PAD^ACRFUTL(ACRPDFOR,"R",80,"")
+51 SET $EXTRACT(Z,364,410)=$$PAD^ACRFUTL("","R",47,"")
+52 SET $EXTRACT(Z,411,413)=$$PAD^ACRFUTL($SELECT(ACRBTYP="V":"CCD",ACRBTYP="T":"PPD",1:""),"R",3,"")
+53 SET $EXTRACT(Z,414)="N"
+54 ;S $E(Z,415)="Y" ;ACR*2.1*15.01 IM15981
+55 ;S $E(Z,415)=$S(ACRBTYP="T":"N",1:"Y") ;ACR*2.1*15.01 IM15981
+56 ;ACR*2.1*15.01 IM15981
SET $EXTRACT(Z,415)="Y"
+57 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
+58 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
+59 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
+60 ;
+61 WRITE Z
+62 QUIT
RECC04(ACRPCNT,ACRSCH,ACRAMT,ACRNAME,ACRADD,ACRAPPN,ACRSSN,ACRNID,ACRID) ;EP
+1 ;----- CHECK 04 PAYMENT RECORD
+2 ;
+3 ;RECORD LAYOUT:
+4 ; 1-2 RECORD TYPE "04" 218-218 TYPE OF PAYMENT
+5 ; 3-8 PAYMENT NUMBER 219-234 ACCOUNT SYMBOL
+6 ; 9-22 SCHEDULE NUMBER 235-243 VENDOR EIN/TRAVELER SSN
+7 ; 23-23 ENCLOSURE CODE 244-283 FILLER
+8 ; 24-30 FILLER 284-285 NUMBER OF PAYMENT ID LINES
+9 ; 31-31 ZERO FILL 286-340 PAYMENT ID LINE 1
+10 ; 32-41 PAYMENT AMOUNT 341-395 PAYMENT ID LINE 2
+11 ; 42-51 AGENCY ID 396-413 FILLER
+12 ; 52-52 RECORD CODE "B" 414-414 1099 REPORTING ELIG
+13 ; 53-87 PAYEE NAME 415-415 TOP OFFSET ELIG
+14 ; 88-122 ADDRESS LINE 1 416-423 ASAID
+15 ;123-157 ADDRESS LINE 2 424-431 ACOID
+16 ;158-187 ADDRESS LINE 3 432-440 MAC
+17 ;188-217 ADDRESS LINE 4
+18 ;
+19 ;INPUT:
+20 ;ACRPCNT=RECORD NUMBER
+21 ;ACRSCH =TREAS SCHED NO
+22 ;ACRAMT =PAYMENT AMOUNT
+23 ;ACRNAME=PAYEE NAME
+24 ;ACRADD =ARRAY CONTAINING ADDRESS LINES
+25 ;ACRAPPN=APPROPRIATION
+26 ;ACRSSN =VENDOR EIN/TRAVELER SSN
+27 ;ACRNID =NUMBER OF PAYMENT ID LINES
+28 ;ACRID =ARRAY CONTAINING PAYMENT ID LINES
+29 ;
+30 NEW Z
+31 SET $EXTRACT(Z,1,2)="04"
+32 SET $EXTRACT(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
+33 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
+34 SET $EXTRACT(Z,23)=2
+35 SET $EXTRACT(Z,24,30)=$$PAD^ACRFUTL("","R",7,"")
+36 SET $EXTRACT(Z,31)=0
+37 SET $EXTRACT(Z,32,41)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL(ACRAMT),".",""),"L",10,0)
+38 SET $EXTRACT(Z,42,51)=$$PAD^ACRFUTL("IHS","R",10,"")
+39 SET $EXTRACT(Z,52)="B"
+40 SET $EXTRACT(Z,53,87)=$$PAD^ACRFUTL(ACRNAME,"R",35,"")
+41 SET $EXTRACT(Z,88,122)=$$PAD^ACRFUTL($GET(ACRADD(1)),"R",35,"")
+42 SET $EXTRACT(Z,123,157)=$$PAD^ACRFUTL($GET(ACRADD(2)),"R",35,"")
+43 SET $EXTRACT(Z,158,187)=$$PAD^ACRFUTL($GET(ACRADD(3)),"R",30,"")
+44 SET $EXTRACT(Z,188,217)=$$PAD^ACRFUTL($GET(ACRADD(4)),"R",30,"")
+45 SET $EXTRACT(Z,218)="A"
+46 SET $EXTRACT(Z,219,234)=$$PAD^ACRFUTL(ACRAPPN,"R",16,"")
+47 SET $EXTRACT(Z,235,243)=$$PAD^ACRFUTL(ACRSSN,"R",9,"")
+48 SET $EXTRACT(Z,244,283)=$$PAD^ACRFUTL("","R",40,"")
+49 SET $EXTRACT(Z,284,285)=$$PAD^ACRFUTL(ACRNID,"L",2,0)
+50 SET $EXTRACT(Z,286,340)=$$PAD^ACRFUTL($GET(ACRID(1)),"R",55,"")
+51 SET $EXTRACT(Z,341,395)=$$PAD^ACRFUTL($GET(ACRID(2)),"R",55,"")
+52 SET $EXTRACT(Z,396,413)=$$PAD^ACRFUTL("","R",18,"")
+53 SET $EXTRACT(Z,414)="N"
+54 ;S $E(Z,415)="Y" ;ACR*2.1*15.01 IM15981
+55 ;S $E(Z,415)=$S(ACRBTYP="T":"N",1:"Y") ;ACR*2.1*15.01 IM15981
+56 ;ACR*2.1*15.01 IM15981
SET $EXTRACT(Z,415)="Y"
+57 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
+58 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
+59 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
+60 ;
+61 WRITE Z
+62 QUIT
RECC05(ACRPCNT,ACRSCH,ACRID) ;EP
+1 ;----- CHECK 05 NCR ENCLOSURE RECORD
+2 ;
+3 ;RECORD LAYOUT:
+4 ; 1-2 RECORD TYPE "05" 243-297 PAYMENT ID LINE 7
+5 ; 3-8 PAYMENT NUMBER 298-352 PAYMENT ID LINE 8
+6 ; 9-22 SCHEDULE NUMBER 353-415 FILLER
+7 ; 23-77 PAYMENT ID LINE 3 416-423 ASAID
+8 ; 78-132 PAYMENT ID LINE 4 424-431 ACOID
+9 ;133-187 PAYMENT ID LINE 5 432-440 MAC
+10 ;188-242 PAYMENT ID LINE 6
+11 ;
+12 ;INPUT:
+13 ;ACRPCNT=PAYMENT NUMBER
+14 ;ACRSCH =TREAS SCHED NO
+15 ;ACRID =ARRAY CONTAINING PAYMENT ID LINES
+16 ;
+17 NEW Z
+18 SET $EXTRACT(Z,1,2)="05"
+19 SET $EXTRACT(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
+20 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
+21 SET $EXTRACT(Z,23,77)=$$PAD^ACRFUTL($GET(ACRID(3)),"R",55,"")
+22 SET $EXTRACT(Z,78,132)=$$PAD^ACRFUTL($GET(ACRID(4)),"R",55,"")
+23 SET $EXTRACT(Z,133,187)=$$PAD^ACRFUTL($GET(ACRID(5)),"R",55,"")
+24 SET $EXTRACT(Z,188,242)=$$PAD^ACRFUTL($GET(ACRID(6)),"R",55,"")
+25 SET $EXTRACT(Z,243,297)=$$PAD^ACRFUTL($GET(ACRID(7)),"R",55,"")
+26 SET $EXTRACT(Z,298,352)=$$PAD^ACRFUTL($GET(ACRID(8)),"R",55,"")
+27 SET $EXTRACT(Z,353,415)=$$PAD^ACRFUTL("","R",63,"")
+28 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
+29 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
+30 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
+31 ;
+32 WRITE Z
+33 QUIT
RECC06(ACRPCNT,ACRSCH,ACRID) ;EP
+1 ;----- CHECK 06 NCR ENCLOSURE RECORD
+2 ;
+3 ;RECORD LAYOUT:
+4 ; 1-2 RECORD TYPE "06" 243-297 PAYMENT ID LINE 13
+5 ; 3-8 PAYMENT NUMBER 298-352 PAYMENT ID LINE 14
+6 ; 9-22 SCHEDULE NUMBER 353-415 FILLER
+7 ; 23-77 PAYMENT ID LINE 9 416-423 ASAID
+8 ; 78-132 PAYMENT ID LINE 10 424-431 ACOID
+9 ;133-187 PAYMENT ID LINE 11 432-440 MAC
+10 ;188-242 PAYMENT ID LINE 12
+11 ;
+12 ;INPUT:
+13 ;ACRPCNT=PAYMENT NUMBER
+14 ;ACRSCH =TREAS SCHED NO
+15 ;ACRID =PAYMENT ID LINE ARRAY
+16 ;
+17 NEW Z
+18 SET $EXTRACT(Z,1,2)="06"
+19 SET $EXTRACT(Z,3,8)=$$PAD^ACRFUTL(ACRPCNT,"L",6,0)
+20 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
+21 SET $EXTRACT(Z,23,77)=$$PAD^ACRFUTL($GET(ACRID(9)),"R",55,"")
+22 SET $EXTRACT(Z,78,132)=$$PAD^ACRFUTL($GET(ACRID(10)),"R",55,"")
+23 SET $EXTRACT(Z,133,187)=$$PAD^ACRFUTL($GET(ACRID(11)),"R",55,"")
+24 SET $EXTRACT(Z,188,242)=$$PAD^ACRFUTL($GET(ACRID(12)),"R",55,"")
+25 SET $EXTRACT(Z,243,297)=$$PAD^ACRFUTL($GET(ACRID(13)),"R",55,"")
+26 SET $EXTRACT(Z,298,352)=$$PAD^ACRFUTL($GET(ACRID(14)),"R",55,"")
+27 SET $EXTRACT(Z,353,415)=$$PAD^ACRFUTL("","R",63,"")
+28 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
+29 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
+30 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
+31 ;
+32 WRITE Z
+33 QUIT
REC09(ACRPCNT,ACRSCH,ACRTAMT,ACRAPPN,ACRCNT) ;EP
+1 ;----- SCHEDULE CONTROL RECORD 09
+2 ;
+3 ; ACR*2.1*15.01 IM15981
+4 ; Moved code to ACRFEXP6 because ACRFEXP5 is too large
+5 ;
+6 DO REC09^ACRFEXP6(ACRPCNT,ACRSCH,ACRTAMT,.ACRAPPN,.ACRCNT)
+7 QUIT
REC99(ACRCNT,ACRSCH) ;EP
+1 ;----- SCHEDULE TRAILER RECORD 99
+2 ;
+3 ; ACR*2.1*15.01 IM15981
+4 ; Moved code to ACRFEXP6 because ACRFEXP5 is too large
+5 ;
+6 DO REC99^ACRFEXP6(.ACRCNT,ACRSCH)
+7 QUIT
