- ACRFEXP6 ;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*15.01;NEW ROUTINE
- ;
- ; Called from ACRFEXP5 linetags because ACRFEXP5 got too big
- ;
- Q
- ;
- REC02(ACRSCH,ACRALC) ;EP
- ;----- AGENCY LOCATION CODE (ALC) CONTROL RECORD 02
- ;
- ;RECORD LAYOUT:
- ; 1-2 RECORD TYPE "02" 55-55 RECORD CODE
- ; 3-8 RECORD NUMBER 56-415 FILLER
- ; 9-22 SCHEDULE NO 416-423 ASAID
- ;23-35 FILLER 424-431 ACOID
- ;36-43 ALC 432-440 MAC
- ;44-54 FILLER
- ;
- ;INPUT:
- ;ACRSCH=TREAS SCHED N0
- ;ACRALC=AGENCY LOC CODE
- ;
- N Z
- S $E(Z,1,2)="02"
- S $E(Z,3,8)="000001"
- S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- S $E(Z,23,35)=$$PAD^ACRFUTL("","R",13,"")
- S $E(Z,36,43)=$$PAD^ACRFUTL(ACRALC,"R",8,"")
- S $E(Z,44,54)=$$PAD^ACRFUTL("","R",11,"")
- S $E(Z,55)="&"
- S $E(Z,56,415)=$$PAD^ACRFUTL("","R",360,"")
- 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
- ;
- REC03(ACRSCH,ACRADD1,ACRADD2,ACRADD3,ACRPHON) ;EP
- ;----- AGENCY BILLING ADDRESS CONTROL RECORD 03
- ;
- ;RECORD LAYOUT:
- ; 1-2 RECORD TYPE "03" 106-130 ADDRESS 2
- ; 3-8 RECORD NUMBER 131-155 ADDRESS 3
- ; 9-22 SCHEDULE NUMBER 156-165 AGENCY TELEPHONE
- ;23-35 ZERO FILL 166-415 FILLER
- ;36-54 FILLER 416-423 ASAID
- ;55-55 RECORD CODE "A" 424-431 ACOID
- ;56-80 AGENCY NAME 432-440 MAC
- ;81-105 ADDRESS 1
- ;
- ;INPUT:
- ;ACRSCH =TREAS SCHED NO
- ;ACRADD1=ADDRESS LINE 1
- ;ACRADD2=ADDRESS LINE 2
- ;ACRADD3=ADDRESS LINE 3
- ;ACRPHON=PHONE NUMBER
- ;
- N Z
- S $E(Z,1,2)="03"
- S $E(Z,3,8)="000002"
- S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- S $E(Z,23,35)=$$PAD^ACRFUTL(0,"R",13,0)
- S $E(Z,36,54)=$$PAD^ACRFUTL("","R",19,"")
- S $E(Z,55)="A"
- S $E(Z,56,80)=$$PAD^ACRFUTL("INDIAN HEALTH SERVICE","R",25,"")
- S $E(Z,81,105)=$$PAD^ACRFUTL(ACRADD1,"R",25,"")
- S $E(Z,106,130)=$$PAD^ACRFUTL(ACRADD2,"R",25,"")
- S $E(Z,131,155)=$$PAD^ACRFUTL(ACRADD3,"R",25,"")
- S $E(Z,156,165)=$$PAD^ACRFUTL(ACRPHON,"R",10,"")
- S $E(Z,166,415)=$$PAD^ACRFUTL("","R",250,"")
- 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
- ;
- ;RECORD LAYOUT:
- ; 1-2 RECORD TYPE "09" 189-201 APPROPRIATED AMT 5
- ; 3-8 RECORD NUMBER 202-217 ACCOUNT SYMBOL 6
- ; 9-22 SCHEDULE NUMBER 218-230 APPROPRIATED AMT 6
- ; 23-35 9 FILLER 231-246 ACCOUNT SYMBOL 7
- ; 36-42 SCHEDULE ITEM COUNT 247-259 APPROPRIATED AMT 7
- ; 43-55 SCHEDULE AMOUNT 260-275 ACCOUNT SYMBOL 8
- ; 56-56 RECORD CODE 276-288 APPROPRIATED AMT 8
- ; 57-72 ACCOUNT SYMBOL 1 289-304 ACCOUNT SYMBOL 9
- ; 73-85 APPROPRIATED AMT 1 305-317 APPROPRIATED AMT 9
- ; 86-101 ACCOUNT SYMBOL 2 318-333 ACCOUNT SYMBOL 10
- ;102-114 APPROPRIATED AMT 2 334-346 APPROPRIATED AMT 10
- ;115-130 ACCOUNT SYMBOL 3 347-415 FILLER
- ;131-143 APPROPRIATED AMT 3 416-423 ASAID
- ;144-159 ACCOUNT SYMBOL 4 424-431 ACOID
- ;160-172 APPROPRIATED AMT 4 432-440 MAC
- ;173-188 ACCOUNT SYMBOL 5
- ;
- ;INPUT:
- ;ACRPCNT=PAYMENT NUMBER
- ;ACRSCH =TREAS SCHED NO
- ;ACRTAMT=TOTAL AMOUNT OF PAYMENTS
- ;ACRAPPN=APPROPRIATION AMOUNTS
- ;
- ;RETURNS:
- ;ACRCNT = RECORD COUNT USED BY 99 RECORD
- ;
- N Z
- S ACRCNT=ACRPCNT+1
- S $E(Z,1,2)="09"
- S $E(Z,3,8)=$$PAD^ACRFUTL(ACRCNT,"L",6,0)
- S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- S $E(Z,23,35)=$$PAD^ACRFUTL(9,"R",13,9)
- S $E(Z,36,42)=$$PAD^ACRFUTL(ACRPCNT,"L",7,0)
- S $E(Z,43,55)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL(ACRTAMT),".",""),"L",13,0)
- S $E(Z,56)="C"
- S $E(Z,57,72)=$$PAD^ACRFUTL($P($G(ACRAPPN(1)),U),"R",16,"")
- S $E(Z,73,85)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(1)),U,2)),".",""),"L",13,0)
- S $E(Z,86,101)=$$PAD^ACRFUTL($P($G(ACRAPPN(2)),U),"R",16,"")
- S $E(Z,102,114)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(2)),U,2)),".",""),"L",13,0)
- S $E(Z,115,130)=$$PAD^ACRFUTL($P($G(ACRAPPN(3)),U),"R",16,"")
- S $E(Z,131,143)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(3)),U,2)),".",""),"L",13,0)
- S $E(Z,144,159)=$$PAD^ACRFUTL($P($G(ACRAPPN(4)),U),"R",16,"")
- S $E(Z,160,172)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(4)),U,2)),".",""),"L",13,0)
- S $E(Z,173,188)=$$PAD^ACRFUTL($P($G(ACRAPPN(5)),U),"R",16,"")
- S $E(Z,189,201)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(5)),U,2)),".",""),"L",13,0)
- S $E(Z,202,217)=$$PAD^ACRFUTL($P($G(ACRAPPN(6)),U),"R",16,"")
- S $E(Z,218,230)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(6)),U,2)),".",""),"L",13,0)
- S $E(Z,231,246)=$$PAD^ACRFUTL($P($G(ACRAPPN(7)),U),"R",16,"")
- S $E(Z,247,259)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(7)),U,2)),".",""),"L",13,0)
- S $E(Z,260,275)=$$PAD^ACRFUTL($P($G(ACRAPPN(8)),U),"R",16,"")
- S $E(Z,276,288)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(8)),U,2)),".",""),"L",13,0)
- S $E(Z,289,304)=$$PAD^ACRFUTL($P($G(ACRAPPN(9)),U),"R",16,"")
- S $E(Z,305,317)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(9)),U,2)),".",""),"L",13,0)
- S $E(Z,318,333)=$$PAD^ACRFUTL($P($G(ACRAPPN(10)),U),"R",16,"")
- S $E(Z,334,346)=$$PAD^ACRFUTL($TR($$DOL^ACRFUTL($P($G(ACRAPPN(10)),U,2)),".",""),"L",13,0)
- S $E(Z,347,415)=$$PAD^ACRFUTL("","R",69,"")
- 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
- ;
- REC99(ACRCNT,ACRSCH) ;EP
- ;----- SCHEDULE TRAILER RECORD 99
- ;
- ;RECORD LAYOUT:
- ; 1-2 RECORD TYPE "99" 416-423 ASAID
- ; 3-8 RECORD NUMBER 424-431 ACOID
- ; 9-22 SCHEDULE NUMBER 432-440 MAC
- ;23-415 FILLER
- ;
- ;INPUT:
- ;ACRCNT=RECORD COUNT
- ;ACRSCH=TREAS SCHED NO
- ;
- N Z
- S ACRCNT=ACRCNT+1
- S $E(Z,1,2)=99
- S $E(Z,3,8)=$$PAD^ACRFUTL(ACRCNT,"L",6,0)
- S $E(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- S $E(Z,23,415)=$$PAD^ACRFUTL("","R",393,"")
- 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
- ACRFEXP6 ;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*15.01;NEW ROUTINE
- +4 ;
- +5 ; Called from ACRFEXP5 linetags because ACRFEXP5 got too big
- +6 ;
- +7 QUIT
- +8 ;
- REC02(ACRSCH,ACRALC) ;EP
- +1 ;----- AGENCY LOCATION CODE (ALC) CONTROL RECORD 02
- +2 ;
- +3 ;RECORD LAYOUT:
- +4 ; 1-2 RECORD TYPE "02" 55-55 RECORD CODE
- +5 ; 3-8 RECORD NUMBER 56-415 FILLER
- +6 ; 9-22 SCHEDULE NO 416-423 ASAID
- +7 ;23-35 FILLER 424-431 ACOID
- +8 ;36-43 ALC 432-440 MAC
- +9 ;44-54 FILLER
- +10 ;
- +11 ;INPUT:
- +12 ;ACRSCH=TREAS SCHED N0
- +13 ;ACRALC=AGENCY LOC CODE
- +14 ;
- +15 NEW Z
- +16 SET $EXTRACT(Z,1,2)="02"
- +17 SET $EXTRACT(Z,3,8)="000001"
- +18 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- +19 SET $EXTRACT(Z,23,35)=$$PAD^ACRFUTL("","R",13,"")
- +20 SET $EXTRACT(Z,36,43)=$$PAD^ACRFUTL(ACRALC,"R",8,"")
- +21 SET $EXTRACT(Z,44,54)=$$PAD^ACRFUTL("","R",11,"")
- +22 SET $EXTRACT(Z,55)="&"
- +23 SET $EXTRACT(Z,56,415)=$$PAD^ACRFUTL("","R",360,"")
- +24 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
- +25 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
- +26 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
- +27 ;
- +28 WRITE Z
- +29 QUIT
- +30 ;
- REC03(ACRSCH,ACRADD1,ACRADD2,ACRADD3,ACRPHON) ;EP
- +1 ;----- AGENCY BILLING ADDRESS CONTROL RECORD 03
- +2 ;
- +3 ;RECORD LAYOUT:
- +4 ; 1-2 RECORD TYPE "03" 106-130 ADDRESS 2
- +5 ; 3-8 RECORD NUMBER 131-155 ADDRESS 3
- +6 ; 9-22 SCHEDULE NUMBER 156-165 AGENCY TELEPHONE
- +7 ;23-35 ZERO FILL 166-415 FILLER
- +8 ;36-54 FILLER 416-423 ASAID
- +9 ;55-55 RECORD CODE "A" 424-431 ACOID
- +10 ;56-80 AGENCY NAME 432-440 MAC
- +11 ;81-105 ADDRESS 1
- +12 ;
- +13 ;INPUT:
- +14 ;ACRSCH =TREAS SCHED NO
- +15 ;ACRADD1=ADDRESS LINE 1
- +16 ;ACRADD2=ADDRESS LINE 2
- +17 ;ACRADD3=ADDRESS LINE 3
- +18 ;ACRPHON=PHONE NUMBER
- +19 ;
- +20 NEW Z
- +21 SET $EXTRACT(Z,1,2)="03"
- +22 SET $EXTRACT(Z,3,8)="000002"
- +23 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- +24 SET $EXTRACT(Z,23,35)=$$PAD^ACRFUTL(0,"R",13,0)
- +25 SET $EXTRACT(Z,36,54)=$$PAD^ACRFUTL("","R",19,"")
- +26 SET $EXTRACT(Z,55)="A"
- +27 SET $EXTRACT(Z,56,80)=$$PAD^ACRFUTL("INDIAN HEALTH SERVICE","R",25,"")
- +28 SET $EXTRACT(Z,81,105)=$$PAD^ACRFUTL(ACRADD1,"R",25,"")
- +29 SET $EXTRACT(Z,106,130)=$$PAD^ACRFUTL(ACRADD2,"R",25,"")
- +30 SET $EXTRACT(Z,131,155)=$$PAD^ACRFUTL(ACRADD3,"R",25,"")
- +31 SET $EXTRACT(Z,156,165)=$$PAD^ACRFUTL(ACRPHON,"R",10,"")
- +32 SET $EXTRACT(Z,166,415)=$$PAD^ACRFUTL("","R",250,"")
- +33 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
- +34 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
- +35 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
- +36 ;
- +37 WRITE Z
- +38 QUIT
- +39 ;
- REC09(ACRPCNT,ACRSCH,ACRTAMT,ACRAPPN,ACRCNT) ;EP
- +1 ;----- SCHEDULE CONTROL RECORD 09
- +2 ;
- +3 ;RECORD LAYOUT:
- +4 ; 1-2 RECORD TYPE "09" 189-201 APPROPRIATED AMT 5
- +5 ; 3-8 RECORD NUMBER 202-217 ACCOUNT SYMBOL 6
- +6 ; 9-22 SCHEDULE NUMBER 218-230 APPROPRIATED AMT 6
- +7 ; 23-35 9 FILLER 231-246 ACCOUNT SYMBOL 7
- +8 ; 36-42 SCHEDULE ITEM COUNT 247-259 APPROPRIATED AMT 7
- +9 ; 43-55 SCHEDULE AMOUNT 260-275 ACCOUNT SYMBOL 8
- +10 ; 56-56 RECORD CODE 276-288 APPROPRIATED AMT 8
- +11 ; 57-72 ACCOUNT SYMBOL 1 289-304 ACCOUNT SYMBOL 9
- +12 ; 73-85 APPROPRIATED AMT 1 305-317 APPROPRIATED AMT 9
- +13 ; 86-101 ACCOUNT SYMBOL 2 318-333 ACCOUNT SYMBOL 10
- +14 ;102-114 APPROPRIATED AMT 2 334-346 APPROPRIATED AMT 10
- +15 ;115-130 ACCOUNT SYMBOL 3 347-415 FILLER
- +16 ;131-143 APPROPRIATED AMT 3 416-423 ASAID
- +17 ;144-159 ACCOUNT SYMBOL 4 424-431 ACOID
- +18 ;160-172 APPROPRIATED AMT 4 432-440 MAC
- +19 ;173-188 ACCOUNT SYMBOL 5
- +20 ;
- +21 ;INPUT:
- +22 ;ACRPCNT=PAYMENT NUMBER
- +23 ;ACRSCH =TREAS SCHED NO
- +24 ;ACRTAMT=TOTAL AMOUNT OF PAYMENTS
- +25 ;ACRAPPN=APPROPRIATION AMOUNTS
- +26 ;
- +27 ;RETURNS:
- +28 ;ACRCNT = RECORD COUNT USED BY 99 RECORD
- +29 ;
- +30 NEW Z
- +31 SET ACRCNT=ACRPCNT+1
- +32 SET $EXTRACT(Z,1,2)="09"
- +33 SET $EXTRACT(Z,3,8)=$$PAD^ACRFUTL(ACRCNT,"L",6,0)
- +34 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- +35 SET $EXTRACT(Z,23,35)=$$PAD^ACRFUTL(9,"R",13,9)
- +36 SET $EXTRACT(Z,36,42)=$$PAD^ACRFUTL(ACRPCNT,"L",7,0)
- +37 SET $EXTRACT(Z,43,55)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL(ACRTAMT),".",""),"L",13,0)
- +38 SET $EXTRACT(Z,56)="C"
- +39 SET $EXTRACT(Z,57,72)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(1)),U),"R",16,"")
- +40 SET $EXTRACT(Z,73,85)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(1)),U,2)),".",""),"L",13,0)
- +41 SET $EXTRACT(Z,86,101)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(2)),U),"R",16,"")
- +42 SET $EXTRACT(Z,102,114)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(2)),U,2)),".",""),"L",13,0)
- +43 SET $EXTRACT(Z,115,130)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(3)),U),"R",16,"")
- +44 SET $EXTRACT(Z,131,143)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(3)),U,2)),".",""),"L",13,0)
- +45 SET $EXTRACT(Z,144,159)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(4)),U),"R",16,"")
- +46 SET $EXTRACT(Z,160,172)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(4)),U,2)),".",""),"L",13,0)
- +47 SET $EXTRACT(Z,173,188)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(5)),U),"R",16,"")
- +48 SET $EXTRACT(Z,189,201)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(5)),U,2)),".",""),"L",13,0)
- +49 SET $EXTRACT(Z,202,217)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(6)),U),"R",16,"")
- +50 SET $EXTRACT(Z,218,230)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(6)),U,2)),".",""),"L",13,0)
- +51 SET $EXTRACT(Z,231,246)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(7)),U),"R",16,"")
- +52 SET $EXTRACT(Z,247,259)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(7)),U,2)),".",""),"L",13,0)
- +53 SET $EXTRACT(Z,260,275)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(8)),U),"R",16,"")
- +54 SET $EXTRACT(Z,276,288)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(8)),U,2)),".",""),"L",13,0)
- +55 SET $EXTRACT(Z,289,304)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(9)),U),"R",16,"")
- +56 SET $EXTRACT(Z,305,317)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(9)),U,2)),".",""),"L",13,0)
- +57 SET $EXTRACT(Z,318,333)=$$PAD^ACRFUTL($PIECE($GET(ACRAPPN(10)),U),"R",16,"")
- +58 SET $EXTRACT(Z,334,346)=$$PAD^ACRFUTL($TRANSLATE($$DOL^ACRFUTL($PIECE($GET(ACRAPPN(10)),U,2)),".",""),"L",13,0)
- +59 SET $EXTRACT(Z,347,415)=$$PAD^ACRFUTL("","R",69,"")
- +60 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
- +61 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
- +62 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
- +63 ;
- +64 WRITE Z
- +65 QUIT
- +66 ;
- REC99(ACRCNT,ACRSCH) ;EP
- +1 ;----- SCHEDULE TRAILER RECORD 99
- +2 ;
- +3 ;RECORD LAYOUT:
- +4 ; 1-2 RECORD TYPE "99" 416-423 ASAID
- +5 ; 3-8 RECORD NUMBER 424-431 ACOID
- +6 ; 9-22 SCHEDULE NUMBER 432-440 MAC
- +7 ;23-415 FILLER
- +8 ;
- +9 ;INPUT:
- +10 ;ACRCNT=RECORD COUNT
- +11 ;ACRSCH=TREAS SCHED NO
- +12 ;
- +13 NEW Z
- +14 SET ACRCNT=ACRCNT+1
- +15 SET $EXTRACT(Z,1,2)=99
- +16 SET $EXTRACT(Z,3,8)=$$PAD^ACRFUTL(ACRCNT,"L",6,0)
- +17 SET $EXTRACT(Z,9,22)=$$PAD^ACRFUTL(ACRSCH,"L",14,0)
- +18 SET $EXTRACT(Z,23,415)=$$PAD^ACRFUTL("","R",393,"")
- +19 SET $EXTRACT(Z,416,423)=$$PAD^ACRFUTL("","R",8,"")
- +20 SET $EXTRACT(Z,424,431)=$$PAD^ACRFUTL("","R",8,"")
- +21 SET $EXTRACT(Z,432,440)=$$PAD^ACRFUTL("","R",9,"")
- +22 ;
- +23 WRITE Z
- +24 QUIT