ACRFEXP2 ;IHS/OIRM/DSD/AEF - MAIN DRIVER ROUTINE FOR DHR & ECS EXPORT [ 09/23/2005 8:29 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,19**;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 and places them into the DHR Data Records
;file for subsequent transmission to CORE and into the Treasury
;ECS file for transmission to Treasury
;
; VARIABLES USED:
; ACRALC = AGENCY LOCATION CODE USED BY TREASURY
; ACRBTYP= BATCH TYPE: T=TRAVEL;V=VENDOR
; ACRECS = UNIX TREASURY ECS FILE NAME
; ACRFIN = FINANCE OFFICE IEN
; ACRRFC = TREASURY REGIONAL FINANCE CENTER CODE
; ACRACH = TREASURY SCHEDULE FORMAT:
; T = TAPE-GROUPED
; C = CHECKS GROUPED
; N = CHECKS-NOT GROUPED
; A = ACH-GROUPED (ELECTRONIC FUNDS TRANSFER)
; B = ACH-NOT GROUPED (ELECTRONIC FUNDS TRANSFER)
; G = DHR ONLY
;
;
EN(ACRD0,ACRD1) ;EP
;----- MAIN DRIVER ENTRY POINT
;
; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRALC = AGENCY LOCATION CODE
; ACRFIN = FINANCE OFFICE IEN
; ACROUT = QUIT CONTROLLER
; ACRRFC = REGIONAL FINANCE CENTER
;
N ACRALC,ACRECS,ACRFIN,ACROUT,ACRRFC
;
D FINCHK(.ACRFIN,.ACROUT)
Q:ACROUT
;
D PARAMCK(1,.ACRALC,.ACRRFC,.ACROUT)
Q:ACROUT
;
D GET(ACRD0,ACRD1)
Q:'$D(^TMP("ACR",$J))
;
D DHR^ACRFEXP3
;
D ECS^ACRFEXP4(ACRD0,ACRD1,ACRFIN,ACRALC,ACRRFC,.ACRECS)
;
D UPDATE(ACRD0,ACRD1,$G(ACRECS))
;
D BSR(ACRD0,ACRD1)
;
K ^TMP("ACR",$J)
;
Q
GET(ACRD0,ACRD1) ;
;----- LOOP THROUGH 1166 APPROVALS FOR PAYMENT SEQUENCES
; TO GATHER PAYMENT DATA AND PUT INTO ^TMP("ACR",$J)
; GLOBAL
;
; ACRACH = TREASURY SCHEDULE FORMAT
; ACRAMT = TRANSACTION AMOUNT
; ACRAPPN = APPROPRIATION NUMBER
; ACRBTYP = BATCH TYPE
; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN IN 1166 AFP FILE
; ACRD2 = SEQ NO IEN IN 1166 AFP FILE
; ACRIEN = VENDOR/TRAVELER INTERNAL ENTRY NUMBER
; ACRNAME = VENDOR/TRAVELER NAME
; ACROCC = OBJECT CLASS CODE
; ACRPDFOR= ACH ADDENDUM/INVOICE NUMBER/TO NUMBER
; ACRREF = REFERENCE CODE
; ACRSSN = VENDOR EIN/TRAVELER SSN
; ACRTCOD = TRANSACTION TYPE
;
N ACRD2,ACRACH,ACRAMT,ACRAPPN,ACRBTYP,ACRDATA,ACRIEN,ACRNAME,ACROCC,ACRPDFOR,ACRREF,ACRSSN,ACRTCOD
K ^TMP("ACR",$J)
S ACRBTYP=$P($G(^AFSLAFP(ACRD0,1,ACRD1,0)),U,4)
Q:ACRBTYP=""
S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,2))
S ACRACH=$P(ACRDATA,U,8)
Q:ACRACH=""
S ACRD2=0
F S ACRD2=$O(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2)) Q:'ACRD2 D
. S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
. S ACRTCOD=$P(ACRDATA,U,18)
. Q:ACRTCOD=""
. S ACRAMT=+$P(ACRDATA,U,11)
. I $E(ACRTCOD,U,4)=2 S ACRAMT=0-ACRAMT
. S ACRREF=$P(ACRDATA,U,6)
. S ACRREF=$TR(ACRREF," ","")
. Q:ACRREF=""
. S ACROCC=$P(ACRDATA,U,8)
. Q:'ACROCC
. S ACROCC=$P($G(^AUTTOBJC(ACROCC,0)),U)
. Q:ACROCC=""
. I ACRBTYP="V" D
. . S ACRIEN=$P(ACRDATA,U,10)
. . S ACRNAME=$P($G(^AUTTVNDR(ACRIEN,0)),U)
. . S ACRSSN=$P($G(^AUTTVNDR(ACRIEN,11)),U,13)
. I ACRBTYP="T" D
. . S ACRIEN=$P(ACRDATA,U,24)
. . ;S ACRNAME=$P($G(^VA(200,ACRIEN,0)),U) ;ACR*2.1*19.02 IM16848
. . S ACRNAME=$$NAME2^ACRFUTL1(ACRIEN) ;ACR*2.1*19.02 IM16848
. . S ACRSSN=$P($G(^VA(200,ACRIEN,1)),U,9)
. Q:ACRNAME=""
. S ACRAPPN=$P($G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,1)),U,21)
. Q:ACRAPPN=""
. S ACRNAME=$$UPPER^ACRFUTL(ACRNAME)
. S ACRNAME=$TR(ACRNAME,"~"," ")
. S ACRNAME=ACRNAME_"~"_ACRIEN_"~"_ACRAPPN
. S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,2))
. S ACRPDFOR=$S(ACRACH="C"!(ACRACH="N"):$P(ACRDATA,U,14),1:$P(ACRDATA,U,2))
. D DHRSET(ACRNAME,ACRD0,ACRD1,ACRD2,ACRAMT,ACRPDFOR)
. Q:ACRACH="G"
. Q:ACRACH="T"
. ;Q:ACROCC="219M" ;COMMENTED OUT TO ALLOW TRAVEL MGT FEE TO GO TO ECS FILE
. Q:"^061^192^191^190^182^181^199^"'[$E(ACRTCOD,1,3)
. I ACRBTYP="T" D
. . Q:$E(ACRTCOD,1,3)="061"
. . S ACRDATA=$G(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
. . S ACRAMT=ACRAMT-$P(ACRDATA,U,12)
. D APPSET(ACRAPPN,ACRAMT)
. I ACRACH="A" D A(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
. I ACRACH="B" D B(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
. I ACRACH="C" D C(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
. I ACRACH="N" D N(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
;
S ACRCNT=0
S ACRAPPN=""
F S ACRAPPN=$O(^TMP("ACR",$J,"X",ACRAPPN)) Q:ACRAPPN']"" D
. S ACRCNT=ACRCNT+1
. S ^TMP("ACR",$J,"ECSAPPN",ACRCNT,0)=ACRAPPN_U_^TMP("ACR",$J,"X",ACRAPPN,0)
Q
APPSET(ACRAPPN,ACRAMT) ;
;----- SET APPROPRIATION NUMBER/AMOUNT ARRAY
;
S ^TMP("ACR",$J,"X",ACRAPPN,0)=$G(^TMP("ACR",$J,"X",ACRAPPN,0))+ACRAMT
Q
DHRSET(ACRNAME,ACRD0,ACRD1,ACRD2,ACRAMT,ACRPDFOR) ;
;----- SET ^TMP GLOBAL WITH DHR PAYMENT DATA
;
; 3RD PIECE = FY IEN OF 1166 APPROVALS FOR PAYMENT FILE
; 4TH PIECE = BATCH IEN
; 5TH PIECE = SEQUENCE NO IEN
; OTHER DATA PIECES ARE INCLUDED FOR TROUBLESHOOTING PURPOSES
; ALSO, VENDOR/TRAVELER NAMES ARE ALPHABETIZED
;
S ^TMP("ACR",$J,"DHR",ACRNAME,ACRD2,0)=ACRD2_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
Q
A(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
;----- SET ^TMP GLOBAL FOR ACH-GROUPED PAYMENTS
;
N ACRPDFRX,ACRPMT,ACRX
;
S ACRPDFOR=$$PDFOR(ACRPDFOR)
S ACRPDFRX=""
;
I '$D(^TMP("ACR",$J,"ECS","A",ACRNAME,0)) D
. S ^TMP("ACR",$J,"ECS","A",ACRNAME,0)="1^0"
. S ACRDATA=$G(^TMP("ACR",$J,"ECS","A",0))
. S $P(ACRDATA,U)=$P(ACRDATA,U)+1
. S ^TMP("ACR",$J,"ECS","A",0)=ACRDATA
;
S ACRPMT=$P(^TMP("ACR",$J,"ECS","A",ACRNAME,0),U)
;
S ACRPDFRX=$TR(ACRPDFRX,"\","")
I ACRPDFRX]"" S ACRPDFRX=ACRPDFRX_","
S ACRPDFRX=ACRPDFRX_ACRPDFOR
S ACRPDFRX=ACRPDFRX_"\"
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","A",ACRNAME,ACRPMT,0))
S $P(ACRDATA,U)=$P(ACRDATA,U)+1
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S $P(ACRDATA,U,3)=ACRD0
S $P(ACRDATA,U,4)=ACRD1
S $P(ACRDATA,U,5)=ACRD2
S $P(ACRDATA,U,6)=ACRPDFRX
S ^TMP("ACR",$J,"ECS","A",ACRNAME,ACRPMT,0)=ACRDATA
;
S ^TMP("ACR",$J,"ECS","A",ACRNAME,ACRPMT,$P(ACRDATA,U),0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
;
S ACRDATA=^TMP("ACR",$J,"ECS","A",ACRNAME,0)
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S ^TMP("ACR",$J,"ECS","A",ACRNAME,0)=ACRDATA
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","A",0))
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S ^TMP("ACR",$J,"ECS","A",0)=ACRDATA
Q
B(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
;----- SET ^TMP GLOBAL FOR ACH-NOT GROUPED PAYMENTS
;
N ACRDATA,ACRPMT
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","B",0))
S $P(ACRDATA,U)=$P(ACRDATA,U)+1
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S ^TMP("ACR",$J,"ECS","B",0)=ACRDATA
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","B",ACRNAME,0))
S $P(ACRDATA,U)=$P(ACRDATA,U)+1
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S ^TMP("ACR",$J,"ECS","B",ACRNAME,0)=ACRDATA
;
S ACRPMT=$P(^TMP("ACR",$J,"ECS","B",ACRNAME,0),U)
S ^TMP("ACR",$J,"ECS","B",ACRNAME,ACRPMT,0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
Q
C(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
;----- SET ^TMP GLOBAL FOR CHECKS-GROUPED PAYMENTS
;
;14 PAYMENT ID LINES
;
N ACRDATA,ACRGPMT
;
S ACRPDFOR=$$PDFOR(ACRPDFOR)
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","C",0))
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S ^TMP("ACR",$J,"ECS","C",0)=ACRDATA
;
I '$D(^TMP("ACR",$J,"ECS","C",ACRNAME,0)) D
. S ^TMP("ACR",$J,"ECS","C",ACRNAME,0)="1^0"
. S ACRDATA=^TMP("ACR",$J,"ECS","C",0)
. S $P(ACRDATA,U)=$P(ACRDATA,U)+1
. S ^TMP("ACR",$J,"ECS","C",0)=ACRDATA
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","C",ACRNAME,0))
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S ^TMP("ACR",$J,"ECS","C",ACRNAME,0)=ACRDATA
;
S ACRGPMT=$P(^TMP("ACR",$J,"ECS","C",ACRNAME,0),U)
;
;Only 14 payments in Checks-Grouped
S ACRDATA=$G(^TMP("ACR",$J,"ECS","C",ACRNAME,ACRGPMT,0))
I $P(ACRDATA,U)+1>14 D
. S ACRGPMT=ACRGPMT+1
. S $P(^TMP("ACR",$J,"ECS","C",ACRNAME,0),U)=ACRGPMT
. S ACRDATA=^TMP("ACR",$J,"ECS","C",0)
. S $P(ACRDATA,U)=$P(ACRDATA,U)+1
. S ^TMP("ACR",$J,"ECS","C",0)=ACRDATA
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","C",ACRNAME,ACRGPMT,0))
S $P(ACRDATA,U)=$P(ACRDATA,U)+1
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S $P(ACRDATA,U,3)=ACRD0
S $P(ACRDATA,U,4)=ACRD1
S $P(ACRDATA,U,5)=ACRD2
S ^TMP("ACR",$J,"ECS","C",ACRNAME,ACRGPMT,0)=ACRDATA
;
S ^TMP("ACR",$J,"ECS","C",ACRNAME,ACRGPMT,$P(ACRDATA,U),0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
Q
N(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
;----- SET ^TMP GLOBAL FOR CHECKS-NOT GROUPED PAYMENTS
;
S ACRDATA=$G(^TMP("ACR",$J,"ECS","N",0))
S $P(ACRDATA,U)=$P(ACRDATA,U)+1
S $P(ACRDATA,U,2)=$P(ACRDATA,U,2)+ACRAMT
S ^TMP("ACR",$J,"ECS","N",0)=ACRDATA
;
S ACRPMT=$P(ACRDATA,U)
S ^TMP("ACR",$J,"ECS","N",ACRNAME,ACRPMT,0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
Q
FINCHK(ACRFIN,ACROUT) ;
;----- CHECK IF PURCHASE AND FINANCE OFFICES SET UP PROPERLY
;
; RETURNS:
; ACRFIN = INTERNAL FINANCE OFFICE
; ACROUT = QUIT CONTROLLER
;
N X
S ACROUT=0
S ACRFIN=$P($G(^ACRPO(1,0)),U,8)
I 'ACRFIN D Q
. S ACROUT=1
. W !!,"The Area Purchase Office is not properly set up."
. W !,"Contact your Area ARMS Manager for assistance."
I '$D(^AUTTPRG(ACRFIN,"DT")) D Q
. S ACROUT=1
. W !!,"Information on the Area Finance Office is not properly set up."
. W !,"Contact your ARMS Manager for assistance."
. D PAUSE^ACRFWARN
Q
PARAMCK(ACRD0,ACRALC,ACRRFC,ACROUT) ;
;----- SET UP REQUIRED ALC AND RFC PARAMETERS
;
; INPUT:
; ACRD0 = THE IEN OF THE FACILITY IN THE FMS SYSTEM DEFAULTS
; FILE
;
; RETURNS:
; ACRALC = AGENCY LOCATION CODE
; ACRRFC = TREASURY REGIONAL FINANCIAL CENTER CODE
; ACROUT = QUIT CONTROLLER: 0=SUCCESSFUL, 1=UNSUCCESSFUL
;
N ACRDATA
S ACROUT=0
S ACRDATA=$G(^ACRSYS(ACRD0,402))
S ACRALC=$P(ACRDATA,U)
S ACRRFC=$P(ACRDATA,U,2)
I ACRALC=""!(ACRRFC="") D S ACROUT=1 Q
. W *7,!?5,"Agency Location Code and/or Regional Financial Center"
. W !?5,"Code missing from FMS Systems Defaults File"
. W !
. H 2
Q
BSR(ACRD0,ACRD1) ;
;----- PRINTS BATCH STATUS REPORT
; INTERFACE TO ROUTINE BS1^ACRFPAY8
;
; INPUT:
; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
;
; VARIABLES NEEDED FOR CALL TO BS1^ACRFPAY8:
; ACRBATDA = BATCH IEN
; ACRBATNO = BATCH NUMBER
; ACRFY = FISCAL YEAR
; ACRFYDA = FISCAL YEAR IEN
; ACROUT = QUIT CONTROLLER - NOT USED HERE, BUT NEWED TO
; PREVENT IT FROM INTERFERING WHEN BS1^ACRFPAY8
; CALLS PAUSE^ACRFWARN
;
N ACRBATDA,ACRBATNO,ACRFY,ACRFYDA,ACROUT
D HOME^%ZIS
S ACRFY=$P($G(^AFSLAFP(ACRD0,0)),U)
S ACRBATNO=$P($G(^AFSLAFP(ACRD0,1,ACRD1,0)),U)
S ACRFYDA=ACRD0
S ACRBATDA=ACRD1
D BS1^ACRFPAY8
Q
UPDATE(ACRD0,ACRD1,ACRECS) ;
;----- UPDATE EXPORT FIELDS: EXPORT DATE, ECS FILE
;
; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
; ACRECS = TREASURY ECS FILE NAME
;
N DA,DIE,DR,X,Y
D ^XBKVAR
S DA=ACRD1
S DA(1)=ACRD0
S DIE="^AFSLAFP("_DA(1)_",1,"
S DR="5////"_DT_";25///"_$G(ACRECS)
D ^DIE
K ^AFSLAFP("EXPORT",ACRD0,ACRD1)
Q
PDFOR(X) ;----- EXTRINSIC FUNCTION TO CONVERT PAID FOR
;
I "REF*"[$E(X,1,4) D
. S X=$P(X,"*",4)
I "RMT*^RMR*"[$E(X,1,4) D
. S X=$P(X,"*",3)
S X=$TR(X,"\","")
Q X
ACRFEXP2 ;IHS/OIRM/DSD/AEF - MAIN DRIVER ROUTINE FOR DHR & ECS EXPORT [ 09/23/2005 8:29 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**2,19**;NOV 05, 2001
+2 ;
+3 ;ACR*2.1*2.1;THIS ROUTINE IS REWRITTEN TO RESTORE THE ACH-GROUPED
+4 ;PAYMENTS
+5 ;
+6 ;This routine processes payments from the 1166 Approvals
+7 ;for Payment file and places them into the DHR Data Records
+8 ;file for subsequent transmission to CORE and into the Treasury
+9 ;ECS file for transmission to Treasury
+10 ;
+11 ; VARIABLES USED:
+12 ; ACRALC = AGENCY LOCATION CODE USED BY TREASURY
+13 ; ACRBTYP= BATCH TYPE: T=TRAVEL;V=VENDOR
+14 ; ACRECS = UNIX TREASURY ECS FILE NAME
+15 ; ACRFIN = FINANCE OFFICE IEN
+16 ; ACRRFC = TREASURY REGIONAL FINANCE CENTER CODE
+17 ; ACRACH = TREASURY SCHEDULE FORMAT:
+18 ; T = TAPE-GROUPED
+19 ; C = CHECKS GROUPED
+20 ; N = CHECKS-NOT GROUPED
+21 ; A = ACH-GROUPED (ELECTRONIC FUNDS TRANSFER)
+22 ; B = ACH-NOT GROUPED (ELECTRONIC FUNDS TRANSFER)
+23 ; G = DHR ONLY
+24 ;
+25 ;
EN(ACRD0,ACRD1) ;EP
+1 ;----- MAIN DRIVER ENTRY POINT
+2 ;
+3 ; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
+4 ; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
+5 ; ACRALC = AGENCY LOCATION CODE
+6 ; ACRFIN = FINANCE OFFICE IEN
+7 ; ACROUT = QUIT CONTROLLER
+8 ; ACRRFC = REGIONAL FINANCE CENTER
+9 ;
+10 NEW ACRALC,ACRECS,ACRFIN,ACROUT,ACRRFC
+11 ;
+12 DO FINCHK(.ACRFIN,.ACROUT)
+13 IF ACROUT
QUIT
+14 ;
+15 DO PARAMCK(1,.ACRALC,.ACRRFC,.ACROUT)
+16 IF ACROUT
QUIT
+17 ;
+18 DO GET(ACRD0,ACRD1)
+19 IF '$DATA(^TMP("ACR",$JOB))
QUIT
+20 ;
+21 DO DHR^ACRFEXP3
+22 ;
+23 DO ECS^ACRFEXP4(ACRD0,ACRD1,ACRFIN,ACRALC,ACRRFC,.ACRECS)
+24 ;
+25 DO UPDATE(ACRD0,ACRD1,$GET(ACRECS))
+26 ;
+27 DO BSR(ACRD0,ACRD1)
+28 ;
+29 KILL ^TMP("ACR",$JOB)
+30 ;
+31 QUIT
GET(ACRD0,ACRD1) ;
+1 ;----- LOOP THROUGH 1166 APPROVALS FOR PAYMENT SEQUENCES
+2 ; TO GATHER PAYMENT DATA AND PUT INTO ^TMP("ACR",$J)
+3 ; GLOBAL
+4 ;
+5 ; ACRACH = TREASURY SCHEDULE FORMAT
+6 ; ACRAMT = TRANSACTION AMOUNT
+7 ; ACRAPPN = APPROPRIATION NUMBER
+8 ; ACRBTYP = BATCH TYPE
+9 ; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
+10 ; ACRD1 = BATCH IEN IN 1166 AFP FILE
+11 ; ACRD2 = SEQ NO IEN IN 1166 AFP FILE
+12 ; ACRIEN = VENDOR/TRAVELER INTERNAL ENTRY NUMBER
+13 ; ACRNAME = VENDOR/TRAVELER NAME
+14 ; ACROCC = OBJECT CLASS CODE
+15 ; ACRPDFOR= ACH ADDENDUM/INVOICE NUMBER/TO NUMBER
+16 ; ACRREF = REFERENCE CODE
+17 ; ACRSSN = VENDOR EIN/TRAVELER SSN
+18 ; ACRTCOD = TRANSACTION TYPE
+19 ;
+20 NEW ACRD2,ACRACH,ACRAMT,ACRAPPN,ACRBTYP,ACRDATA,ACRIEN,ACRNAME,ACROCC,ACRPDFOR,ACRREF,ACRSSN,ACRTCOD
+21 KILL ^TMP("ACR",$JOB)
+22 SET ACRBTYP=$PIECE($GET(^AFSLAFP(ACRD0,1,ACRD1,0)),U,4)
+23 IF ACRBTYP=""
QUIT
+24 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,2))
+25 SET ACRACH=$PIECE(ACRDATA,U,8)
+26 IF ACRACH=""
QUIT
+27 SET ACRD2=0
+28 FOR
SET ACRD2=$ORDER(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2))
IF 'ACRD2
QUIT
Begin DoDot:1
+29 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
+30 SET ACRTCOD=$PIECE(ACRDATA,U,18)
+31 IF ACRTCOD=""
QUIT
+32 SET ACRAMT=+$PIECE(ACRDATA,U,11)
+33 IF $EXTRACT(ACRTCOD,U,4)=2
SET ACRAMT=0-ACRAMT
+34 SET ACRREF=$PIECE(ACRDATA,U,6)
+35 SET ACRREF=$TRANSLATE(ACRREF," ","")
+36 IF ACRREF=""
QUIT
+37 SET ACROCC=$PIECE(ACRDATA,U,8)
+38 IF 'ACROCC
QUIT
+39 SET ACROCC=$PIECE($GET(^AUTTOBJC(ACROCC,0)),U)
+40 IF ACROCC=""
QUIT
+41 IF ACRBTYP="V"
Begin DoDot:2
+42 SET ACRIEN=$PIECE(ACRDATA,U,10)
+43 SET ACRNAME=$PIECE($GET(^AUTTVNDR(ACRIEN,0)),U)
+44 SET ACRSSN=$PIECE($GET(^AUTTVNDR(ACRIEN,11)),U,13)
End DoDot:2
+45 IF ACRBTYP="T"
Begin DoDot:2
+46 SET ACRIEN=$PIECE(ACRDATA,U,24)
+47 ;S ACRNAME=$P($G(^VA(200,ACRIEN,0)),U) ;ACR*2.1*19.02 IM16848
+48 ;ACR*2.1*19.02 IM16848
SET ACRNAME=$$NAME2^ACRFUTL1(ACRIEN)
+49 SET ACRSSN=$PIECE($GET(^VA(200,ACRIEN,1)),U,9)
End DoDot:2
+50 IF ACRNAME=""
QUIT
+51 SET ACRAPPN=$PIECE($GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,1)),U,21)
+52 IF ACRAPPN=""
QUIT
+53 SET ACRNAME=$$UPPER^ACRFUTL(ACRNAME)
+54 SET ACRNAME=$TRANSLATE(ACRNAME,"~"," ")
+55 SET ACRNAME=ACRNAME_"~"_ACRIEN_"~"_ACRAPPN
+56 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,2))
+57 SET ACRPDFOR=$SELECT(ACRACH="C"!(ACRACH="N"):$PIECE(ACRDATA,U,14),1:$PIECE(ACRDATA,U,2))
+58 DO DHRSET(ACRNAME,ACRD0,ACRD1,ACRD2,ACRAMT,ACRPDFOR)
+59 IF ACRACH="G"
QUIT
+60 IF ACRACH="T"
QUIT
+61 ;Q:ACROCC="219M" ;COMMENTED OUT TO ALLOW TRAVEL MGT FEE TO GO TO ECS FILE
+62 IF "^061^192^191^190^182^181^199^"'[$EXTRACT(ACRTCOD,1,3)
QUIT
+63 IF ACRBTYP="T"
Begin DoDot:2
+64 IF $EXTRACT(ACRTCOD,1,3)="061"
QUIT
+65 SET ACRDATA=$GET(^AFSLAFP(ACRD0,1,ACRD1,1,ACRD2,0))
+66 SET ACRAMT=ACRAMT-$PIECE(ACRDATA,U,12)
End DoDot:2
+67 DO APPSET(ACRAPPN,ACRAMT)
+68 IF ACRACH="A"
DO A(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
+69 IF ACRACH="B"
DO B(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
+70 IF ACRACH="C"
DO C(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
+71 IF ACRACH="N"
DO N(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR)
End DoDot:1
+72 ;
+73 SET ACRCNT=0
+74 SET ACRAPPN=""
+75 FOR
SET ACRAPPN=$ORDER(^TMP("ACR",$JOB,"X",ACRAPPN))
IF ACRAPPN']""
QUIT
Begin DoDot:1
+76 SET ACRCNT=ACRCNT+1
+77 SET ^TMP("ACR",$JOB,"ECSAPPN",ACRCNT,0)=ACRAPPN_U_^TMP("ACR",$JOB,"X",ACRAPPN,0)
End DoDot:1
+78 QUIT
APPSET(ACRAPPN,ACRAMT) ;
+1 ;----- SET APPROPRIATION NUMBER/AMOUNT ARRAY
+2 ;
+3 SET ^TMP("ACR",$JOB,"X",ACRAPPN,0)=$GET(^TMP("ACR",$JOB,"X",ACRAPPN,0))+ACRAMT
+4 QUIT
DHRSET(ACRNAME,ACRD0,ACRD1,ACRD2,ACRAMT,ACRPDFOR) ;
+1 ;----- SET ^TMP GLOBAL WITH DHR PAYMENT DATA
+2 ;
+3 ; 3RD PIECE = FY IEN OF 1166 APPROVALS FOR PAYMENT FILE
+4 ; 4TH PIECE = BATCH IEN
+5 ; 5TH PIECE = SEQUENCE NO IEN
+6 ; OTHER DATA PIECES ARE INCLUDED FOR TROUBLESHOOTING PURPOSES
+7 ; ALSO, VENDOR/TRAVELER NAMES ARE ALPHABETIZED
+8 ;
+9 SET ^TMP("ACR",$JOB,"DHR",ACRNAME,ACRD2,0)=ACRD2_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
+10 QUIT
A(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
+1 ;----- SET ^TMP GLOBAL FOR ACH-GROUPED PAYMENTS
+2 ;
+3 NEW ACRPDFRX,ACRPMT,ACRX
+4 ;
+5 SET ACRPDFOR=$$PDFOR(ACRPDFOR)
+6 SET ACRPDFRX=""
+7 ;
+8 IF '$DATA(^TMP("ACR",$JOB,"ECS","A",ACRNAME,0))
Begin DoDot:1
+9 SET ^TMP("ACR",$JOB,"ECS","A",ACRNAME,0)="1^0"
+10 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","A",0))
+11 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+12 SET ^TMP("ACR",$JOB,"ECS","A",0)=ACRDATA
End DoDot:1
+13 ;
+14 SET ACRPMT=$PIECE(^TMP("ACR",$JOB,"ECS","A",ACRNAME,0),U)
+15 ;
+16 SET ACRPDFRX=$TRANSLATE(ACRPDFRX,"\","")
+17 IF ACRPDFRX]""
SET ACRPDFRX=ACRPDFRX_","
+18 SET ACRPDFRX=ACRPDFRX_ACRPDFOR
+19 SET ACRPDFRX=ACRPDFRX_"\"
+20 ;
+21 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","A",ACRNAME,ACRPMT,0))
+22 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+23 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+24 SET $PIECE(ACRDATA,U,3)=ACRD0
+25 SET $PIECE(ACRDATA,U,4)=ACRD1
+26 SET $PIECE(ACRDATA,U,5)=ACRD2
+27 SET $PIECE(ACRDATA,U,6)=ACRPDFRX
+28 SET ^TMP("ACR",$JOB,"ECS","A",ACRNAME,ACRPMT,0)=ACRDATA
+29 ;
+30 SET ^TMP("ACR",$JOB,"ECS","A",ACRNAME,ACRPMT,$PIECE(ACRDATA,U),0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
+31 ;
+32 SET ACRDATA=^TMP("ACR",$JOB,"ECS","A",ACRNAME,0)
+33 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+34 SET ^TMP("ACR",$JOB,"ECS","A",ACRNAME,0)=ACRDATA
+35 ;
+36 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","A",0))
+37 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+38 SET ^TMP("ACR",$JOB,"ECS","A",0)=ACRDATA
+39 QUIT
B(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
+1 ;----- SET ^TMP GLOBAL FOR ACH-NOT GROUPED PAYMENTS
+2 ;
+3 NEW ACRDATA,ACRPMT
+4 ;
+5 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","B",0))
+6 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+7 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+8 SET ^TMP("ACR",$JOB,"ECS","B",0)=ACRDATA
+9 ;
+10 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","B",ACRNAME,0))
+11 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+12 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+13 SET ^TMP("ACR",$JOB,"ECS","B",ACRNAME,0)=ACRDATA
+14 ;
+15 SET ACRPMT=$PIECE(^TMP("ACR",$JOB,"ECS","B",ACRNAME,0),U)
+16 SET ^TMP("ACR",$JOB,"ECS","B",ACRNAME,ACRPMT,0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
+17 QUIT
C(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
+1 ;----- SET ^TMP GLOBAL FOR CHECKS-GROUPED PAYMENTS
+2 ;
+3 ;14 PAYMENT ID LINES
+4 ;
+5 NEW ACRDATA,ACRGPMT
+6 ;
+7 SET ACRPDFOR=$$PDFOR(ACRPDFOR)
+8 ;
+9 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","C",0))
+10 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+11 SET ^TMP("ACR",$JOB,"ECS","C",0)=ACRDATA
+12 ;
+13 IF '$DATA(^TMP("ACR",$JOB,"ECS","C",ACRNAME,0))
Begin DoDot:1
+14 SET ^TMP("ACR",$JOB,"ECS","C",ACRNAME,0)="1^0"
+15 SET ACRDATA=^TMP("ACR",$JOB,"ECS","C",0)
+16 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+17 SET ^TMP("ACR",$JOB,"ECS","C",0)=ACRDATA
End DoDot:1
+18 ;
+19 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","C",ACRNAME,0))
+20 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+21 SET ^TMP("ACR",$JOB,"ECS","C",ACRNAME,0)=ACRDATA
+22 ;
+23 SET ACRGPMT=$PIECE(^TMP("ACR",$JOB,"ECS","C",ACRNAME,0),U)
+24 ;
+25 ;Only 14 payments in Checks-Grouped
+26 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","C",ACRNAME,ACRGPMT,0))
+27 IF $PIECE(ACRDATA,U)+1>14
Begin DoDot:1
+28 SET ACRGPMT=ACRGPMT+1
+29 SET $PIECE(^TMP("ACR",$JOB,"ECS","C",ACRNAME,0),U)=ACRGPMT
+30 SET ACRDATA=^TMP("ACR",$JOB,"ECS","C",0)
+31 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+32 SET ^TMP("ACR",$JOB,"ECS","C",0)=ACRDATA
End DoDot:1
+33 ;
+34 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","C",ACRNAME,ACRGPMT,0))
+35 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+36 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+37 SET $PIECE(ACRDATA,U,3)=ACRD0
+38 SET $PIECE(ACRDATA,U,4)=ACRD1
+39 SET $PIECE(ACRDATA,U,5)=ACRD2
+40 SET ^TMP("ACR",$JOB,"ECS","C",ACRNAME,ACRGPMT,0)=ACRDATA
+41 ;
+42 SET ^TMP("ACR",$JOB,"ECS","C",ACRNAME,ACRGPMT,$PIECE(ACRDATA,U),0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
+43 QUIT
N(ACRAMT,ACRD0,ACRD1,ACRD2,ACRNAME,ACRPDFOR) ;
+1 ;----- SET ^TMP GLOBAL FOR CHECKS-NOT GROUPED PAYMENTS
+2 ;
+3 SET ACRDATA=$GET(^TMP("ACR",$JOB,"ECS","N",0))
+4 SET $PIECE(ACRDATA,U)=$PIECE(ACRDATA,U)+1
+5 SET $PIECE(ACRDATA,U,2)=$PIECE(ACRDATA,U,2)+ACRAMT
+6 SET ^TMP("ACR",$JOB,"ECS","N",0)=ACRDATA
+7 ;
+8 SET ACRPMT=$PIECE(ACRDATA,U)
+9 SET ^TMP("ACR",$JOB,"ECS","N",ACRNAME,ACRPMT,0)=1_U_ACRAMT_U_ACRD0_U_ACRD1_U_ACRD2_U_ACRPDFOR
+10 QUIT
FINCHK(ACRFIN,ACROUT) ;
+1 ;----- CHECK IF PURCHASE AND FINANCE OFFICES SET UP PROPERLY
+2 ;
+3 ; RETURNS:
+4 ; ACRFIN = INTERNAL FINANCE OFFICE
+5 ; ACROUT = QUIT CONTROLLER
+6 ;
+7 NEW X
+8 SET ACROUT=0
+9 SET ACRFIN=$PIECE($GET(^ACRPO(1,0)),U,8)
+10 IF 'ACRFIN
Begin DoDot:1
+11 SET ACROUT=1
+12 WRITE !!,"The Area Purchase Office is not properly set up."
+13 WRITE !,"Contact your Area ARMS Manager for assistance."
End DoDot:1
QUIT
+14 IF '$DATA(^AUTTPRG(ACRFIN,"DT"))
Begin DoDot:1
+15 SET ACROUT=1
+16 WRITE !!,"Information on the Area Finance Office is not properly set up."
+17 WRITE !,"Contact your ARMS Manager for assistance."
+18 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+19 QUIT
PARAMCK(ACRD0,ACRALC,ACRRFC,ACROUT) ;
+1 ;----- SET UP REQUIRED ALC AND RFC PARAMETERS
+2 ;
+3 ; INPUT:
+4 ; ACRD0 = THE IEN OF THE FACILITY IN THE FMS SYSTEM DEFAULTS
+5 ; FILE
+6 ;
+7 ; RETURNS:
+8 ; ACRALC = AGENCY LOCATION CODE
+9 ; ACRRFC = TREASURY REGIONAL FINANCIAL CENTER CODE
+10 ; ACROUT = QUIT CONTROLLER: 0=SUCCESSFUL, 1=UNSUCCESSFUL
+11 ;
+12 NEW ACRDATA
+13 SET ACROUT=0
+14 SET ACRDATA=$GET(^ACRSYS(ACRD0,402))
+15 SET ACRALC=$PIECE(ACRDATA,U)
+16 SET ACRRFC=$PIECE(ACRDATA,U,2)
+17 IF ACRALC=""!(ACRRFC="")
Begin DoDot:1
+18 WRITE *7,!?5,"Agency Location Code and/or Regional Financial Center"
+19 WRITE !?5,"Code missing from FMS Systems Defaults File"
+20 WRITE !
+21 HANG 2
End DoDot:1
SET ACROUT=1
QUIT
+22 QUIT
BSR(ACRD0,ACRD1) ;
+1 ;----- PRINTS BATCH STATUS REPORT
+2 ; INTERFACE TO ROUTINE BS1^ACRFPAY8
+3 ;
+4 ; INPUT:
+5 ; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
+6 ; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
+7 ;
+8 ; VARIABLES NEEDED FOR CALL TO BS1^ACRFPAY8:
+9 ; ACRBATDA = BATCH IEN
+10 ; ACRBATNO = BATCH NUMBER
+11 ; ACRFY = FISCAL YEAR
+12 ; ACRFYDA = FISCAL YEAR IEN
+13 ; ACROUT = QUIT CONTROLLER - NOT USED HERE, BUT NEWED TO
+14 ; PREVENT IT FROM INTERFERING WHEN BS1^ACRFPAY8
+15 ; CALLS PAUSE^ACRFWARN
+16 ;
+17 NEW ACRBATDA,ACRBATNO,ACRFY,ACRFYDA,ACROUT
+18 DO HOME^%ZIS
+19 SET ACRFY=$PIECE($GET(^AFSLAFP(ACRD0,0)),U)
+20 SET ACRBATNO=$PIECE($GET(^AFSLAFP(ACRD0,1,ACRD1,0)),U)
+21 SET ACRFYDA=ACRD0
+22 SET ACRBATDA=ACRD1
+23 DO BS1^ACRFPAY8
+24 QUIT
UPDATE(ACRD0,ACRD1,ACRECS) ;
+1 ;----- UPDATE EXPORT FIELDS: EXPORT DATE, ECS FILE
+2 ;
+3 ; ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE
+4 ; ACRD1 = BATCH IEN IN 1166 APPROVALS FOR PAYMENT FILE
+5 ; ACRECS = TREASURY ECS FILE NAME
+6 ;
+7 NEW DA,DIE,DR,X,Y
+8 DO ^XBKVAR
+9 SET DA=ACRD1
+10 SET DA(1)=ACRD0
+11 SET DIE="^AFSLAFP("_DA(1)_",1,"
+12 SET DR="5////"_DT_";25///"_$GET(ACRECS)
+13 DO ^DIE
+14 KILL ^AFSLAFP("EXPORT",ACRD0,ACRD1)
+15 QUIT
PDFOR(X) ;----- EXTRINSIC FUNCTION TO CONVERT PAID FOR
+1 ;
+2 IF "REF*"[$EXTRACT(X,1,4)
Begin DoDot:1
+3 SET X=$PIECE(X,"*",4)
End DoDot:1
+4 IF "RMT*^RMR*"[$EXTRACT(X,1,4)
Begin DoDot:1
+5 SET X=$PIECE(X,"*",3)
End DoDot:1
+6 SET X=$TRANSLATE(X,"\","")
+7 QUIT X
