ACRFEXP4 ;IHS/OIRM/DSD/AEF - EXPORT TO ECS FILE [ 03/18/2005 8:43 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,16**;NOV 05, 2001
;
;ACR*2.1*2.1;THIS ROUTINE IS REWRITTEN TO RESTORE THE ACH-GROUPED
;PAYMENTS
;
;
;This routine processes payments from the 1166 Approvals
;for Payment file, formats, and places them into the UNIX
;ECS file for transmission to Treasury.
;
;It is expected that the global ^TMP("ACR",$J,"ECS") would
;have been built by routine ACRFEXP2 and will contain the
;payments to be placed into the ECS file.
;
ECS(ACRD0,ACRD1,ACRFIN,ACRALC,ACRRFC,ACRECS) ;EP
;----- MAIN ENTRY POINT
;
; INPUT:
; ACRD0 = FY IEN IN 1166 APROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRFIN = FINANCE LOCATION IEN
; ACRALC = AGENCY LOCATION CODE
; ACRRFC = REGIONAL FINANCE CENTER CODE
;
; RETURNS:
; ACRECS = TREASURY ECS FILE NAME
;
N %FILE,ACRACH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAMT,ACRAPHON,ACRAPPN,ACRBTYP,ACRCNT,ACROUT,ACRPCNT,ACRSCH
;
Q:'$D(^TMP("ACR",$J,"ECS"))
;
S ACRECS=$$NEXTECS^ACRFEXPU(ACRD0,ACRD1)
Q:ACRECS=""
;
D HFS^ACRFEXPU(ACRECS,1,.%FILE,.ACROUT)
Q:ACROUT
;
D SET1(ACRD0,ACRD1,ACRFIN,.ACRBTYP,.ACRSCH,.ACRACH,.ACRAADD1,.ACRAADD2,.ACRAADD3,.ACRAPHON)
;
D APPN(.ACRAPPN)
;
U %FILE
D REC01^ACRFEXP5(ACRSCH,ACRRFC,ACRALC,ACRECS,ACRACH,ACRBTYP)
;Require records 02,03,09,99 until moved off of old ECS machine ;ACR*2.1*16.06 IM15505
D REC02^ACRFEXP5(ACRSCH,ACRALC)
D REC03^ACRFEXP5(ACRSCH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAPHON)
;
S ACRPCNT=0
D LOOP(ACRSCH,ACRBTYP,ACRACH,.ACRPCNT,.ACRTAMT)
;
D REC09^ACRFEXP5(ACRPCNT,ACRSCH,ACRTAMT,.ACRAPPN,.ACRCNT)
D REC99^ACRFEXP5(.ACRCNT,ACRSCH)
;
D ^%ZISC
;
Q
LOOP(ACRSCH,ACRBTYP,ACRACH,ACRPCNT,ACRTAMT) ;
;----- LOOP THROUGH PAYMENTS IN ^TMP("ACR",$J) GLOBAL
;THE ACH-GROUPED PAYMENTS
;
N ACRADD,ACRADD1,ACRADD2,ACRAMT,ACRAPPN,ACRATTN,ACRATYP,ACRCITY,ACRD0,ACRD1,ACRD2,ACRDAN,ACRDATA,ACRID,ACRNAME,ACRNID,ACRPDFOR,ACRPMT,ACRRTN,ACRSSN,ACRSTATE,ACRVEND,ACRZIP
S (ACRPCNT,ACRTAMT)=0
S ACRVEND=""
F S ACRVEND=$O(^TMP("ACR",$J,"ECS",ACRACH,ACRVEND)) Q:ACRVEND']"" D
. S ACRPMT=0
. F S ACRPMT=$O(^TMP("ACR",$J,"ECS",ACRACH,ACRVEND,ACRPMT)) Q:'ACRPMT D
. . S ACRPCNT=ACRPCNT+1
. . S ACRDATA=^TMP("ACR",$J,"ECS",ACRACH,ACRVEND,ACRPMT,0)
. . S ACRAMT=$P(ACRDATA,U,2)
. . S ACRTAMT=ACRTAMT+ACRAMT
. . S ACRD0=$P(ACRDATA,U,3)
. . S ACRD1=$P(ACRDATA,U,4)
. . S ACRD2=$P(ACRDATA,U,5)
. . S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
. . S ACRSSN=""
. . I ACRBTYP="V" D
. . .S ACRSSN=$P(ACRDATA,U,10)
. . . S ACRSSN=$E($P($G(^AUTTVNDR(ACRSSN,11)),U),2,10)
. . I ACRBTYP="T" D
. . . S ACRSSN=$P(ACRDATA,U,24)
. . . S ACRSSN=$P($G(^VA(200,ACRSSN,1)),U,9)
. . S ACRATTN=$P(ACRDATA,U,25)
. . S ACRADD1=$P(ACRDATA,U,28)
. . S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,1))
. . S ACRCITY=$E($P(ACRDATA,U),1,19)
. . S ACRSTATE=$P(ACRDATA,U,2)
. . S ACRZIP=$P(ACRDATA,U,3)
. . S ACRNAME=$P(ACRDATA,U,4)
. . S ACRAPPN=$P(ACRDATA,U,21)
. . S ACRDATA=$G(^TMP("ACR",$J,"ECS",ACRACH,ACRVEND,ACRPMT,0))
. . S ACRPDFOR=$P(ACRDATA,U,6)
. . ;I ACRACH="A" D ;ACR*2.1*16.06 IM15505
. . . ;Q:"REF*^RMT*^RMR*"[$E(ACRPDFOR,1,4) ;ACR*2.1*16.06 IM15505
. . . ;S ACRPDFOR=$E(ACRPDFOR,1,30) ;ACR*2.1*16.06 IM15505
. . . ;S ACRPDFOR="RMT*"_$S(ACRBTYP="T":"VV",1:"IV")_"*"_ACRPDFOR ;ACR*2.1*16.06 IM15505
. . . ;S ACRPDFOR=ACRPDFOR_"*"_$P(ACRDATA,U,2) ;ACR*2.1*16.06 IM15505
. . . ;S ACRPDFOR=$TR(ACRPDFOR,"\","")_"\" ;ACR*2.1*16.06 IM15505
. . K ACRID,ACRNID
. . S ACRID(1)=ACRPDFOR
. . S ACRNID=1
. . I ACRACH="C" D
. . . S ACRNID=0
. . . F I=1:1:14 I $D(^TMP("ACR",$J,"ECS",ACRACH,ACRVEND,ACRPMT,I,0)) D
. . . . S ACRNID=ACRNID+1
. . . . S ACRID(ACRNID)=$P(^TMP("ACR",$J,"ECS",ACRACH,ACRVEND,ACRPMT,I,0),U,6)
. . S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,2))
. . S ACRADD2=$P(ACRDATA,U,7)
. . S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,19))
. . S ACRATYP=$P(ACRDATA,U)
. . S ACRRTN=$P(ACRDATA,U,2)
. . S ACRDAN=$P(ACRDATA,U,3)
. . K ACRADD
. . S ACRADD=0
. . I ACRATTN]"" D
. . .S ACRADD=1
. . . S ACRADD(ACRADD)="ATTN: "_ACRATTN
. . I ACRADD1]"" D
. . . S ACRADD=ACRADD+1
. . . S ACRADD(ACRADD)=ACRADD1
. . I ACRADD2]"" D
. . .S ACRADD=ACRADD+1
. . .S ACRADD(ACRADD)=ACRADD2
. . S ACRADD=ACRADD+1
. . S ACRADD(ACRADD)=ACRCITY_", "_ACRSTATE_" "_ACRZIP
. . I ACRACH="C"!(ACRACH="N") D
. . . D RECC04^ACRFEXP5(.ACRPCNT,ACRSCH,ACRAMT,ACRNAME,.ACRADD,ACRAPPN,ACRSSN,ACRNID,.ACRID)
. . . D RECC05^ACRFEXP5(ACRPCNT,ACRSCH,.ACRID)
. . . D RECC06^ACRFEXP5(ACRPCNT,ACRSCH,.ACRID)
. . I ACRACH="A"!(ACRACH="B") D
. . .D RECA04^ACRFEXP5(.ACRPCNT,ACRSCH,ACRATYP,ACRSSN,ACRAMT,ACRNAME,ACRRTN,ACRDAN,ACRAPPN,ACRPDFOR,ACRBTYP)
Q
SET1(ACRD0,ACRD1,ACRFIN,ACRBTYP,ACRSCH,ACRACH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAPHON) ;
;----- SETUP REQUIRED HEADER/TRAILER RECORD VARIABLES
;
N ACRDATA,ACRSTATE
S ACRBTYP=$P($G(^AFSLAFP(ACRD0,1,ACRD1,0)),U,4)
S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,2))
S ACRSCH=$P(ACRDATA,U,6)
S ACRACH=$P(ACRDATA,U,8)
;
S ACRDATA=$G(^AUTTPRG(ACRFIN,"DT"))
S ACRAADD1=$P(ACRDATA,U)
S ACRAADD2=$P(ACRDATA,U,2)
S ACRAADD3=$P(ACRDATA,U,3)
S ACRSTATE=$P(ACRDATA,U,4)
I ACRSTATE S ACRSTATE=$P($G(^DIC(5,ACRSTATE,0)),U,2)
S ACRAADD3=ACRAADD3_", "_ACRSTATE_" "_$P(ACRDATA,U,5)
S ACRAPHON=$TR($P(ACRDATA,U,6),"-","")
Q
APPN(ACRAPPN) ;
;----- SETS APPROPRIATION NUMBER ARRAY USED FOR 09 RECORDS
;
N ACRCNT
S ACRCNT=0
F S ACRCNT=$O(^TMP("ACR",$J,"ECSAPPN",ACRCNT)) Q:'ACRCNT D
. S ACRAPPN(ACRCNT)=^TMP("ACR",$J,"ECSAPPN",ACRCNT,0)
Q
ACRFEXP4 ;IHS/OIRM/DSD/AEF - EXPORT TO ECS FILE [ 03/18/2005 8:43 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,16**;NOV 05, 2001
+2 ;
+3 ;ACR*2.1*2.1;THIS ROUTINE IS REWRITTEN TO RESTORE THE ACH-GROUPED
+4 ;PAYMENTS
+5 ;
+6 ;
+7 ;This routine processes payments from the 1166 Approvals
+8 ;for Payment file, formats, and places them into the UNIX
+9 ;ECS file for transmission to Treasury.
+10 ;
+11 ;It is expected that the global ^TMP("ACR",$J,"ECS") would
+12 ;have been built by routine ACRFEXP2 and will contain the
+13 ;payments to be placed into the ECS file.
+14 ;
ECS(ACRD0,ACRD1,ACRFIN,ACRALC,ACRRFC,ACRECS) ;EP
+1 ;----- MAIN ENTRY POINT
+2 ;
+3 ; INPUT:
+4 ; ACRD0 = FY IEN IN 1166 APROVALS FOR PAYMENT FILE
+5 ; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
+6 ; ACRFIN = FINANCE LOCATION IEN
+7 ; ACRALC = AGENCY LOCATION CODE
+8 ; ACRRFC = REGIONAL FINANCE CENTER CODE
+9 ;
+10 ; RETURNS:
+11 ; ACRECS = TREASURY ECS FILE NAME
+12 ;
+13 NEW %FILE,ACRACH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAMT,ACRAPHON,ACRAPPN,ACRBTYP,ACRCNT,ACROUT,ACRPCNT,ACRSCH
+14 ;
+15 IF '$DATA(^TMP("ACR",$JOB,"ECS"))
QUIT
+16 ;
+17 SET ACRECS=$$NEXTECS^ACRFEXPU(ACRD0,ACRD1)
+18 IF ACRECS=""
QUIT
+19 ;
+20 DO HFS^ACRFEXPU(ACRECS,1,.%FILE,.ACROUT)
+21 IF ACROUT
QUIT
+22 ;
+23 DO SET1(ACRD0,ACRD1,ACRFIN,.ACRBTYP,.ACRSCH,.ACRACH,.ACRAADD1,.ACRAADD2,.ACRAADD3,.ACRAPHON)
+24 ;
+25 DO APPN(.ACRAPPN)
+26 ;
+27 USE %FILE
+28 DO REC01^ACRFEXP5(ACRSCH,ACRRFC,ACRALC,ACRECS,ACRACH,ACRBTYP)
+29 ;Require records 02,03,09,99 until moved off of old ECS machine ;ACR*2.1*16.06 IM15505
+30 DO REC02^ACRFEXP5(ACRSCH,ACRALC)
+31 DO REC03^ACRFEXP5(ACRSCH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAPHON)
+32 ;
+33 SET ACRPCNT=0
+34 DO LOOP(ACRSCH,ACRBTYP,ACRACH,.ACRPCNT,.ACRTAMT)
+35 ;
+36 DO REC09^ACRFEXP5(ACRPCNT,ACRSCH,ACRTAMT,.ACRAPPN,.ACRCNT)
+37 DO REC99^ACRFEXP5(.ACRCNT,ACRSCH)
+38 ;
+39 DO ^%ZISC
+40 ;
+41 QUIT
LOOP(ACRSCH,ACRBTYP,ACRACH,ACRPCNT,ACRTAMT) ;
+1 ;----- LOOP THROUGH PAYMENTS IN ^TMP("ACR",$J) GLOBAL
+2 ;THE ACH-GROUPED PAYMENTS
+3 ;
+4 NEW ACRADD,ACRADD1,ACRADD2,ACRAMT,ACRAPPN,ACRATTN,ACRATYP,ACRCITY,ACRD0,ACRD1,ACRD2,ACRDAN,ACRDATA,ACRID,ACRNAME,ACRNID,ACRPDFOR,ACRPMT,ACRRTN,ACRSSN,ACRSTATE,ACRVEND,ACRZIP
+5 SET (ACRPCNT,ACRTAMT)=0
+6 SET ACRVEND=""
+7 FOR
SET ACRVEND=$ORDER(^TMP("ACR",$JOB,"ECS",ACRACH,ACRVEND))
IF ACRVEND']""
QUIT
Begin DoDot:1
+8 SET ACRPMT=0
+9 FOR
SET ACRPMT=$ORDER(^TMP("ACR",$JOB,"ECS",ACRACH,ACRVEND,ACRPMT))
IF 'ACRPMT
QUIT
Begin DoDot:2
+10 SET ACRPCNT=ACRPCNT+1
+11 SET ACRDATA=^TMP("ACR",$JOB,"ECS",ACRACH,ACRVEND,ACRPMT,0)
+12 SET ACRAMT=$PIECE(ACRDATA,U,2)
+13 SET ACRTAMT=ACRTAMT+ACRAMT
+14 SET ACRD0=$PIECE(ACRDATA,U,3)
+15 SET ACRD1=$PIECE(ACRDATA,U,4)
+16 SET ACRD2=$PIECE(ACRDATA,U,5)
+17 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
+18 SET ACRSSN=""
+19 IF ACRBTYP="V"
Begin DoDot:3
+20 SET ACRSSN=$PIECE(ACRDATA,U,10)
+21 SET ACRSSN=$EXTRACT($PIECE($GET(^AUTTVNDR(ACRSSN,11)),U),2,10)
End DoDot:3
+22 IF ACRBTYP="T"
Begin DoDot:3
+23 SET ACRSSN=$PIECE(ACRDATA,U,24)
+24 SET ACRSSN=$PIECE($GET(^VA(200,ACRSSN,1)),U,9)
End DoDot:3
+25 SET ACRATTN=$PIECE(ACRDATA,U,25)
+26 SET ACRADD1=$PIECE(ACRDATA,U,28)
+27 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,1))
+28 SET ACRCITY=$EXTRACT($PIECE(ACRDATA,U),1,19)
+29 SET ACRSTATE=$PIECE(ACRDATA,U,2)
+30 SET ACRZIP=$PIECE(ACRDATA,U,3)
+31 SET ACRNAME=$PIECE(ACRDATA,U,4)
+32 SET ACRAPPN=$PIECE(ACRDATA,U,21)
+33 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS",ACRACH,ACRVEND,ACRPMT,0))
+34 SET ACRPDFOR=$PIECE(ACRDATA,U,6)
+35 ;I ACRACH="A" D ;ACR*2.1*16.06 IM15505
+36 ;Q:"REF*^RMT*^RMR*"[$E(ACRPDFOR,1,4) ;ACR*2.1*16.06 IM15505
+37 ;S ACRPDFOR=$E(ACRPDFOR,1,30) ;ACR*2.1*16.06 IM15505
+38 ;S ACRPDFOR="RMT*"_$S(ACRBTYP="T":"VV",1:"IV")_"*"_ACRPDFOR ;ACR*2.1*16.06 IM15505
+39 ;S ACRPDFOR=ACRPDFOR_"*"_$P(ACRDATA,U,2) ;ACR*2.1*16.06 IM15505
+40 ;S ACRPDFOR=$TR(ACRPDFOR,"\","")_"\" ;ACR*2.1*16.06 IM15505
+41 KILL ACRID,ACRNID
+42 SET ACRID(1)=ACRPDFOR
+43 SET ACRNID=1
+44 IF ACRACH="C"
Begin DoDot:3
+45 SET ACRNID=0
+46 FOR I=1:1:14
IF $DATA(^TMP("ACR",$JOB,"ECS",ACRACH,ACRVEND,ACRPMT,I,0))
Begin DoDot:4
+47 SET ACRNID=ACRNID+1
+48 SET ACRID(ACRNID)=$PIECE(^TMP("ACR",$JOB,"ECS",ACRACH,ACRVEND,ACRPMT,I,0),U,6)
End DoDot:4
End DoDot:3
+49 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,2))
+50 SET ACRADD2=$PIECE(ACRDATA,U,7)
+51 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,19))
+52 SET ACRATYP=$PIECE(ACRDATA,U)
+53 SET ACRRTN=$PIECE(ACRDATA,U,2)
+54 SET ACRDAN=$PIECE(ACRDATA,U,3)
+55 KILL ACRADD
+56 SET ACRADD=0
+57 IF ACRATTN]""
Begin DoDot:3
+58 SET ACRADD=1
+59 SET ACRADD(ACRADD)="ATTN: "_ACRATTN
End DoDot:3
+60 IF ACRADD1]""
Begin DoDot:3
+61 SET ACRADD=ACRADD+1
+62 SET ACRADD(ACRADD)=ACRADD1
End DoDot:3
+63 IF ACRADD2]""
Begin DoDot:3
+64 SET ACRADD=ACRADD+1
+65 SET ACRADD(ACRADD)=ACRADD2
End DoDot:3
+66 SET ACRADD=ACRADD+1
+67 SET ACRADD(ACRADD)=ACRCITY_", "_ACRSTATE_" "_ACRZIP
+68 IF ACRACH="C"!(ACRACH="N")
Begin DoDot:3
+69 DO RECC04^ACRFEXP5(.ACRPCNT,ACRSCH,ACRAMT,ACRNAME,.ACRADD,ACRAPPN,ACRSSN,ACRNID,.ACRID)
+70 DO RECC05^ACRFEXP5(ACRPCNT,ACRSCH,.ACRID)
+71 DO RECC06^ACRFEXP5(ACRPCNT,ACRSCH,.ACRID)
End DoDot:3
+72 IF ACRACH="A"!(ACRACH="B")
Begin DoDot:3
+73 DO RECA04^ACRFEXP5(.ACRPCNT,ACRSCH,ACRATYP,ACRSSN,ACRAMT,ACRNAME,ACRRTN,ACRDAN,ACRAPPN,ACRPDFOR,ACRBTYP)
End DoDot:3
End DoDot:2
End DoDot:1
+74 QUIT
SET1(ACRD0,ACRD1,ACRFIN,ACRBTYP,ACRSCH,ACRACH,ACRAADD1,ACRAADD2,ACRAADD3,ACRAPHON) ;
+1 ;----- SETUP REQUIRED HEADER/TRAILER RECORD VARIABLES
+2 ;
+3 NEW ACRDATA,ACRSTATE
+4 SET ACRBTYP=$PIECE($GET(^AFSLAFP(ACRD0,1,ACRD1,0)),U,4)
+5 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,2))
+6 SET ACRSCH=$PIECE(ACRDATA,U,6)
+7 SET ACRACH=$PIECE(ACRDATA,U,8)
+8 ;
+9 SET ACRDATA=$GET(^AUTTPRG(ACRFIN,"DT"))
+10 SET ACRAADD1=$PIECE(ACRDATA,U)
+11 SET ACRAADD2=$PIECE(ACRDATA,U,2)
+12 SET ACRAADD3=$PIECE(ACRDATA,U,3)
+13 SET ACRSTATE=$PIECE(ACRDATA,U,4)
+14 IF ACRSTATE
SET ACRSTATE=$PIECE($GET(^DIC(5,ACRSTATE,0)),U,2)
+15 SET ACRAADD3=ACRAADD3_", "_ACRSTATE_" "_$PIECE(ACRDATA,U,5)
+16 SET ACRAPHON=$TRANSLATE($PIECE(ACRDATA,U,6),"-","")
+17 QUIT
APPN(ACRAPPN) ;
+1 ;----- SETS APPROPRIATION NUMBER ARRAY USED FOR 09 RECORDS
+2 ;
+3 NEW ACRCNT
+4 SET ACRCNT=0
+5 FOR
SET ACRCNT=$ORDER(^TMP("ACR",$JOB,"ECSAPPN",ACRCNT))
IF 'ACRCNT
QUIT
Begin DoDot:1
+6 SET ACRAPPN(ACRCNT)=^TMP("ACR",$JOB,"ECSAPPN",ACRCNT,0)
End DoDot:1
+7 QUIT
