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

ACRFPAYR.m

Go to the documentation of this file. 
  1. ACRFPAYR ;IHS/OIRM/DSD/THL,AEF - INTEREST PENALY REPORT;  [ 07/23/2002  2:22 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3**;NOV 05, 2001
  1.  ;;
  1. IPPR ;EP;TO SET UP PRINT OF INTEREST REPORT
  1.  D IPEN
  1. IPEXIT K ACRDATE,ACRBEGIN,ACREND,ACRFYDA,ACRBATDA,ACRSEQDA,ACRFY,ACRBATNO,ACRSEQNO,ACRQUIT,ACROUT,ACRFR,ACRTO,ACRRTN,ACRT1,ACRT2,ACRJ
  1.  Q
  1. IPEN W @IOF
  1.  W !?10,"Interest Payment Report"
  1.  S DIR(0)="NO^1000:9999"
  1.  S DIR("A",1)="Report for"
  1.  S DIR("A")="FISCAL YEAR..."
  1.  S DIR("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
  1.  W !!
  1.  D DIR^ACRFDIC
  1.  I $L(Y)'=4 S ACRQUIT="" Q
  1.  S ACRFY=Y
  1.  S ACRFYDA=$O(^AFSLAFP("B",Y,0))
  1.  I 'ACRFYDA D  Q
  1.  .W !!,"FISCAL YEAR ",Y," NOT FOUND."
  1.  .D PAUSE^ACRFWARN
  1. IDATES D DATES^ACRFDATE
  1.  I '$G(ACRBEGIN) S ACRQUIT="" Q
  1.  I '$G(ACREND) W !,"Both BEGINNING and ENDING dates required." G IDATES
  1. IPAMT ;SPECIFY DOLLAR AMOUNT RANGE
  1.  S DIR(0)="NOA^1:99999999:2"
  1.  S DIR("A",1)="Interest"
  1.  S DIR("A")="Amount From...: "
  1.  S DIR("B")="1.00"
  1.  D DIR^ACRFDIC
  1.  I Y<1 S ACRQUIT="" Q
  1.  S ACRFR=Y-1
  1.  S DIR(0)="NOA^1:99999999:2"
  1.  S DIR("A")="Interest"
  1.  S DIR("A")="Amount To.....: "
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)
  1.  I Y<1 D  K ACRQUIT,ACROUT G IPAMT
  1.  S ACRTO=Y+1
  1.  S (ZTRTN,ACRRTN)="IP^ACRFPAYR"
  1.  S ZTDESC="Payment Management Interest Penalty Report"
  1.  D ^ACRFZIS
  1.  Q
  1. IP ;EP;TO PRINT INTEREST PENALTY REPORT
  1.  D IPH
  1.  D IPDATA
  1.  Q
  1. IPH ;HEADER
  1.  W @IOF
  1.  W !?10,"INTEREST PENALTY REPORT"
  1.  W !?10,"-----------------------"
  1.  W !?10,"FISCAL YEAR: ",ACRFY
  1.  W !?10,"REPORT FROM: "
  1.  S Y=ACRBEGIN
  1.  X ^DD("DD")
  1.  W Y
  1.  W !?10,"REPORT TO..: "
  1.  S Y=ACREND
  1.  X ^DD("DD")
  1.  W Y
  1.  W !?10,"REPORT DATE: "
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W Y
  1. L1 W !,"--------------------------------------------------------------------------------"
  1.  Q
  1. IPDATA ;FIND RECORDS TO INCLUDE
  1.  N ACRDATE,ACROBJDA
  1.  S ACROBJDA=$O(^AUTTOBJC("B","4319 ",0))
  1.  Q:'ACROBJDA
  1.  S (ACRT1,ACRT2,ACRJ)=0
  1.  S ACRDATE=ACRBEGIN-1
  1.  F  S ACRDATE=$O(^AFSLAFP(ACRFYDA,1,"E",ACRDATE)) Q:'ACRDATE!$D(ACRQUIT)!(ACRDATE>ACREND)  D
  1.  .S ACRBATDA=0
  1.  .F  S ACRBATDA=$O(^AFSLAFP(ACRFYDA,1,"E",ACRDATE,ACRBATDA)) Q:'ACRBATDA  D
  1.  ..D IPGET
  1.  D L1
  1.  W !,?35,"TOTAL PAYMENTS: ",$J($FN(ACRT2,"P,",2),14)
  1.  W !,?35,"TOTAL INTEREST: ",$J($FN(ACRT1,"P,",2),14)
  1.  W !,?35,"TOTAL DOCUMENTS "
  1.  W !,?35,"WITH INTEREST.: ",$J(ACRJ,13)
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. IPGET ;
  1.  S ACRSEQDA=0
  1.  F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT)  I $P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,8)=ACROBJDA,$P(^(0),U,11)>ACRFR,$P(^(0),U,11)<ACRTO D
  1.  .S ACRBATNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U)
  1.  .N W,X,Y,Z
  1.  .S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
  1.  .S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
  1.  .S Z=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
  1.  .S W=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA-1,0))
  1.  .S:$P(X,U,20)'=$P(W,U,20)!($P(W,U,8)=ACROBJDA) W=""
  1.  .D IPDISP
  1.  .S ACRJ=ACRJ+1
  1.  .I IOSL-8<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT)  D IPH
  1.  Q
  1. IPDISP ;DISPLAY EACH INTEREST PENALTY
  1.  W !!,"FY......: ",ACRFY,?22,"BATCH NO.: ",ACRBATNO
  1.  W !,"DOCUMENT: ",$P(W,U,20),?22,"REF CODE.: ",$P(W,U,5),?41,"SEQ. NO.: ",$P(W,U),?57,"GRS. PMT: ",$J($FN($P(W,U,11),"P,",2),10)
  1.  W !,"DOCUMENT: ",$P(X,U,20),?22,"REF CODE.: ",$P(X,U,6),?41,"SEQ. NO.: ",$P(X,U),?57,"INT. PMT: ",$J($FN($P(X,U,11),"P,",2),10)
  1.  W !,"VENDOR..: ",$E($P($G(^AUTTVNDR(+$P(X,U,10),0)),U),1,20)
  1.  W !,"PAID FOR: ",$P(X,U,14)
  1.  W !,"CAN.....: ",$P($G(^AUTTCAN(+$P(X,U,7),0)),U),?22,"OBJECT CD: ",$P($G(^AUTTOBJC(+$P(X,U,8),0)),U),?41,"FED CODE: ",$P(X,U,15),?57,"PIG-P/F.: ",$P(Y,U,19),?71,"WKLD: ",$P(X,U,17)
  1.  S ACRT1=ACRT1+$P(X,U,11)
  1.  S ACRT2=ACRT2+$P(W,U,11)
  1.  Q
  1. CENTER(X) ;CENTER HEADER INFO
  1.  W !?80-$L(X)/2,X
  1.  Q
  1. PORR ;EP;TO SETUP PRINT OF THE PURCHASE ORDER OR RECEIVING REPORT
  1.  N ACRXX,ACRXXX
  1.  K ACRQUIT
  1.  D WHICHP^ACRFPAY6
  1.  Q:$D(ACRQUIT)
  1.  S ACRXX=ACRY
  1.  I ACRBTYP="T" S ACRXXX=4 D ZIS Q
  1.  S DIR(0)="SO^1:Purchase Order;2:Receiving Report;3:PO and Receiving Report"
  1.  S DIR("A")="Which one"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:+Y<1
  1.  S ACRXXX=Y
  1.  I ACRXXX>1 D RRNO
  1.  D ZIS
  1.  Q
  1. ZIS ;SELECT OUTPUT DEVICE
  1.  S:'$D(ZTRTN) (ZTRTN,ACRRTN)="PORR1^ACRFPAYR"
  1.  S:'$D(ZTDESC) ZTDESC="Print payment source document"
  1.  D ^ACRFZIS
  1.  Q
  1. PORR1 ;EP;TO PRINT PO AND/OR RECEIVING REPORT
  1.  N X,ACRJ,ACRSEQDA,ACRDOCDA,ACRRRNO
  1.  F ACRJ=1:1 S X=$P(ACRXX,",",ACRJ) Q:'X  D:+$G(^TMP("ACRPAY",$J,X))
  1.  .D SETDOC
  1.  .Q:'ACRDOCDA
  1.  .I ACRXXX=4 D PO Q
  1.  .I ACRXXX=1 D PO Q
  1.  .I ACRXXX=2 D RR Q
  1.  .D PO
  1.  .D RR
  1.  Q
  1. PO D ^ACRFQ
  1.  Q
  1. RR S ACRRRNO=$G(ACRRR(X))
  1.  Q:'ACRRRNO
  1.  S ACRREFX=499
  1.  D ^ACRFQ
  1.  Q
  1. SETDOC ;
  1.  S ACRSEQDA=+^TMP("ACRPAY",$J,X)
  1.  Q:'ACRSEQDA
  1.  S ACRDOCDA=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,"ARMS")),U) ;ACR*2.1*3.2
  1.  Q:'ACRDOCDA
  1.  D SETDOC^ACRFEA1
  1.  S ACRREFDA=$P(^ACRDOC(ACRDOCDA,0),U,13)
  1.  S (ACRREF,ACRREFX)=$P($G(^AUTTDOCR(+ACRREFDA,0)),U)
  1.  Q
  1. RRNO ;SELECT RECEIVING REPORT NUMBER FOR EACH DOCUMENT
  1.  N ACRX,ACRJ,ACRSEQDA,ACRDOCDA
  1.  F ACRJ=1:1 S ACRX=$P(ACRXX,",",ACRJ) Q:'ACRX  D:+$G(^TMP("ACRPAY",$J,ACRX))
  1.  .S X=ACRX
  1.  .D SETDOC
  1.  .Q:'$G(ACRDOCDA)
  1.  .D RRNO^ACRFRRPT
  1.  .Q:'$G(ACRRRNO)
  1.  .S ACRRR(ACRX)=ACRRRNO
  1.  Q