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

ACRFIV43.m

Go to the documentation of this file. 
  1. ACRFIV43 ;IHS/OIRM/DSD/AEF,MRS - ARMS TO 1166 PAYMENT INTERFACE;  [ 03/18/2005  9:41 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;JUL 31, 2001
  1.  ;ACR*2.1*16.06 IM15505  ;NEW ROUTINE
  1.  ;
  1.  ;UTILITY TO EDIT PAYMENT DATA AFTER INVOICE AUDIT COMPLETED
  1.  ;          CONTINUED FROM ACRFIV41
  1.  ;
  1. CORRECT(ACRDT,ACRPCNT,ACRIVDC,ACRTERMS,ACRIVTF)   ;EP;
  1.  ;CALLED BY ACRFIV4, ACRFIV41, ACRFIV42, ACRFIV43
  1.  ;TO VALIDATE INFORMATION CORRECTNESS
  1.  K ACRDT
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Is this correct"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I +Y=1 D  Q
  1.  .S ACRDT=""
  1.  .Q
  1.  K ACRPCNT,ACRIVDC,ACRIVTF,ACRP
  1.  Q
  1. PAY(ACRIVPAY,ACRIVT,ACRTERMS,ACRT) ;EP;TO DISPLAY PAYMENT SUMMARY
  1.  ;  Called from ACRFIV4, ACRFIV42, LOCAL/DISCOUNT
  1.  ;
  1.  ;  INPUT    ;  ACRIVPAY= LOCAL ARRAY OF AMOUNT TO PAY FOR CAN,OCC
  1.  ;              ACRIVT  = TOTAL AMOUNT TO PAY
  1.  ;              ACRTERMS = ONLY SET IF INTEREST PENALTY OR DISCOUNT
  1.  ;                       P1=DAYS
  1.  ;                       P2=AMOUNT OF PENALTY OR DISCOUNT TAKEN
  1.  ;                       P3=INTEREST RATE
  1.  ;                       P4=INVOICE NUMBER, NOT SET HERE
  1.  ;                       P5=ACRIVT (AMOUNT TO PAY)
  1.  ;                       P14=ACRT
  1.  ;              ACRT >0= Discount taken w/percentage
  1.  ;              ACRT =0= Discount taken w/dollar amount
  1.  ;              ACRT =-1= Interest penalty
  1.  ;              ACRT =-2= Discount lost
  1.  ;
  1.  N ACRCANDA,ACROBJDA,ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRTXT4
  1.  I '$D(ACRON) D HOME^ACRFMENU             ;SET FORMATTING VARIABLES
  1.  D INIT
  1.  D TERMS(.ACRTERMS)
  1.  D WRT3
  1.  Q
  1. INIT ;LOCAL ENTRY TO INITIALIZE LOCAL VARIABLES
  1.  S (ACRCANDA,ACRIVT,ACRDCNT)=0
  1.  F  S ACRCANDA=$O(ACRIVPAY(ACRCANDA)) Q:'ACRCANDA  D
  1.  .S ACROBJDA=0
  1.  .F  S ACROBJDA=$O(ACRIVPAY(ACRCANDA,ACROBJDA)) Q:'ACROBJDA  D
  1.  ..S (ACRIVTF,ACRIVT)=ACRIVT+ACRIVPAY(ACRCANDA,ACROBJDA)
  1.  ..S ACRDCNT=ACRDCNT+1                        ;COUNT NUMBER OF OCC
  1.  Q
  1.  ;
  1. TERMS(ACRTERMS) ;LOCAL;TO PROCESS DISCOUNT LOST, INTEREST PENALTY AND DISCOUNT TAKEN
  1.  ;  ALLOWS FOR BOTH DISCOUNT LOST AND INTEREST PENALTY
  1.  S ACRT=$P($G(ACRTERMS),U,14)
  1.  I ACRT="" S ACRPCNT=0 Q
  1.  ;
  1.  I ACRT=-2 D  Q
  1.  .S ACRTXT=$$LOST(.ACRTERMS,.ACRIVTF,.ACRIVT)
  1.  .D WRT2
  1.  ;
  1.  I ACRT=-1 D  Q
  1.  .S ACRTXT=$$WRT(.ACRT,.ACRPCNT,.ACRTERMS,.ACRIVTF,ACRIVT,.ACRIVDC,.ACRP)
  1.  .D WRT2
  1.  ;Now process Discounts
  1.  S ACRTXT=$$WRT(.ACRT,.ACRPCNT,.ACRTERMS,.ACRIVTF,ACRIVT,.ACRIVDC,.ACRP)
  1.  D WRT2
  1.  Q
  1.  ;
  1. WRT2 ;LOCAL ENTRY
  1.  S ACRTXT1=$P(ACRTXT,U),ACRTXT2=$P(ACRTXT,U,2),ACRTXT3=$P(ACRTXT,U,3)
  1.  W !!?10
  1.  W @ACRON
  1.  W "*****    NOTE    *****"
  1.  W @ACROF
  1.  W !!
  1.  W:$D(ACRTXT4) ?3,ACRTXT4
  1.  W !!?10,ACRTXT1
  1.  W @ACRON
  1.  W ACRTXT2
  1.  W @ACROF
  1.  W ACRTXT3
  1.  Q
  1. WRT3 ;LOCAL ENTRY
  1.  W !?10,"Amount of payment due...: "
  1.  W @ACRON
  1.  W $J($FN(ACRIVT,"P,",2),14)
  1.  W @ACROF
  1.  I $G(ACRP)>0 D
  1.  .W !?10,"The interest to be paid.:"
  1.  .W @ACRON
  1.  .W $J($FN(ACRP,"P,",2),15)
  1.  .W @ACROF
  1.  I $G(ACRIVDC)>0 D
  1.  .W !?10,"The discount to be taken: "
  1.  .W @ACRON
  1.  .W $J($FN(ACRIVDC,"P,",2),14)
  1.  .W @ACROF
  1.  W !?10,"Payment to be made......: "
  1.  W @ACRON
  1.  W $J($FN(ACRIVTF,"P,",2),14)
  1.  W @ACROF
  1.  Q
  1.  ;
  1. WRT(ACRT,ACRRATE,ACRTERMS,ACRIVTF,ACRIVT,ACRIVDC,ACRP)   ;LOCAL ENTRY
  1.  ;EXTRINSIC FUNCTION TO WRITE PAYMENT TERMS
  1.  ; Variables changed when returned:  
  1.  ;   ACRTERMS
  1.  ; ACRIVDC = Discount Amount
  1.  ; ACRIVTF = Invoice amount
  1.  ; ACRT = Type Discount/Interest
  1.  ; ACRP = Interest $ amount
  1.  ;
  1.  N ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRAMT,A
  1.  S A="A "
  1.  S ACRDAYS=$P(ACRTERMS,U)
  1.  S ACRAMT=$P(ACRTERMS,U,2)
  1.  S ACRRATE=$P(ACRTERMS,U,3)
  1.  ;
  1. DISPC ; LOCAL ENTRY                       ;Discount taken w/percentage
  1.  I ACRT>0 D  Q ACRTXT
  1.  .S ACRTXT1=ACRRATE_"% discount for payment within "
  1.  .S ACRTXT2=+ACRDAYS
  1.  .S ACRTXT3=" days will be applied."
  1.  .;S ACRTXT4="A reversal obligation for the Discount will be sent to CORE"
  1.  .S ACRTXT=A_ACRTXT1_U_ACRTXT2_U_ACRTXT3
  1.  .S ACRAMT=$$DOL^ACRFUTL(.ACRAMT)              ; Formatting
  1.  .S $P(ACRTERMS,U,12)=ACRIVTF                  ; Invoice amount
  1.  .S ACRIVTF=ACRIVT-ACRAMT
  1.  .S ACRIVDC=ACRAMT
  1.  .S $P(ACRTERMS,U,5)=ACRIVTF                   ; Payment amount
  1.  .Q
  1. DISAMT ;LOCAL ENTRY                             ;Discount taken w/$dollar amt
  1.  I ACRT=0 D  Q ACRTXT
  1.  .S ACRTXT1=" discount for early payment will be applied."
  1.  .S ACRTXT2=$FN(ACRAMT,"P",2)
  1.  .;S ACRTXT4="A reversal obligation for the Discount will be sent to CORE"
  1.  .S ACRTXT=A_U_ACRTXT2_U_ACRTXT1
  1.  .S $P(ACRTERMS,U,12)=ACRIVTF                   ; Invoice amount
  1.  .S ACRIVTF=ACRIVT-ACRAMT
  1.  .S ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
  1.  .S ACRIVDC=ACRAMT
  1.  .S $P(ACRTERMS,U,5)=ACRIVTF                    ; Payment amount
  1.  .Q
  1. INT ;LOCAL ENTRY                                   ; Interest penalty
  1.  I ACRT=-1 D  Q ACRTXT
  1.  .S ACRTXT1="penalty for a late payment of "
  1.  .S ACRTXT3=" days will be applied."
  1.  .S ACRTXT=A_ACRTXT1_U_ACRDAYS_U_ACRTXT3
  1.  .S ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
  1.  .S $P(ACRTERMS,U,12)=ACRIVTF                ; Invoice amount
  1.  .S ACRIVTF=ACRIVT+ACRAMT
  1.  .S (ACRP,$P(ACRTERMS,U,2))=ACRAMT
  1.  .S $P(ACRTERMS,U,5)=ACRIVT                  ; payment amount
  1.  .Q
  1.  ;
  1. DISLOST ;LOST DISCOUNT
  1.  I ACRT=-2 D  Q ACRTXT
  1.  .S ACRTXT="Discount Lost will be recorded "
  1.  S ACRTXT="Error"                                   ;Housekeeping
  1.  Q ACRTXT
  1.  ;
  1. LOST(ACRTERMS,ACRIVTF,ACRIVT) ;LOCAL ENTRY                   ;Discount lost 
  1.  N ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRAMT
  1.  S ACRAMT=$P(ACRTERMS,U,2)
  1.  S ACRRATE=$P(ACRTERMS,U,3)
  1.  I ACRAMT]"" S ACRTXT1="The discount LOST........: "
  1.  I ACRRATE]"" D
  1.  .S ACRTXT1="The discount LOST ("
  1.  .S ACRTXT1=ACRTXT1_$E("00",1,2-$L(ACRRATE))_ACRRATE_" %): "
  1.  .S ACRAMT=(ACRIVT*ACRRATE*.01)
  1.  .S ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
  1.  .S $P(ACRTERMS,U,2)=ACRAMT                  ; Discount Lost amount
  1.  S $P(ACRTERMS,U,5)=ACRIVT                   ; payment amount
  1.  S $P(ACRTERMS,U,12)=ACRIVTF                 ; Invoice amount
  1.  S ACRTXT2=$J($FN(ACRAMT,"P,",2),14)
  1.  S ACRTXT=ACRTXT1_U_ACRTXT2
  1.  Q ACRTXT
  1. PAYD(ACRIVPAY,ACRIVT,ACRTERMS,ACRT) ;EP;TO DISPLAY PAYMENT SUMMARY
  1.  ;  Called from ACRFIV4, ACRFIV42, LOCAL/DISCOUNT
  1.  ;
  1.  ;  INPUT    ;  ACRIVPAY= LOCAL ARRAY OF AMOUNT TO PAY FOR CAN,OCC
  1.  ;              ACRIVT  = TOTAL AMOUNT TO PAY
  1.  ;              ACRTERMS = ONLY SET IF INTEREST PENALTY OR DISCOUNT
  1.  ;                       P1=DAYS
  1.  ;                       P2=AMOUNT OF PENALTY OR DISCOUNT TAKEN
  1.  ;                       P3=INTEREST RATE
  1.  ;                       P4=INVOICE NUMBER, NOT SET HERE
  1.  ;                       P5=ACRIVT (AMOUNT TO PAY)
  1.  ;                       P14=ACRT
  1.  ;              ACRT >0= Discount taken w/percentage
  1.  ;              ACRT =0= Discount taken w/dollar amount
  1.  ;              ACRT =-1= Interest penalty
  1.  ;              ACRT =-2= Discount lost
  1.  ;
  1.  N ACRCANDA,ACROBJDA,ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRDCNT,ACRTDIS
  1.  S ACRDCNT=$$OBJCNT(.ACRIVPAY)
  1.  D INITD
  1.  D TERMS(.ACRTERMS)
  1.  D WRT3
  1.  Q
  1. INITD ;LOCAL ENTRY TO INITIALIZE LOCAL VARIABLES
  1.  S (ACRCANDA,ACRIVT)=0
  1.  F  S ACRCANDA=$O(ACRIVPAY(ACRCANDA)) Q:'ACRCANDA  D
  1.  .S ACROBJDA=0
  1.  .F  S ACROBJDA=$O(ACRIVPAY(ACRCANDA,ACROBJDA)) Q:'ACROBJDA  D
  1.  ..S (ACRIVTF,ACRIVT)=ACRIVT+ACRIVPAY(ACRCANDA,ACROBJDA)
  1.  Q
  1. OBJCNT(ACRIVPAY) ;EP; EXTRINSIC FUNCTION TO RETURN NUMBER OF OCC'S
  1.  N ACRX,ACRY,ACRJ
  1.  S (ACRX,ACRJ)=0
  1.  F  S ACRX=$O(ACRIVPAY(ACRX)) Q:'ACRX  D
  1.  .S ACRY=0
  1.  .F  S ACRY=$O(ACRIVPAY(ACRX,ACRY)) Q:'ACRY  S ACRJ=ACRJ+1
  1.  Q ACRJ