Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFACH

ACRFACH.m

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