ACRFACH ;IHS/OIRM/DSD/MRS,AEF - FORMAT ACH ADDENDUM [ 07/21/2005 12:27 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**16,17**;MAY 15, 2001
; NEW ROUTINE ACR*2.1*16.06 IM15505
;
;This routine contains formatting specifications and creates the
;RMR Treasury ACH Addendum record.
;
; INPUT:
; ACRDOCDA = IEN OF DOCUMENT (NULL=NON-ARMS)
; ACRDOC = DOCUMENT OR PO NUMBER
; ACRTERMS:
; ACRTERMS = DAYS^AMT^RATE^INVOICE#^ACRIVT^ACRBTYP^ACRACH
; ^ACRTCODE^ACRFINAL^ACRORIG^ACRPODT^ACRIVTOT^ACRPOBJ^ACRT
; WHERE:
; Piece 1 - DAYS = NUMBER OF INTEREST DAYS OR Lost OR Discount
; Piece 2 - AMT = AMOUNT OF PENALTY OR DISCOUNT
; Piece 3 - RATE = RATE PENALTY/DISCOUNT CALCULATED
; Piece 4 - INVOICE = INVOICE NUMBER
; Piece 5 - ACRIVT = PAYMENT AMOUNT
; Piece 6 - ACRBTYP = VENDOR OR TRAVEL
; Piece 7 - ACRACH = CHECKS OR ECS BATCH
; Piece 8 - ACRTCODE = TRANSACTION CODE
; Piece 9 - ACRFINAL = FINAL PAYMENT CODE
; Piece 10 - ACRORIG = ORIGINAL OBLIGATED AMOUNT - RETURNED ONLY
; Piece 11 - ACRPODT = DATE OBLIGATED - RETURNED ONLY
; Piece 12 - ACRINTOT = INVOICE AMOUNT FOR INT/DISC/LOST
; Piece 13 - ACRPOBJ = OBJECT CLASS CODE FOR PENALTY/DISCOUNT
; Piece 14 - ACRT = DISCOUNT LOST(-2)
; DISCOUNT TAKEN (>-1)
; INTEREST (-1)
;
; RETURNS - ACH ADDENDUM STRING THAT BEGINS WITH "RMR"
; OR NULL IF BATCH IS FOR CHECKS
; CAVEAT - STRING IS LIMITED TO 80 CHARACTERS
; STRING CAN ONLY HAVE ONE "REF" SEGMENT
;
; RMR Structure (See User's Manual for more)
; RMR: Remittance Advice Accounts Receivable Open Item Reference
; Segment ID is NOT counted as a piece
; 01 128 RNQ: Reference Number Qualifier (IV,VV,CT,PO,RB..)
; 02 127 RN: Reference Number (INVOICE/CONTRACT/VOUCHER.. NUMBER)
;*03 482 PAC: Payment Action Code (AI, PP, PI)
; 04 782 MA: Monetary Amount (total of current payment)
; 05 777 TI: Total Invoice or Credit/Debit (total of original obl)
; 06 780 ADT: Amount of Discount Taken
;
;FORMAT - RMR*RNQ*RN*OPTIONAL*OPTIONAL\
;RMR*RNQ*RN*PAYMENT ACTION CODE*MONETARY AMOUNT**\ (6 PIECES ALLOWED)
; In addition, the 3 piece REF segment may be used
;REF*RNQ*RN*DESCRIPTION\ (ONLY 3 PIECES ALLOWED)
;
;*THE THIRD PIECE VARIES AND CREATES THE NEED FOR MULTIPLE QUALIFIERS
; SUBSEQUENT SEQMENTS WILL ALWAYS BEGIN WITH REF
; EACH SEGMENT ALWAYS ENDS WITH \
;
;PAYMENT ACTION CODE - AI AMOUNT PAID INCLUSIVE OF DISCOUNT/ADJUSTMS
; - PP PARTIAL PAYMENT
; - PI PAY ITEM
;Examples of payments:
; - IF THERE IS AN INVOICE NUMBER IT WILL ALWAYS BE PROVIDED
; - IF NO INVOICE, PURCHASE ORDER OR DOCUMENT NUMBER WILL BE USED
; - PO NUMBER WILL BE PROVIDED, IF ROOM
; - CONTRACT NUMBER WILL ALSO BE PROVIDED, IF ROOM
;
; VENDOR(FINAL)- RMR*IV*IV NUMBER*PI*AMOUNT\REF*PO*PO#\
; VENDOR(PARTIAL)- RMR*IV*IV NUMBER*PP*AMOUNT*OBLIGATION\REF*PO*PO#\
; TRAVEL(FINAL)- RMR*VV*VOUCHER NUMBER*PI*AMOUNT\
; CONTRACT - RMR*IV*IV NUMBR*PI*AMOUNT\REF*CT*CONTRACT NUMBER*DESCRIPT\
; VENDOR WITH INTEREST PENALTY ***MUST HAVE RATE SEQMENT***
; - RMR*IV*IV#*AI*1125*1100\REF*RB*12%*25.00 intX6 d\
; VENDOR WITH DISCOUNT
; - RMR*IV*IV#*AI*1100*1125*25\REF*IV*IV#*Discount terms\
;
;
EN(ACRDOCDA,ACRDOC,ACRTERMS,ACRTCODE,ACRREF) ;EP; CALLED BY ACRFIV13 ONLY
N ACRX,ACRDOC0,ACRINV0,ACRGTA,ACRINT,ACRORIG,ACRNO
N ACRDAYS,ACRRATE,ACRINV,ACRIVT,ACRDOCT,ACRTMP,ACRILEN,ACRTA
S ACRX="" ;Default value
S ACRACH=$P(ACRTERMS,U,7) ;CHECKS OR ECS BATCH
;I "AB"'[ACRACH Q ACRX ;ONLY WANT ECS BATCHES ACR*2.1*17.01 IM17097
I "B"'[ACRACH Q ACRX ;ONLY WANT B ECS BATCHES ACR*2.1*17.01 IM17097
S ACRBTYP=$P(ACRTERMS,U,6) ;VENDOR OR TRAVEL
I ACRBTYP="" Q ACRX
D DATA
I ACRT]"",ACRT=-1 D MDATA
S ACRX="RMR*"
I ACRBTYP="V" D VENDOR(.ACRX,ACRDOC,ACRINV,ACRFINAL,ACRORIG,ACRIVT,ACRILEN)
I ACRBTYP="T" D
.D TRAVEL(.ACRX,ACRDOC,$$DOL^ACRFUTL(ACRIVT-ACRTA),ACRFINAL,ACRORIG,ACRILEN)
I ACRT=-1 D
.D INTEREST(.ACRX,ACRRATE,ACRIVT,ACRINT,ACRDAYS,ACRILEN)
I ACRT]"",ACRT>-1 D Q ACRX
.D DISCOUNT(.ACRX,ACRRATE,ACRIVT,ACRINT,ACRDOC,ACRILEN)
I ACRBTYP'="T" D
.D PO(.ACRX,ACRDOC)
.D CONTRACT(.ACRX,ACRCTN,ACRGTA)
Q ACRX
;
INTEREST(ACRX,ACRRATE,ACRIVT,ACRINT,ACRDAYS,ACRILEN) ;CHECK FOR INTEREST PENALTY
; - RMR*IV*IV#*AI*1125.00*1100.00\REF*RB*12%*25.00 intX6 d\
Q:ACRRATE=""
S $P(ACRX,"*",4)="AI"
S $P(ACRX,"*",5)=$$DOL^ACRFUTL(ACRIVT+ACRINT) ;ADD INTEREST TO INV TOT
S $P(ACRX,"*",6)=ACRIVT_"\" ;ORIGINAL INVOICE TOTAL
S ACRTMP="REF*RB*"_ACRRATE_"%*"_ACRINT_" INT@"_ACRDAYS_" DA\"
I ACRILEN>1,$L(ACRX_ACRTMP)>80 D
.F S ACRNO=$P(ACRX,"*",3) Q:$L(ACRX_ACRTMP)'>80!(ACRNO="") D
..S $P(ACRX,"*",3)=$P(ACRNO,",",1,$L(ACRNO,",")-1)
Q:$L(ACRX_ACRTMP)>80 ;CAN'T ADD, TOO LONG
S ACRX=ACRX_ACRTMP
Q
;
DISCOUNT(ACRX,ACRRATE,ACRIVT,ACRINT,ACRDOC,ACRILEN) ;LOCAL ENTRY
S $P(ACRX,"*",4)="AI"
S $P(ACRX,"*",5)=$$DOL^ACRFUTL(ACRIVT) ;DISCOUNTED AMOUNT
S $P(ACRX,"*",6)=$$DOL^ACRFUTL(ACRIVT+ACRINT) ;ORIGINAL INVOICE AMOUNT
S $P(ACRX,"*",7)=ACRINT_"\" ;DISCOUNT AMOUNT
S ACRTMP="REF*PO*"_ACRDOC
I ACRRATE]"" D
.S ACRTMP=ACRTMP_"*DIS "_+ACRDAYS_"DA@"_ACRRATE_"%" ;ONLY ADD IF %
I ACRRATE="" D
.S ACRTMP=ACRTMP_"*DIS $$" ;SHOW IF DOLLAR AMT
S ACRTMP=ACRTMP_"\"
I ACRILEN>1,$L(ACRX_ACRTMP)>80 D
.F S ACRNO=$P(ACRX,"*",3) Q:$L(ACRX_ACRTMP)'>80!(ACRNO="") D
..S $P(ACRX,"*",3)=$P(ACRNO,",",1,$L(ACRNO,",")-1)
Q:$L(ACRX_ACRTMP)>80 ;CAN'T APPEND, TOO LONG
S ACRX=ACRX_ACRTMP
D CONTRACT(.ACRX,ACRCTN,ACRGTA)
Q
;
VENDOR(ACRX,ACRDOC,ACRINV,ACRFINAL,ACRORIG,ACRIVT,ACRILEN) ; LOCAL ENTRY ONLY
;SET ACRX STRING FOR VENDOR WITH IV OR PO NUMBER
N ACRQ
S ACRQ="PO*",ACRNO=ACRDOC
I ACRINV]"" D
.;S ACRQ="IV*" I ACRDOC["TO" S ACRQ="VV*" ;VENDOR PAID AGAINST A TV
.S ACRQ="IV*" I $E(ACRDOC,5,6)="TO"!($E(ACRDOC,5,6)="T0") S ACRQ="VV*" ;VENDOR PAID AGAINST TV; ACR*2.1*17.06 IM17204
.S ACRNO=ACRINV
S ACRX=ACRX_ACRQ_ACRNO_"*PI*"_ACRIVT_"\"
;ADD ORIG OBLIG AMT IF NOT PROCESSED AS FINAL
I ACRFINAL'=1 D
.S ACRTMP=""
.S:ACRORIG]"" ACRTMP="*"_ACRORIG
.S $P(ACRX,"*",4,6)="PP*"_ACRIVT_ACRTMP_"\"
I ACRILEN>1,$L(ACRX)>80 D
.F S ACRNO=$P(ACRX,"*",3) Q:$L(ACRX)'>80!(ACRNO="") D
..S $P(ACRX,"*",3)=$P(ACRNO,",",1,$L(ACRNO,",")-1)
Q
;
TRAVEL(ACRX,ACRDOC,ACRIVT,ACRFINAL,ACRORIG,ACRILEN) ;LOCAL ENTRY ONLY
;SET STRING FOR TRAVEL VOUCHER NUMBER
S ACRX=ACRX_"VV*"_ACRDOC_"*PI*"_ACRIVT_"\"
I ACRILEN>1,$L(ACRX)>80 D
.F S ACRNO=$P(ACRX,"*",3) Q:$L(ACRX)'>80!(ACRNO="") D
..S $P(ACRX,"*",3)=$P(ACRNO,",",1,$L(ACRNO,",")-1)
Q
;
PO(ACRX,ACRDOC) ;Add purchase order number if not already used, if room
Q:ACRX["REF" ;ONLY 1 "REF" SEGMENT ALLOWED ;ACR*2.1*17.06 IM17204
Q:ACRDOC=""
Q:ACRX["PO"
Q:ACRX[ACRDOC
S ACRTMP="REF*PO*"_ACRDOC_"\"
Q:$L(ACRX_ACRTMP)>80
S ACRX=ACRX_ACRTMP
Q
;
CONTRACT(ACRX,ACRCTN,ACRGTA) ; Check for contract number and add if room
Q:ACRX["REF" ;ONLY 1 "REF" SEGMENT ALLOWED ;ACR*2.1*17.06 IM17204
Q:ACRCTN=""&(ACRGTA="")
Q:ACRX[ACRCTN!(ACRX[ACRGTA)
I ACRGTA]"" D Q
.S ACRTMP="REF*CT*"_ACRGTA_"*Government Travel Account\"
I ACRCTN]"" S ACRTMP="REF*CT*"_ACRCTN_"\"
Q:$L(ACRX_ACRTMP)>80
S ACRX=ACRX_ACRTMP
Q
;
DATA ;LOCAL ENTRY - SET VARIABLES
S ACRDOCT=+$G(ACRDOCDA) ; NULL VALUE = NON-ARMS
S ACRDOC0=$G(^ACRDOC(ACRDOCT,0))
S ACRTMP=$G(^ACRDOC(ACRDOCT,"PO"))
S ACRPODT=$P(ACRTMP,U) ; DATE OBLIGATED
S ACRCTN=$P(ACRTMP,U,2) ; CONTRACT NUMBER
S ACRSTAT=$P($G(^ACROBL(ACRDOCT,"APV")),U,6) ; PAYMENT STATUS
S ACRORIG=$P($G(^ACROBL(ACRDOCT,"DT")),U,4) ; ORIGINAL OBLIGATION
S:ACRORIG]"" ACRORIG=$$DOL^ACRFUTL(ACRORIG)
S ACRGTA="" ; GOVERNMENT TRAVEL
S ACRT=$P(ACRTERMS,U,14) ;INTEREST/DISCOUNT FLAG
I ACRREF=618 S ACRGTA=$P($G(^ACRSYS(1,"DT1")),U,14)
S ACRDAYS=$P(ACRTERMS,U) ;NUMBER OF DAYS W/FLAGS
S ACRINT=$P(ACRTERMS,U,2) ;INTEREST/DISCOUNT AMOUNT
S ACRRATE=$P(ACRTERMS,U,3) ;INTEREST/DISCOUNT RATE
S ACRINV=$P(ACRTERMS,U,4) ;INVOICE NUMBER
S ACRIVT=$P(ACRTERMS,U,5) ;INVOICE AMOUNT
S ACRIVT=$$DOL^ACRFUTL(ACRIVT)
S ACRFINAL=$P(ACRTERMS,U,9) ;PAYMENT STATUS; 1=FINAL; 2=PARTIAL
S $P(ACRTERMS,U,10)=ACRORIG ;ADD ORIG AMOUNT
S $P(ACRTERMS,U,11)=ACRPODT ;ADD DATE OBLIGATED
S ACRILEN=$L(ACRINV,",") ;COUNT OF POSSIBLE GROUPED INVOICES
I ACRBTYP="T" D
.S ACRTA=0
.S:ACRTCODE'="06119" ACRTA=$P($G(^ACROTA(ACRDOCT,0)),U,3) ;TRAVEL ADV
Q
MDATA ; - SET VARIABLES FOR INTEREST/DISCOUNT
S ACRINT=$$DOL^ACRFUTL(ACRINT)
S ACRIVT=$P(ACRTERMS,U,12) ; INVOICE TOTAL AMOUNT
S ACRIVT=$$DOL^ACRFUTL(ACRIVT)
Q
ACRFACH ;IHS/OIRM/DSD/MRS,AEF - FORMAT ACH ADDENDUM [ 07/21/2005 12:27 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16,17**;MAY 15, 2001
+2 ; NEW ROUTINE ACR*2.1*16.06 IM15505
+3 ;
+4 ;This routine contains formatting specifications and creates the
+5 ;RMR Treasury ACH Addendum record.
+6 ;
+7 ; INPUT:
+8 ; ACRDOCDA = IEN OF DOCUMENT (NULL=NON-ARMS)
+9 ; ACRDOC = DOCUMENT OR PO NUMBER
+10 ; ACRTERMS:
+11 ; ACRTERMS = DAYS^AMT^RATE^INVOICE#^ACRIVT^ACRBTYP^ACRACH
+12 ; ^ACRTCODE^ACRFINAL^ACRORIG^ACRPODT^ACRIVTOT^ACRPOBJ^ACRT
+13 ; WHERE:
+14 ; Piece 1 - DAYS = NUMBER OF INTEREST DAYS OR Lost OR Discount
+15 ; Piece 2 - AMT = AMOUNT OF PENALTY OR DISCOUNT
+16 ; Piece 3 - RATE = RATE PENALTY/DISCOUNT CALCULATED
+17 ; Piece 4 - INVOICE = INVOICE NUMBER
+18 ; Piece 5 - ACRIVT = PAYMENT AMOUNT
+19 ; Piece 6 - ACRBTYP = VENDOR OR TRAVEL
+20 ; Piece 7 - ACRACH = CHECKS OR ECS BATCH
+21 ; Piece 8 - ACRTCODE = TRANSACTION CODE
+22 ; Piece 9 - ACRFINAL = FINAL PAYMENT CODE
+23 ; Piece 10 - ACRORIG = ORIGINAL OBLIGATED AMOUNT - RETURNED ONLY
+24 ; Piece 11 - ACRPODT = DATE OBLIGATED - RETURNED ONLY
+25 ; Piece 12 - ACRINTOT = INVOICE AMOUNT FOR INT/DISC/LOST
+26 ; Piece 13 - ACRPOBJ = OBJECT CLASS CODE FOR PENALTY/DISCOUNT
+27 ; Piece 14 - ACRT = DISCOUNT LOST(-2)
+28 ; DISCOUNT TAKEN (>-1)
+29 ; INTEREST (-1)
+30 ;
+31 ; RETURNS - ACH ADDENDUM STRING THAT BEGINS WITH "RMR"
+32 ; OR NULL IF BATCH IS FOR CHECKS
+33 ; CAVEAT - STRING IS LIMITED TO 80 CHARACTERS
+34 ; STRING CAN ONLY HAVE ONE "REF" SEGMENT
+35 ;
+36 ; RMR Structure (See User's Manual for more)
+37 ; RMR: Remittance Advice Accounts Receivable Open Item Reference
+38 ; Segment ID is NOT counted as a piece
+39 ; 01 128 RNQ: Reference Number Qualifier (IV,VV,CT,PO,RB..)
+40 ; 02 127 RN: Reference Number (INVOICE/CONTRACT/VOUCHER.. NUMBER)
+41 ;*03 482 PAC: Payment Action Code (AI, PP, PI)
+42 ; 04 782 MA: Monetary Amount (total of current payment)
+43 ; 05 777 TI: Total Invoice or Credit/Debit (total of original obl)
+44 ; 06 780 ADT: Amount of Discount Taken
+45 ;
+46 ;FORMAT - RMR*RNQ*RN*OPTIONAL*OPTIONAL\
+47 ;RMR*RNQ*RN*PAYMENT ACTION CODE*MONETARY AMOUNT**\ (6 PIECES ALLOWED)
+48 ; In addition, the 3 piece REF segment may be used
+49 ;REF*RNQ*RN*DESCRIPTION\ (ONLY 3 PIECES ALLOWED)
+50 ;
+51 ;*THE THIRD PIECE VARIES AND CREATES THE NEED FOR MULTIPLE QUALIFIERS
+52 ; SUBSEQUENT SEQMENTS WILL ALWAYS BEGIN WITH REF
+53 ; EACH SEGMENT ALWAYS ENDS WITH \
+54 ;
+55 ;PAYMENT ACTION CODE - AI AMOUNT PAID INCLUSIVE OF DISCOUNT/ADJUSTMS
+56 ; - PP PARTIAL PAYMENT
+57 ; - PI PAY ITEM
+58 ;Examples of payments:
+59 ; - IF THERE IS AN INVOICE NUMBER IT WILL ALWAYS BE PROVIDED
+60 ; - IF NO INVOICE, PURCHASE ORDER OR DOCUMENT NUMBER WILL BE USED
+61 ; - PO NUMBER WILL BE PROVIDED, IF ROOM
+62 ; - CONTRACT NUMBER WILL ALSO BE PROVIDED, IF ROOM
+63 ;
+64 ; VENDOR(FINAL)- RMR*IV*IV NUMBER*PI*AMOUNT\REF*PO*PO#\
+65 ; VENDOR(PARTIAL)- RMR*IV*IV NUMBER*PP*AMOUNT*OBLIGATION\REF*PO*PO#\
+66 ; TRAVEL(FINAL)- RMR*VV*VOUCHER NUMBER*PI*AMOUNT\
+67 ; CONTRACT - RMR*IV*IV NUMBR*PI*AMOUNT\REF*CT*CONTRACT NUMBER*DESCRIPT\
+68 ; VENDOR WITH INTEREST PENALTY ***MUST HAVE RATE SEQMENT***
+69 ; - RMR*IV*IV#*AI*1125*1100\REF*RB*12%*25.00 intX6 d\
+70 ; VENDOR WITH DISCOUNT
+71 ; - RMR*IV*IV#*AI*1100*1125*25\REF*IV*IV#*Discount terms\
+72 ;
+73 ;
EN(ACRDOCDA,ACRDOC,ACRTERMS,ACRTCODE,ACRREF) ;EP; CALLED BY ACRFIV13 ONLY
+1 NEW ACRX,ACRDOC0,ACRINV0,ACRGTA,ACRINT,ACRORIG,ACRNO
+2 NEW ACRDAYS,ACRRATE,ACRINV,ACRIVT,ACRDOCT,ACRTMP,ACRILEN,ACRTA
+3 ;Default value
SET ACRX=""
+4 ;CHECKS OR ECS BATCH
SET ACRACH=$PIECE(ACRTERMS,U,7)
+5 ;I "AB"'[ACRACH Q ACRX ;ONLY WANT ECS BATCHES ACR*2.1*17.01 IM17097
+6 ;ONLY WANT B ECS BATCHES ACR*2.1*17.01 IM17097
IF "B"'[ACRACH
QUIT ACRX
+7 ;VENDOR OR TRAVEL
SET ACRBTYP=$PIECE(ACRTERMS,U,6)
+8 IF ACRBTYP=""
QUIT ACRX
+9 DO DATA
+10 IF ACRT]""
IF ACRT=-1
DO MDATA
+11 SET ACRX="RMR*"
+12 IF ACRBTYP="V"
DO VENDOR(.ACRX,ACRDOC,ACRINV,ACRFINAL,ACRORIG,ACRIVT,ACRILEN)
+13 IF ACRBTYP="T"
Begin DoDot:1
+14 DO TRAVEL(.ACRX,ACRDOC,$$DOL^ACRFUTL(ACRIVT-ACRTA),ACRFINAL,ACRORIG,ACRILEN)
End DoDot:1
+15 IF ACRT=-1
Begin DoDot:1
+16 DO INTEREST(.ACRX,ACRRATE,ACRIVT,ACRINT,ACRDAYS,ACRILEN)
End DoDot:1
+17 IF ACRT]""
IF ACRT>-1
Begin DoDot:1
+18 DO DISCOUNT(.ACRX,ACRRATE,ACRIVT,ACRINT,ACRDOC,ACRILEN)
End DoDot:1
QUIT ACRX
+19 IF ACRBTYP'="T"
Begin DoDot:1
+20 DO PO(.ACRX,ACRDOC)
+21 DO CONTRACT(.ACRX,ACRCTN,ACRGTA)
End DoDot:1
+22 QUIT ACRX
+23 ;
INTEREST(ACRX,ACRRATE,ACRIVT,ACRINT,ACRDAYS,ACRILEN) ;CHECK FOR INTEREST PENALTY
+1 ; - RMR*IV*IV#*AI*1125.00*1100.00\REF*RB*12%*25.00 intX6 d\
+2 IF ACRRATE=""
QUIT
+3 SET $PIECE(ACRX,"*",4)="AI"
+4 ;ADD INTEREST TO INV TOT
SET $PIECE(ACRX,"*",5)=$$DOL^ACRFUTL(ACRIVT+ACRINT)
+5 ;ORIGINAL INVOICE TOTAL
SET $PIECE(ACRX,"*",6)=ACRIVT_"\"
+6 SET ACRTMP="REF*RB*"_ACRRATE_"%*"_ACRINT_" INT@"_ACRDAYS_" DA\"
+7 IF ACRILEN>1
IF $LENGTH(ACRX_ACRTMP)>80
Begin DoDot:1
+8 FOR
SET ACRNO=$PIECE(ACRX,"*",3)
IF $LENGTH(ACRX_ACRTMP)'>80!(ACRNO="")
QUIT
Begin DoDot:2
+9 SET $PIECE(ACRX,"*",3)=$PIECE(ACRNO,",",1,$LENGTH(ACRNO,",")-1)
End DoDot:2
End DoDot:1
+10 ;CAN'T ADD, TOO LONG
IF $LENGTH(ACRX_ACRTMP)>80
QUIT
+11 SET ACRX=ACRX_ACRTMP
+12 QUIT
+13 ;
DISCOUNT(ACRX,ACRRATE,ACRIVT,ACRINT,ACRDOC,ACRILEN) ;LOCAL ENTRY
+1 SET $PIECE(ACRX,"*",4)="AI"
+2 ;DISCOUNTED AMOUNT
SET $PIECE(ACRX,"*",5)=$$DOL^ACRFUTL(ACRIVT)
+3 ;ORIGINAL INVOICE AMOUNT
SET $PIECE(ACRX,"*",6)=$$DOL^ACRFUTL(ACRIVT+ACRINT)
+4 ;DISCOUNT AMOUNT
SET $PIECE(ACRX,"*",7)=ACRINT_"\"
+5 SET ACRTMP="REF*PO*"_ACRDOC
+6 IF ACRRATE]""
Begin DoDot:1
+7 ;ONLY ADD IF %
SET ACRTMP=ACRTMP_"*DIS "_+ACRDAYS_"DA@"_ACRRATE_"%"
End DoDot:1
+8 IF ACRRATE=""
Begin DoDot:1
+9 ;SHOW IF DOLLAR AMT
SET ACRTMP=ACRTMP_"*DIS $$"
End DoDot:1
+10 SET ACRTMP=ACRTMP_"\"
+11 IF ACRILEN>1
IF $LENGTH(ACRX_ACRTMP)>80
Begin DoDot:1
+12 FOR
SET ACRNO=$PIECE(ACRX,"*",3)
IF $LENGTH(ACRX_ACRTMP)'>80!(ACRNO="")
QUIT
Begin DoDot:2
+13 SET $PIECE(ACRX,"*",3)=$PIECE(ACRNO,",",1,$LENGTH(ACRNO,",")-1)
End DoDot:2
End DoDot:1
+14 ;CAN'T APPEND, TOO LONG
IF $LENGTH(ACRX_ACRTMP)>80
QUIT
+15 SET ACRX=ACRX_ACRTMP
+16 DO CONTRACT(.ACRX,ACRCTN,ACRGTA)
+17 QUIT
+18 ;
VENDOR(ACRX,ACRDOC,ACRINV,ACRFINAL,ACRORIG,ACRIVT,ACRILEN) ; LOCAL ENTRY ONLY
+1 ;SET ACRX STRING FOR VENDOR WITH IV OR PO NUMBER
+2 NEW ACRQ
+3 SET ACRQ="PO*"
SET ACRNO=ACRDOC
+4 IF ACRINV]""
Begin DoDot:1
+5 ;S ACRQ="IV*" I ACRDOC["TO" S ACRQ="VV*" ;VENDOR PAID AGAINST A TV
+6 ;VENDOR PAID AGAINST TV; ACR*2.1*17.06 IM17204
SET ACRQ="IV*"
IF $EXTRACT(ACRDOC,5,6)="TO"!($EXTRACT(ACRDOC,5,6)="T0")
SET ACRQ="VV*"
+7 SET ACRNO=ACRINV
End DoDot:1
+8 SET ACRX=ACRX_ACRQ_ACRNO_"*PI*"_ACRIVT_"\"
+9 ;ADD ORIG OBLIG AMT IF NOT PROCESSED AS FINAL
+10 IF ACRFINAL'=1
Begin DoDot:1
+11 SET ACRTMP=""
+12 IF ACRORIG]""
SET ACRTMP="*"_ACRORIG
+13 SET $PIECE(ACRX,"*",4,6)="PP*"_ACRIVT_ACRTMP_"\"
End DoDot:1
+14 IF ACRILEN>1
IF $LENGTH(ACRX)>80
Begin DoDot:1
+15 FOR
SET ACRNO=$PIECE(ACRX,"*",3)
IF $LENGTH(ACRX)'>80!(ACRNO="")
QUIT
Begin DoDot:2
+16 SET $PIECE(ACRX,"*",3)=$PIECE(ACRNO,",",1,$LENGTH(ACRNO,",")-1)
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
TRAVEL(ACRX,ACRDOC,ACRIVT,ACRFINAL,ACRORIG,ACRILEN) ;LOCAL ENTRY ONLY
+1 ;SET STRING FOR TRAVEL VOUCHER NUMBER
+2 SET ACRX=ACRX_"VV*"_ACRDOC_"*PI*"_ACRIVT_"\"
+3 IF ACRILEN>1
IF $LENGTH(ACRX)>80
Begin DoDot:1
+4 FOR
SET ACRNO=$PIECE(ACRX,"*",3)
IF $LENGTH(ACRX)'>80!(ACRNO="")
QUIT
Begin DoDot:2
+5 SET $PIECE(ACRX,"*",3)=$PIECE(ACRNO,",",1,$LENGTH(ACRNO,",")-1)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
PO(ACRX,ACRDOC) ;Add purchase order number if not already used, if room
+1 ;ONLY 1 "REF" SEGMENT ALLOWED ;ACR*2.1*17.06 IM17204
IF ACRX["REF"
QUIT
+2 IF ACRDOC=""
QUIT
+3 IF ACRX["PO"
QUIT
+4 IF ACRX[ACRDOC
QUIT
+5 SET ACRTMP="REF*PO*"_ACRDOC_"\"
+6 IF $LENGTH(ACRX_ACRTMP)>80
QUIT
+7 SET ACRX=ACRX_ACRTMP
+8 QUIT
+9 ;
CONTRACT(ACRX,ACRCTN,ACRGTA) ; Check for contract number and add if room
+1 ;ONLY 1 "REF" SEGMENT ALLOWED ;ACR*2.1*17.06 IM17204
IF ACRX["REF"
QUIT
+2 IF ACRCTN=""&(ACRGTA="")
QUIT
+3 IF ACRX[ACRCTN!(ACRX[ACRGTA)
QUIT
+4 IF ACRGTA]""
Begin DoDot:1
+5 SET ACRTMP="REF*CT*"_ACRGTA_"*Government Travel Account\"
End DoDot:1
QUIT
+6 IF ACRCTN]""
SET ACRTMP="REF*CT*"_ACRCTN_"\"
+7 IF $LENGTH(ACRX_ACRTMP)>80
QUIT
+8 SET ACRX=ACRX_ACRTMP
+9 QUIT
+10 ;
DATA ;LOCAL ENTRY - SET VARIABLES
+1 ; NULL VALUE = NON-ARMS
SET ACRDOCT=+$GET(ACRDOCDA)
+2 SET ACRDOC0=$GET(^ACRDOC(ACRDOCT,0))
+3 SET ACRTMP=$GET(^ACRDOC(ACRDOCT,"PO"))
+4 ; DATE OBLIGATED
SET ACRPODT=$PIECE(ACRTMP,U)
+5 ; CONTRACT NUMBER
SET ACRCTN=$PIECE(ACRTMP,U,2)
+6 ; PAYMENT STATUS
SET ACRSTAT=$PIECE($GET(^ACROBL(ACRDOCT,"APV")),U,6)
+7 ; ORIGINAL OBLIGATION
SET ACRORIG=$PIECE($GET(^ACROBL(ACRDOCT,"DT")),U,4)
+8 IF ACRORIG]""
SET ACRORIG=$$DOL^ACRFUTL(ACRORIG)
+9 ; GOVERNMENT TRAVEL
SET ACRGTA=""
+10 ;INTEREST/DISCOUNT FLAG
SET ACRT=$PIECE(ACRTERMS,U,14)
+11 IF ACRREF=618
SET ACRGTA=$PIECE($GET(^ACRSYS(1,"DT1")),U,14)
+12 ;NUMBER OF DAYS W/FLAGS
SET ACRDAYS=$PIECE(ACRTERMS,U)
+13 ;INTEREST/DISCOUNT AMOUNT
SET ACRINT=$PIECE(ACRTERMS,U,2)
+14 ;INTEREST/DISCOUNT RATE
SET ACRRATE=$PIECE(ACRTERMS,U,3)
+15 ;INVOICE NUMBER
SET ACRINV=$PIECE(ACRTERMS,U,4)
+16 ;INVOICE AMOUNT
SET ACRIVT=$PIECE(ACRTERMS,U,5)
+17 SET ACRIVT=$$DOL^ACRFUTL(ACRIVT)
+18 ;PAYMENT STATUS; 1=FINAL; 2=PARTIAL
SET ACRFINAL=$PIECE(ACRTERMS,U,9)
+19 ;ADD ORIG AMOUNT
SET $PIECE(ACRTERMS,U,10)=ACRORIG
+20 ;ADD DATE OBLIGATED
SET $PIECE(ACRTERMS,U,11)=ACRPODT
+21 ;COUNT OF POSSIBLE GROUPED INVOICES
SET ACRILEN=$LENGTH(ACRINV,",")
+22 IF ACRBTYP="T"
Begin DoDot:1
+23 SET ACRTA=0
+24 ;TRAVEL ADV
IF ACRTCODE'="06119"
SET ACRTA=$PIECE($GET(^ACROTA(ACRDOCT,0)),U,3)
End DoDot:1
+25 QUIT
MDATA ; - SET VARIABLES FOR INTEREST/DISCOUNT
+1 SET ACRINT=$$DOL^ACRFUTL(ACRINT)
+2 ; INVOICE TOTAL AMOUNT
SET ACRIVT=$PIECE(ACRTERMS,U,12)
+3 SET ACRIVT=$$DOL^ACRFUTL(ACRIVT)
+4 QUIT
