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

ACRFPAY8.m

Go to the documentation of this file. 
  1. ACRFPAY8 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH;  [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;
  1. VENDOR ;EP;SELECT VENDOR
  1.  S DIC="^AUTTVNDR("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="VENDOR NAME OR EIN..: "
  1.  S DIC("S")="I $P($G(^(11)),U)]"""",$P($G(^(13)),U)]""""&($P($G(^(13)),U,4)]"""")!($P($G(^(14)),U)]""""&($P($G(^(14)),U,4)]""""))"
  1.  I $G(ACRACH)]"","AB"[ACRACH S DIC("S")=DIC("S")_",$P($G(^(19)),U)]"""""
  1.  S:$P($G(^AUTTVNDR(+$G(ACRVDA),0)),U) DIC("B")=$P(^(0),U)
  1.  I $G(ACRREF)=618,$G(ACRVDAT),$P($G(^AUTTVNDR(ACRVDAT,0)),U)]"" S DIC("B")=$P(^(0),U)
  1.  K ACRVDAT
  1.  D DIC^ACRFDIC
  1.  I X["^" S ACROUT="" Q
  1.  I $D(DTOUT)!($D(DUOUT)) S ACROUT="" Q
  1.  I +Y<1 W !!,"VENDOR'S NAME REQUIRED",! G VENDOR
  1.  S (ACRVDA,ACRVDAX)=+Y
  1.  S:$G(ACRREF)=618 ACRVDAT=+Y
  1.  Q
  1. LCOD ;EP;SELECT LOCATION CODE
  1.  S DIC="^AUTTLCOD("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="LOCATION CODE.......: "
  1.  D DIC^ACRFDIC
  1.  I X["^" S ACROUT="" Q
  1.  I $D(DTOUT)!($D(DUOUT)) S ACROUT="" Q
  1.  I +Y<1 W !!,"LOCATION CODE REQUIRED",! G LCOD
  1.  S $P(ACRLBDT,U,11)=+Y
  1.  Q
  1. TRAVELER ;EP;SELECT TRAVERER
  1.  S DIC="^ACRAU("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="TRAVELER............: "
  1.  D DIC^ACRFDIC
  1.  I X["^" S ACROUT="" Q
  1.  I $D(DTOUT)!($D(DUOUT)) S ACROUT="" Q
  1.  I +Y<1 W !!,"TRAVELER'S NAME REQUIRED",! G TRAVELER
  1.  S ACRDUZ=+Y
  1.  Q
  1. CCOMPLET ;EP;COMPLETE THE COMBINATION/TRANSFER OF BATCHES
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Are you ABSOLUTELY CERTAIN you want to combine"
  1.  S DIR("A")="the(se) SOURCE batches into the DESTINATION Batch."
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:+Y'=1
  1.  S ACRS=0
  1.  F  S ACRS=$O(ACR("SOURCE",ACRS)) Q:'ACRS  D
  1.  .S X=ACR("SOURCE",ACRS)
  1.  .S ACRSBAT=+X
  1.  .S ACRSFY=$P(X,U,2)
  1.  .Q:'ACRSBAT
  1.  .S ACRSS=0
  1.  .F  S ACRSS=$O(^AFSLAFP(ACRSFY,1,ACRSBAT,1,ACRSS)) Q:'ACRSS  D TRANSFER^ACRFPAY2
  1.  Q
  1. CSELECT K ACRDEST,ACRACH,ACRX
  1.  Q
  1. BSTATUS ;EP;TO PRINT BATCH STATUS
  1.  Q:$G(ACRXALL)="ALL"
  1.  F  D BS Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. BS K ACRFYDA,ACRBATDA
  1.  W @IOF
  1.  W !!,"Select Fiscal Year and Batch number for the"
  1.  W !,"Batch STATUS Report"
  1.  D FYBAT^ACRFPAY2
  1.  I '$G(ACRFYDA)!'$G(ACRBATDA) S ACRQUIT="" Q
  1.  N ACR0,ACR1,ACR2
  1.  D BS1
  1.  Q
  1. BS1 ;EP;
  1.  Q:$G(ACRXALL)="ALL"
  1.  Q:'$G(ACRFYDA)!'$D(ACRBATDA)
  1.  S ACR0=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
  1.  S ACR1=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1))
  1.  S ACR2=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
  1.  W @IOF
  1.  W !?20,"Batch STATUS Report"
  1.  W !?20,"Report Date: "
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W Y
  1.  W !!,"Fiscal Year.......: ",ACRFY
  1.  W !,"Batch Number......: ",ACRBATNO
  1.  W !,"Treasury Schedule.: ",$P(ACR2,U,6)
  1.  W:$P(ACR2,U,8)]"" !,"Schedule Format...: ",$P($P($P($G(^DD(9002325.01,22,0)),U,3),$P(ACR2,U,8)_":",2),";")
  1.  I '$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0)) W " (This batch has no payments)"
  1.  W !,"Payment Due.......: "
  1.  I $P(ACR2,U,2) D  I 1
  1.  .S Y=$P(ACR2,U,2)
  1.  .X ^DD("DD")
  1.  .W Y
  1.  W !,"Payment Open/Clsd.: "
  1.  W $S($P(ACR2,U,3)="O":"OPEN",$P(ACR2,U,3)="C":"CLOSED",1:"NOT SPECIFIED")
  1.  W !,"Payment Certified.: "
  1.  I $P(ACR0,U,5) D  I 1
  1.  .S Y=$P(ACR0,U,5)
  1.  .X ^DD("DD")
  1.  .W Y
  1.  E  W "Not yet certified"
  1.  W !,"Payment Exported..: "
  1.  I $P(ACR2,U) D  I 1
  1.  .S Y=$P(ACR2,U)
  1.  .X ^DD("DD")
  1.  .W Y
  1.  E  W "Not yet exported"
  1.  I $P(ACR2,U,11)]"" W !,"ECS FileName......: ",$P(ACR2,U,11)
  1.  K ACRAPPN
  1.  N ACRSEQDA,ACRTOT,ACRTOTC,J,K
  1.  S (ACRSEQDA,J,K,ACRTOT,ACRTOTC)=0
  1.  F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA  D
  1.  .S ACRTCODE=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,18)
  1.  .S ACRAMT=+$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,11)
  1.  . S ACRBTYP=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
  1.  . S ACRAMT=$S(ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA),1:ACRAMT)
  1.  .I ACRTCODE'=23717 D
  1.  ..S J=J+1
  1.  ..S ACRTOT=ACRTOT+ACRAMT
  1.  .I ACRTCODE=23717 D
  1.  ..S K=K+1
  1.  ..S ACRTOTC=ACRTOTC+ACRAMT
  1.  W !,"Number of Paymts..: ",J
  1.  W !,"Tot amt of Paymts.: ",$J($FN(ACRTOT,"P,",2),12)
  1.  I K D
  1.  .W !,"Number of Credits.: ",K
  1.  .W !,"Tot amt of Credits: ",$J($FN(ACRTOTC,"P,",2),12)
  1.  .W !?21,"------------"
  1.  .W !,"Actual Payment....: ",$J($FN(ACRTOT-ACRTOTC,"P,",2),12)
  1.  W !
  1.  D PAUSE^ACRFWARN:$G(ACRXALL)'="ALL"
  1.  D APPSUM
  1.  Q
  1. BANK ;UPDATE BANK ROUTINE INFORMATION
  1.  N X,Y,ACRCHK,ACRRTN,ACRDAN
  1.  S X=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U,10)
  1.  I X D  Q:$P(Y,U)=""
  1.  .S Y=$G(^AUTTVNDR(X,19))
  1.  I 'X S X=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U,24) D:X  Q:$P(Y,U)=""
  1.  .S Y=$G(^ACRAU(X,19))
  1.  Q:$P(Y,U)=""
  1.  S ACRCHK=$P(Y,U)
  1.  S ACRRTN=$P(Y,U,2)
  1.  S ACRDAN=$P(Y,U,3)
  1.  S DA(2)=ACRFYDA
  1.  S DA(1)=ACRBATDA
  1.  S DA=ACRSEQDA
  1.  S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
  1.  S DR="1901////"_ACRCHK_";1902////"_ACRRTN_";1903////"_ACRDAN
  1.  D DIE^ACRFDIC
  1.  Q
  1. SSCHUP ;EP;
  1.  Q:$E($P(^AFSLAFP(ACRFYDA,1,ACRBATDA,0),U))="G"
  1.  N ACRSEQDA,ACRJ,ACR1
  1.  S (ACRSEQDA,ACRJ)=0
  1.  F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT)  D
  1.  .Q:'$D(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))  S ACR1=$G(^(1))
  1.  .S ACRJ=ACRJ+1
  1.  .I $G(ACRBSCH)]"",$P(ACR1,U,11)'=ACRBSCH D SSCH
  1.  .D BANK:"AB"[$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,8)
  1.  Q
  1. SSCH ;UPDATE SEQUENCE ENTRY SCHEDULE NUMBER
  1.  S DA(2)=ACRFYDA
  1.  S DA(1)=ACRBATDA
  1.  S DA=ACRSEQDA
  1.  S DIE="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
  1.  S DR="40////"_ACRBSCH
  1.  D DIE^ACRFDIC
  1.  I $P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1)),U,11)="" S $P(^(1),U,11)=ACRBSCH
  1.  Q
  1. APPSUM ;EP;APPROPRIATION SUMMARY
  1.  Q:$G(ACRXALL)="ALL"
  1.  K ACRQUIT
  1.  D APPSUMH
  1.  N ACRSEQDA,Y,Z
  1.  S ACRSEQDA=0
  1.  F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA  D
  1.  .S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
  1.  .S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
  1.  .S:$P(Y,U,21)="" $P(Y,U,21)="NOT STATED"
  1.  .S Z=$P(X,U,18)
  1.  .S:'$D(ACRAPPN($P(Y,U,21))) ACRAPPN($P(Y,U,21))=""
  1.  . S ACRBTYP=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U,4)
  1.  . I Z'=23717 S ACRAPPN($P(Y,U,21))=ACRAPPN($P(Y,U,21))+$S(ACRBTYP="V":+$P(X,U,11),ACRBTYP="T":$$NET^ACRFSSU(ACRFYDA,ACRBATDA,ACRSEQDA),1:0)
  1.  .E  S ACRAPPN($P(Y,U,21))=ACRAPPN($P(Y,U,21))-$P(X,U,11)
  1.  S Z=0
  1.  S X=""
  1.  F  S X=$O(ACRAPPN(X)) Q:X=""!$D(ACRQUIT)  S Z=Z+ACRAPPN(X)
  1.  S X=""
  1.  F  S X=$O(ACRAPPN(X)) Q:X=""!$D(ACRQUIT)  D
  1.  .W !?10,X,?25,$J($FN(+ACRAPPN(X),"P,",2),15)
  1.  .I IOSL-4<$Y D  Q:$D(ACRQUIT)
  1.  ..N X,Y,Z
  1.  ..D PAUSE^ACRFWARN
  1.  ..Q:$D(ACRQUIT)
  1.  ..D APPSUMH
  1.  D AH1
  1.  W !?25,$J($FN(Z,"P,",2),15)
  1.  K ACRAPPN
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. APPSUMH ;APPROPRIATION SUMMARY HEADER
  1.  W @IOF
  1.  W !!,"Appropriation Summary "
  1.  W:$G(ACRBATNO)]"" "Batch NO. ",ACRBATNO
  1.  W:$G(ACRSCHNO)]"" " Schedule NO. ",ACRSCHNO
  1.  W !!?10,"APPROPRIATION",?25,"AMOUNT"
  1. AH1 W !?10,"-------------",?25,"---------------"
  1.  Q
  1. EXPLIST ;EP;TO PRINT LIST OF EXPORT FILES FOR SPECIFIED DATE
  1.  D EXPEXIT
  1.  F  D EXP1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. EXPEXIT K ACRQUIT,ACRDC
  1.  K ^TMP("ACREXP",$J)
  1.  Q
  1. EXP1 ;
  1.  D EXPEXIT
  1.  W @IOF
  1.  W !?17,"Enter the EXPORT DATE(S)",!
  1.  D DATES^ACRFDATE
  1.  I '$G(ACRBEGIN) S ACRQUIT="" Q
  1.  S (ACRRTN,ZTRTN)="EXP2^ACRFPAY8"
  1.  S ZTDESC="LIST OF BATCHES EXPORTED ON SPECIFIC DATE"
  1.  D ^ACRFZIS
  1.  Q
  1. EXP2 ;EP;TO PRINT LIST OF BATCHES EXPORTED ON SPECIFIC DATE
  1.  K ACRQUIT
  1.  N ACRX,ACRY,ACRZ,ACRDC,ACRXX,ACRXY,Z
  1.  S ACRDATE=ACRBEGIN-.0001
  1.  F  S ACRDATE=$O(^AFSLAFP("EXP",ACRDATE)) Q:'ACRDATE!(ACRDATE>(ACREND+.9999))  D
  1.  .S ACRFYDA=0
  1.  .F  S ACRFYDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA)) Q:'ACRFYDA  D
  1.  ..S ACRBATDA=0
  1.  ..F  S ACRBATDA=$O(^AFSLAFP("EXP",ACRDATE,ACRFYDA,ACRBATDA)) Q:'ACRBATDA  D
  1.  ...N X,Y,Z,T1,T2,N1,N2
  1.  ...S (ACRSEQDA,N1,T1,N2,T2)=0
  1.  ...F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA  D
  1.  ....S X=^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)
  1.  ....S Y=$P(X,U,18)
  1.  ....I Y'=23717 S N1=N1+1,T1=T1+$P(X,U,11)
  1.  ....I Y=23717 S N2=N2+1,T2=T2+$P(X,U,11)
  1.  ...S ACRY=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
  1.  ...S ACRZ=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
  1.  ...S ^TMP("ACREXP",$J,ACRDATE,$S($P(ACRZ,U,11)]"":$P(ACRZ,U,11),1:"NOT STATED"),ACRBATDA)=$P(ACRY,U)_U_$P(ACRZ,U,6)_U_$P(ACRZ,U,11)_U_$P(ACRZ,U,8)_U_N1_U_T1_U_N2_U_T2
  1.  I '$D(^TMP("ACREXP",$J)) D
  1.  .W !,"No EXPORTS recorded on "
  1.  .S Y=ACRBEGIN
  1.  .X ^DD("DD")
  1.  .W Y
  1.  S ACRDATE=""
  1.  F  S ACRDATE=$O(^TMP("ACREXP",$J,ACRDATE)) Q:ACRDATE=""!$D(ACROUT)  D
  1.  .D EXPH
  1.  .S ACRXX=""
  1.  .F  S ACRXX=$O(^TMP("ACREXP",$J,ACRDATE,ACRXX)) Q:ACRXX=""!$D(ACROUT)  D
  1.  ..S ACRXY=0
  1.  ..F  S ACRXY=$O(^TMP("ACREXP",$J,ACRDATE,ACRXX,ACRXY)) Q:'ACRXY!$D(^ACROUT)  D
  1.  ...S Z=^TMP("ACREXP",$J,ACRDATE,ACRXX,ACRXY)
  1.  ...W !,$P(Z,U),?8,$P(Z,U,2),?20,$P(Z,U,3),?30
  1.  ...W $S($E($P(Z,U,4))="C":"CHECKS",$E($P(Z,U,4))="A":"GROUPD",$E($P(Z,U,4))="B":"NOTGPD",$E($P(Z,U,4))="G":"DHRONL",1:"")
  1.  ...W ?38,$J($P(Z,U,5),3),?42,$J($FN($P(Z,U,6),"P,",2),15)
  1.  ...W ?59,$J($P(Z,U,7),3),?63,$J($FN($P(Z,U,8),"P,",2),15)
  1.  ...I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACROUT)  D EXPH
  1.  ...K ACRQUIT
  1.  .D PAUSE^ACRFWARN
  1.  Q
  1. EXPH ;EXPORT LIST HEADER
  1.  W @IOF
  1.  W !?10,"List of files exported on "
  1.  S Y=ACRDATE
  1.  X ^DD("DD")
  1.  W Y
  1.  W !?10,"Report Date: "
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W Y
  1.  S ACRDC=$G(ACRDC)+1
  1.  W ?55,"PAGE: ",ACRDC
  1.  W !?40,"PAYMENTS",?62,"CREDITS"
  1.  W !,"BATCH",?8,"SCHD",?20,"ECS FILE",?30,"FORMAT",?38,"NO.",?44,"AMOUNT",?59,"NO.",?66,"AMOUNT"
  1.  W !,"------",?8,"------",?20,"--------",?30,"------",?38,"---",?42,"---------------",?59,"---",?63,"---------------"
  1.  Q