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

ACRFPAY2.m

Go to the documentation of this file. 
  1. ACRFPAY2 ;IHS/OIRM/DSD/THL,AEF - CERTIFY AND EXPORT PAYMENT BATCH;  [ 09/23/2005  9:22 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16,19**;NOV 05, 2001
  1.  ;;
  1. TRANSFER ;EP;TO CREATE NEW SEQUENCE NUMBER AND TRANSFER PAYMENT TO ANOTHER BATCH
  1.  N ACRBATDA,ACRFYDA
  1.  S ACRBATDA=+ACRDEST
  1.  S ACRFYDA=$P(ACRDEST,U,2)
  1.  D NEWSEQ
  1.  Q:'$D(ACRSEQDA)
  1.  S ACRSEQNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U)
  1.  S %X="^AFSLAFP("_ACRSFY_",1,"_ACRSBAT_",1,"_ACRSS_","
  1.  S %Y="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"_ACRSEQDA_","
  1.  D %XY^%RCR
  1.  S $P(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0),U)=ACRSEQNO
  1.  S DA=ACRSEQDA
  1.  S DA(2)=ACRFYDA
  1.  S DA(1)=ACRBATDA
  1.  S DIK="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"
  1.  D IX1^ACRFDIC
  1.  S DA=ACRSS
  1.  S DA(2)=ACRSFY
  1.  S DA(1)=ACRSBAT
  1.  S DIK="^AFSLAFP("_ACRSFY_",1,"_ACRSBAT_",1,"
  1.  D DIK^ACRFDIC
  1.  Q
  1. NEWSEQ ;CREATE NEW SEQUENCE ENTRY
  1.  ;D SEQNO^ACRFIV12                             ;ACR*2.1*16.06 IM15505
  1.  D SEQNO^ACRFIV12(ACRFYDA,ACRBATDA,.ACRSEQNO)  ;ACR*2.1*16.06 IM15505
  1.  Q:'$G(ACRSEQNO)
  1.  S DA(2)=ACRFYDA
  1.  S DA(1)=ACRBATDA
  1.  S X=ACRSEQNO
  1.  S DIC="^AFSLAFP("_DA(2)_",1,"_DA(1)_",1,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")="2////"_DUZ
  1.  S:'$D(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,0)) ^(0)="^9002325.02"
  1.  D FILE^ACRFDIC
  1.  S ACRSEQDA=+Y
  1.  Q
  1. TRANS ;EP;TRANSFER A PAYMENT
  1.  S DIC="^AFSLAFP("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Fiscal Year of DESTINATION Batch.: "
  1.  S DIC("B")=$P(^AFSLAFP(ACRFYDA,0),U)
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" Q
  1.  S $P(ACRDEST,U,2)=+Y
  1. BAT S DIC="^AFSLAFP("_+Y_",1,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Batch Number of DESTINATION Batch: "
  1.  S DIC("S")="I $P($G(^(2)),U,3)=""O"""
  1.  D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" Q
  1.  S $P(ACRDEST,U)=+Y
  1.  S DIR(0)="LO^1:"_ACRMAX
  1.  S DIR("A")="TRANSFER Which PAYMENT(s)"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I '+Y S ACRQUIT="" Q
  1.  S ACRXX=ACRY
  1.  S DIR("A",1)="Are you CERTAIN you want to TRANSFER"
  1.  S DIR("A")="payment(s) "_$E(ACRY,1,$L(ACRY)-1)_" from this batch"
  1.  S DIR(0)="YO"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I +Y'=1 S ACRQUIT="" Q
  1.  S ACRSFY=ACRFYDA
  1.  S ACRSBAT=ACRBATDA
  1.  F ACRJ=1:1 S X=$P(ACRXX,",",ACRJ) Q:'X!'+$G(^TMP("ACRPAY",$J,+X))!$D(ACRQUIT)  S ACRSS=+^TMP("ACRPAY",$J,X) D TRANSFER
  1.  K ACRQUIT
  1.  Q
  1. LOCATOR ;EP;TO LOCATE A DOCUMENT
  1.  F  D L1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  Q
  1. L1 W @IOF
  1.  N ACRXREF,ACRX
  1.  W !?17,"Document LOCATOR",!
  1.  S DIR(0)="SO^1:Vendor Name/EIN;2:Traveler;3:Document Number;4:ARMS Invoice Number"
  1.  S DIR("A")="Which one"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:'Y
  1.  I Y=1 D VN S Y=1
  1.  I Y=2 D TV S Y=2
  1.  I Y=3 D DN S Y=3
  1.  I Y=4 D IN S Y=4
  1.  I $G(ACRX)]"",$G(ACRXREF)]"" D ZIS
  1.  K ACRQUIT
  1.  Q
  1. VN S DIC="^AUTTVNDR("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which Vendor: "
  1.  S DIC("S")="I $D(^AFSLAFP(""E"",+Y))"
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" Q
  1.  S ACRX=+Y
  1.  S ACRXREF="E"
  1.  S ACRXX=$P($G(^AUTTVNDR(ACRX,0)),U)
  1.  D ^ACRFDATE
  1.  Q
  1. TV S DIC="^ACRAU("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which Traveler: "
  1.  S DIC("S")="I $D(^AFSLAFP(""H"",+Y))"
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" Q
  1.  S ACRX=+Y
  1.  S ACRXREF="H"
  1.  ;S ACRXX=$P($G(^VA(200,ACRX,0)),U)  ;ACR*2.1*19.02 IM16848
  1.  S ACRXX=$$NAME2^ACRFUTL1(ACRX)  ;ACR*2.1*19.02 IM16848
  1.  D ^ACRFDATE
  1.  Q
  1. DN S DIR(0)="FO^10:10"
  1.  S DIR("A")="Document NUMBER"
  1.  S DIR("?",1)="Enter the 10 character document number"
  1.  S DIR("?")="for the document you want to locate."
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I $L(Y)'=10 S ACRQUIT="" Q
  1. DN1 S (ACRX,ACRXX)=ACRY
  1.  S ACRXREF="N"
  1.  I '$D(^AFSLAFP(ACRXREF,ACRX)) D  Q
  1.  .W !!,"No payments on file in 1166 PAYMENT PACKAGE for ",ACRXX
  1.  .D PAUSE^ACRFWARN
  1.  .K ACRQUIT,ACRX,ACRXX,ACRXREF
  1.  Q
  1. IN S DIC="^ACRINV("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Invoice Number: "
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I +Y<1 K ACRQUIT Q
  1.  S ACRY=$P(^ACRINV(+Y,0),U,7)
  1.  S ACRDOCDA=$P(^ACRINV(+Y,0),U,2)
  1.  I ACRDOCDA D
  1.  . S ACRY=$P($G(^ACRDOC(ACRDOCDA,0)),U,2)
  1.  . I ACRY="" S ACRY=$E($TR($P($G(^ACRDOC(ACRDOCDA,0)),U),"-",""),1,10)
  1.  D DN1
  1.  Q
  1. L2 ;EP;TO PRINT PAYMENT HISTORY
  1.  I '$D(^AFSLAFP(ACRXREF,ACRX)) D  Q
  1.  .W !!,"No payments on file in 1166 PAYMENT PACKAGE for ",ACRXX
  1.  .D PAUSE^ACRFWARN
  1.  .K ACRQUIT
  1.  S ACRFYDA=99999
  1.  F  S ACRFYDA=$O(^AFSLAFP(ACRXREF,ACRX,ACRFYDA),-1) Q:'ACRFYDA!$D(ACRQUIT)  D
  1.  .S ACRBATDA=99999999
  1.  .F  S ACRBATDA=$O(^AFSLAFP(ACRXREF,ACRX,ACRFYDA,ACRBATDA),-1) Q:'ACRBATDA!$D(ACRQUIT)  D
  1.  ..N X,Y,Z
  1.  ..S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0))
  1.  ..S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2))
  1.  ..I $D(ACRBEGIN),+Y,+Y<ACRBEGIN Q
  1.  ..I $D(ACREND),+Y,+Y>ACREND Q
  1.  ..I $D(ACRBEGIN),'+Y,$P(Y,U,2),$P(Y,U,2)<ACRBEGIN Q
  1.  ..I $D(ACREND),'+Y,$P(Y,U,2),$P(Y,U,2)>ACREND Q
  1.  ..D BATCH
  1.  ..S ACRSEQDA=0
  1.  ..F  S ACRSEQDA=$O(^AFSLAFP(ACRXREF,ACRX,ACRFYDA,ACRBATDA,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT)  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 Z=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
  1.  ...D SEQ
  1.  K ACRQUIT,ACROUT
  1.  Q
  1. BATCH W !!,"FISCAL YEAR....: ",$P($G(^AFSLAFP(ACRFYDA,0)),U)
  1.  W !,"BATCH NUMBER...: ",$P(X,U)
  1.  W !,"SCHEDULE NUMBER: ",$P(Y,U,6)
  1.  I $P(Y,U) S Y=$P(Y,U) X ^DD("DD") W !,"EXPORT DATE....: ",Y
  1.  E  I $P(Y,U,2) S Y=$P(Y,U,2) X ^DD("DD") W !,"EXPORT DUE.....: ",Y
  1.  Q
  1. SEQ W !!?3,"SEQUENCE NO.: ",$P(X,U)
  1.  W !?3,"DOCUMENT NO.: ",$P(X,U,20),?35,"(",$P(X,U,5),")"
  1.  W !?3,"AMOUNT......: ",$J($FN($P(X,U,11),"P",2),11),?35,"(",$P($G(^AUTTCAN(+$P(X,U,7),0)),U),?$X+3,$P($G(^AUTTOBJC(+$P(X,U,8),0)),U),")"
  1.  I $P(X,U,10) W !?3,"VENDOR......: ",$P($G(^AUTTVNDR($P(X,U,10),0)),U)
  1.  ;I $P(X,U,24) W !?3,"EMPLOYEE....: ",$P($G(^VA(200,$P(X,U,24),0)),U)  ;ACR*2.1*19.02 IM16848
  1.  I $P(X,U,24) W !?3,"EMPLOYEE....: ",$$NAME2^ACRFUTL1($P(X,U,24))  ;ACR*2.1*19.02 IM16848
  1.  W !?3,"PAID FOR....: ",$P(Z,U,14)
  1.  W !?3,"ACH ADDENDUM: ",$P(Z,U,2)
  1.  D PAUSE^ACRFWARN
  1.  I $Y+4>IOSL W @IOF
  1.  Q
  1. ZIS ;PRINT PAYMENT HISTORY
  1.  S (ZTRTN,ACRRTN)="L2^ACRFPAY2"
  1.  S ZTDESC="PRINT PAYMENT HISTORY"
  1.  D ^ACRFZIS
  1.  Q
  1. DHR(ACRFYDA,ACRBATDA,ACRSEQDA) ;EP;TO CREATE PAYMENT DHR
  1.  Q:'ACRFYDA!'ACRBATDA!'ACRSEQDA
  1.  N X                                               ;ACR*2.1*3.06
  1.  S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
  1.  Q:X=""
  1.  D DHR2(ACRFYDA,ACRBATDA,ACRSEQDA,X)               ;ACR*2.1*3.06
  1.  Q                                                 ;ACR*2.1*3.06
  1. DHR2(ACRFYDA,ACRBATDA,ACRSEQDA,X)        ;EP;              ;ACR*2.1*3.06
  1.  N Y,Z                                             ;ACR*2.1*3.06
  1.  S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
  1.  Q:Y=""
  1.  S Z=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
  1.  Q:Z=""
  1.  N ACRZ S ACRZ=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,3))
  1.  S ACR1=$P(X,U,4) ;RECORD TYPE                     ;ACR*2.1*3.07
  1.  S ACR2=DT
  1.  S ACR3=$E($P(X,U,18),1,3)
  1.  S ACR4=$E($P(X,U,18),4)
  1.  S ACR5=$E($P(X,U,18),5)
  1.  S ACR6=$P(X,U,5)
  1.  S ACR7=$P(X,U,20)
  1.  S ACR8=$P(X,U,6)                                  ;ACR*2.1*3.06
  1.  S ACR9=$P(X,U,21)                                 ;ACR*2.1*3.06
  1.  S ACR10=1
  1.  S ACR11=$P(X,U,2)
  1.  S ACR12=$P(X,U,7)
  1.  S ACR12=$P($G(^AUTTCAN(+ACR12,0)),U)
  1.  S ACR13=$P(X,U,8)
  1.  S ACR13=$P($G(^AUTTOBJC(+ACR13,0)),U)
  1.  S ACR14=$P(X,U,11)
  1.  S ACR14=$TR(ACR14,".","")
  1.  S ACR14=$E("000000000000",1,12-$L(ACR14))_ACR14
  1.  S ACR15=$P(X,U,15)
  1.  S ACR16=$P(X,U,10)
  1.  S ACR16=$P($G(^AUTTVNDR(+ACR16,11)),U,13)
  1.  S ACR16=ACR16_$E("               ",1,15-$L(ACR16))
  1.  S ACR17="               "
  1.  S ACR18=$P(Y,U,11)
  1.  S ACR19="      "
  1.  S ACR20="  "
  1.  S ACR21=" "
  1.  S ACR22="  "
  1.  S ACR23="    "
  1.  S ACR24="    "
  1.  S ACR25="      "
  1.  S ACR26=$P(ACRZ,U)
  1.  I $L(ACR26)'=4 S ACR26="    "
  1.  S ACR27=$P(ACRZ,U,2)
  1.  I $L(ACR27)'=4 S ACR27="    "
  1.  S ACR28=$P(ACRZ,U,3)
  1.  I $L(ACR28)'=2 S ACR28="  "
  1.  S ACR29=" "
  1.  S ACR30="    "
  1.  S DR=""
  1.  F J=1:1:30 S DR=DR_@("ACR"_J)
  1.  S:DR["^" DR=$TR(DR,"^","")
  1.  I $D(^ACRDHR("C",DR)) D  Q
  1.  . S ACRFMS=$O(^ACRDHR("C",DR,0))
  1.  I $G(ACRDOCDA)="",ACR7]"" D                     ;ACR*2.1*3.06
  1.  .S ACRDOCDA=$O(^ACRDOC("B",ACR7,0))             ;ACR*2.1*3.06
  1.  .S:ACRDOCDA="" ACRDOCDA=$O(^ACRDOC("C",ACR7,0)) ;ACR*2.1*16.06 IM15505
  1.  S ACRDR="99////"_DR
  1.  S DIC="^ACRDHR("
  1.  S DIC(0)="L"
  1.  S X=".02////"_DT_";.03////"_DUZ_";.04////"_$G(ACRDOCDA)_";"
  1.  F J=1:1:16,18,26,27,28 S X=X_J_"////"_@("ACR"_J)_";"
  1.  S DIC("DR")=X
  1.  S X=ACR7
  1.  D FILE^ACRFDIC
  1.  S DA=+Y
  1.  S ACRFMS=+Y
  1.  S DIE="^ACRDHR("
  1.  S DR=ACRDR
  1.  D DIE^ACRFDIC
  1.  F J=1:1:30 K @("ACR"_J)
  1.  S DA=ACRSEQDA
  1.  S DIE="^AFSLAFP("_ACRFYDA_",1,"_ACRBATDA_",1,"
  1.  S DR=".04////"_ACRFMS
  1.  D ^DIE
  1.  K ACRFMS
  1.  Q
  1. DHRPRINT ;EP;TO SELECT PAYMENT BATCH TO PRINT
  1.  K ACRFYDA,ACRBATDA,ACRSEQDA
  1.  F  D DP1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT,ACROUT,ACRFYDA,ACRBATDA,ACRSEQDA
  1.  Q
  1. DP1 ;SELECT FY
  1.  W @IOF
  1.  W !?20,"Select the Fiscal Year and Batch"
  1.  W !?20,"for Payment DHR's to be printed."
  1.  W !!
  1.  S ACRDHR=""
  1.  D FYBAT
  1.  Q:'$G(ACRFYDA)!'$G(ACRBATDA)
  1. DHRZIS ;EP;TO SELECT DEVICE
  1.  S (ZTRTN,ACRRTN)="DP2^ACRFPAY2"
  1.  S ZTDESC="PRINT PAYMENT DHR'S"
  1.  D ^ACRFZIS
  1.  Q
  1. DP2 ;EP;
  1.  K ACRQUIT,ACRDOC
  1.  N ACRSEQDA,ACRSCHNO
  1.  S ACRSCHNO=$P(^AFSLAFP(ACRFYDA,1,ACRBATDA,2),U,6)
  1.  Q:ACRSCHNO=""
  1.  S ACRSEQDA=0
  1.  F  S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA!$D(ACRQUIT)  D
  1.  .S ACRDOC=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,20)
  1.  .Q:ACRDOC=""
  1.  .Q:$D(ACRDOC(ACRDOC))
  1.  .S ACRDOC(ACRDOC)=""
  1.  .S D0=0
  1.  .F  S D0=$O(^ACRDHR("B",ACRDOC,D0)) Q:'D0  D
  1.  ..Q:$P($G(^ACRDHR(D0,1)),U,18)'=ACRSCHNO
  1.  ..D DHRP
  1.  Q
  1. DHRP ;EP;TO PRINT PAYMENT DHR'S
  1.  D ^ACRDHR
  1.  D PAUSE^ACRFWARN
  1.  W @IOF
  1.  Q
  1. DHRPYN ;EP
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Print Payment DHR's now"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I Y'=1 S ACRQUIT="" Q
  1.  D DP1
  1.  Q
  1. FYBAT ;EP;SELECT FY AND BATCH
  1.  S DIC="^AFSLAFP("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which FISCAL YEAR: "
  1.  S DIC("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
  1.  S DIC("S")="I $P(^(0),U)=X"
  1.  S Y=""
  1.  I $G(ACRFYDA) S Y=ACRFYDA K DIC
  1.  E  W ! D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" K ACRFYDA Q
  1.  S (ACRFYDA,DA(1))=+Y
  1.  S ACRFY=$P(^AFSLAFP(+Y,0),U)
  1.  S DIC="^AFSLAFP("_DA(1)_",1,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Batch or Sched #: "
  1.  I $D(ACRDIC("S"))#2 S DIC("S")=ACRDIC("S") K ACRDIC("S")
  1.  I $D(ACRDHR) K ACRDHR S DIC("S")="I +$G(^(2))"
  1.  S Y=""
  1.  I $G(ACRBATDA) S Y=ACRBATDA K DIC
  1.  E  W ! D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" K ACRBATDA Q
  1.  S ACRBATDA=+Y
  1.  S ACRBATNO=$P(^AFSLAFP(ACRFYDA,1,+Y,0),U)
  1.  S ACRSCHNO=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U,6)
  1.  I $D(ACREXP)#2,$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U)]"" D  Q
  1.  .W !!,"This Batch has already been exported."
  1.  .K ACRBATDA
  1.  .D PAUSE^ACRFWARN
  1.  Q