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

ACRFIV13.m

Go to the documentation of this file.
  1. ACRFIV13 ;IHS/OIRM/DSD/THL,AEF - CREATE PAYMENT RECORDS IN 1166 PACKAGE; [ 05/27/2005 3:18 PM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16,17**;JUL 31, 2001
  1. ;ACR*2.1*16.06 IM15505 ;NEW ROUTINE
  1. ;
  1. ;CREATE NEW 1166 BATCHES AND SEQUENCE NO. ENTRIES, CONTINUED FROM IV11
  1. ;
  1. EN(ACRA,ACRB,ACRC,ACRD,ACRE) ;EP; CALLED BY ACRFIV11
  1. ;----- SET VARIABLES FOR PAYMENT
  1. ;NOTE: VARIABLES ARE RESET BECAUSE TRAVEL ENTRY DOES NOT BRING IN THEM IN
  1. ;
  1. N ACRTMP,ACRTMP2,ACRADDN,ACRTADD
  1. S ACRDOC=$G(ACRDOC)
  1. S ACRDOC2=$G(ACRDOC2)
  1. S ACRDOCDA=$G(ACRDOCDA)
  1. S ACRTADD=""
  1. S ACRLBDA=$G(ACRLBDA)
  1. S ACRLBDT=$G(ACRLBDT)
  1. S ACRFYFUN=$G(ACRFYFUN)
  1. S ACRINV=$G(ACRINV)
  1. S ACRIVDC=$G(ACRIVDC)
  1. S ACRIVTF=$G(ACRIVTF)
  1. S ACRTERMS=$G(ACRTERMS)
  1. S ACRTCODE=$G(ACRTCODE)
  1. S ACRFINAL=$G(ACRFINAL)
  1. S ACRREF2=$G(ACRREF2)
  1. S ACRP=$G(ACRP)
  1. I '$D(ACRREF) S ACRREF=ACRREF1
  1. ;I $P(ACRTERMS,U,14)>-1 S ACRTADD=ACRTERMS ;CAPTURE DISCOUNT INFO ;ACR*2.1*17.01 IM17097
  1. I $P(ACRTERMS,U,14)]"",$P(ACRTERMS,U,14)>-1 S ACRTADD=ACRTERMS ;CAPTURE DISCOUNT INFO ACR*2.1*17.01 IM17097
  1. D TERMS(.ACRTADD,.ACRIVTF,.ACRINV) ;SET STRING FOR ACH ADDENDUM CALL
  1. D GET
  1. S ACRADDN=$$EN^ACRFACH($G(ACRDOCDA),ACRDOC,.ACRTADD,ACRTCODE,ACRREF)
  1. D SET
  1. Q
  1. GET ;----- GATHER ALL DATA FOR THE PAYMENT ENTRY
  1. ;
  1. I ACRDOCDA]"" D
  1. .S:ACRLBDA="" ACRLBDA=$P(^ACRDOC(ACRDOCDA,0),U,6)
  1. .S:ACRLBDT="" ACRLBDT=$G(^ACRLOCB(ACRLBDA,"DT")) ;FMS DEPT
  1. .S:ACRFYFUN="" ACRFYFUN=$$FYFUN^ACRFUTL1(ACRLBDA) ;FY OF FUNDS
  1. S ACRFY=$S($L(+ACRLBDT)=4:$E(+ACRLBDT,3,4),1:+ACRLBDT) ;CURRENT FY
  1. S ACRDFYDA=$O(^AFSLODOC("B",ACRFYFUN,0))
  1. I "^130^600^602^"'[(U_ACRREF_U)!(ACRBTYP="V"&$G(ACRVDA)) D
  1. .D VENDOR^ACRFIV12
  1. ;I ACRBTYP="T","^130^600^602^618^"[(U_ACRREF_U) D ;ACR*2.1*3.33
  1. I ACRBTYP="T","^130^148^600^602^618^"[(U_ACRREF_U) D ;ACR*2.1*3.33
  1. .D TRAVELER^ACRFIV12
  1. S:ACRDOC["-" ACRDOC=$$DOC^ACRFUTL(ACRDOC)
  1. S:ACRDOC2="" ACRDOC2=ACRDOC
  1. S:ACRDOC2["-" ACRDOC2=$$DOC^ACRFUTL(ACRDOC2)
  1. S:ACRREF=618 ACRGTA=$P($G(^ACRSYS(1,"DT1")),U,14)
  1. I "^21^22^23^"[(U_$E($P($G(^AUTTOBJC(+$G(ACROBJDA),0)),U),1,2)_U) D
  1. .I $E(ACRTCODE,1,3)=181!($E(ACRTCODE,1,3)=191) D
  1. ..S $E(ACRTCODE,3)=2
  1. .Q
  1. I "^21^22^23^"'[(U_$E($P($G(^AUTTOBJC(+$G(ACROBJDA),0)),U),1,2)_U) D
  1. .I $E(ACRTCODE,1,3)=182!($E(ACRTCODE,1,3)=192) D
  1. ..S $E(ACRTCODE,3)=1
  1. .Q
  1. I $P($G(^ACRSYS(1,"DT1")),U,5)=1 D
  1. .I $E(ACRTCODE,1,3)=181!($E(ACRTCODE,1,3)=191) D
  1. ..S $E(ACRTCODE,3)=2
  1. .Q
  1. S $P(ACRTADD,U,6,9)=ACRBTYP_U_ACRACH_U_ACRTCODE_U_ACRFINAL
  1. I $P(ACRTERMS,U,14)]"" D
  1. .S $P(ACRTERMS,U,4)=ACRINV ;CAPTURE INVOICE
  1. .S $P(ACRTERMS,U,6,7)=ACRBTYP_U_ACRACH
  1. .S $P(ACRTERMS,U,9)=ACRFINAL
  1. Q
  1. ;
  1. TERMS(ACRTADD,ACRIVTF,ACRINV) ;
  1. ;----- SET ACRTADD FOR ACH ADDENDUM, ALLOW ENTRY FROM EDIT BATCH
  1. ;
  1. ;I $P(ACRTERMS,U,14)>-1 D ;ACR*2.1*17.01 IM17097
  1. I $P(ACRTERMS,U,14)]"",$P(ACRTERMS,U,14)>-1 D ;ACR*2.1*17.01 IM17097
  1. .S ACRTADD=ACRTERMS ;CAPTURE DISCOUNT INFO
  1. .S $P(ACRTADD,U,2)=ACRIVDC
  1. .S $P(ACRTADD,U,8)=ACRTCODE
  1. S $P(ACRTADD,U,5)=ACRIVTF ; INVOICE/PAY AMOUNT
  1. I ACRINV="" D
  1. .S ACRTMP=$O(^TMP("ACRINV",$J,""))
  1. .Q:ACRTMP=""
  1. .S ACRINV=$P(^TMP("ACRINV",$J,ACRTMP),U,2) ;INVOICE NUMBER
  1. Q:ACRINV=""
  1. S:$P(ACRTADD,U,4)="" $P(ACRTADD,U,4)=ACRINV ; CAPTURE INVOICE
  1. Q
  1. ;
  1. SET ;----- SETS VARIABLES INTO ACRA,ACRB,ACRC,ACRD,ACRE
  1. ; RETURNED FOR SET INTO AFSLAFP
  1. ;
  1. ; SEQUENCE NO
  1. S $P(ACRA,U,1)=ACRSEQNO
  1. ;
  1. ; SEQ FY OF FUNDS (FY OF FUNDS)
  1. S $P(ACRA,U,2)=$E(ACRFYFUN,4)
  1. ;
  1. ; [2]DATA ENTRY USER ID
  1. S $P(ACRA,U,3)=DUZ
  1. ;
  1. ; [10]RECORD TYPE; ALWAYS NUMBER 2
  1. S $P(ACRA,U,4)=2
  1. ;
  1. ; [11]REFERENCE CODE
  1. ;S $P(ACRA,U,5)=$S(ACRREF=600:130,ACRREF=602:" ",1:ACRREF) ;ACR*2.1*3.05
  1. S $P(ACRA,U,5)=$S(ACRREF=600:130,ACRREF=602:130,1:ACRREF) ;ACR*2.1*3.05
  1. ;
  1. ; [12]OTHER DOCUMENT REF
  1. S ACRTMP=$S(ACRREF2]"":ACRREF2,ACRREF'=600:617,1:600)
  1. S:ACRREF=602 ACRTMP=602
  1. S $P(ACRA,U,6)=ACRTMP
  1. ;
  1. ; [13]CAN
  1. S $P(ACRA,U,7)=ACRCANDA
  1. ;
  1. ; [14]SUB-OBJECT CLASS
  1. S $P(ACRA,U,8)=ACROBJDA
  1. ;
  1. ; [15]DOC-TYP
  1. S $P(ACRA,U,9)=$E($G(ACR15),1,2)
  1. ;
  1. ; [16]VENDOR-EIN
  1. S $P(ACRA,U,10)=$G(ACR16)
  1. ;
  1. ; [17]DOLLAR AMOUNT
  1. S ACR17=$$17(ACRIVTF)
  1. S $P(ACRA,U,11)=ACR17
  1. ;
  1. ; [18]DIS-AMT;ACRFIV12
  1. S ACRTMP=""
  1. I '$G(ACR18),$E(ACRTCODE,1,3)="061" S ACR18=+$G(ACRIVTF) ;TA
  1. S:+$G(ACR18) ACRTMP=$$17(ACR18)
  1. S:$G(ACRIVDC)]"" ACRTMP=ACRIVDC
  1. S $P(ACRA,U,12)=ACRTMP
  1. ;
  1. ; [19]AFP-PAY-DATE
  1. S $P(ACRA,U,13)=$G(ACR19)
  1. ;
  1. ; [21]FED-CD(FED/NON FED SOURCE)
  1. S $P(ACRA,U,15)=$S(ACRREF'=210:1,1:2)
  1. ;
  1. ; [22]PAY-CD;SET ELSEWHERE
  1. S $P(ACRA,U,16)=ACRFINAL
  1. ;
  1. ; [23]PIG-WK;SET ELSEWHERE
  1. S $P(ACRA,U,17)=$G(ACR23)
  1. ;
  1. ; [24]TRN-CD
  1. S $P(ACRA,U,18)=ACRTCODE
  1. ;
  1. ; [25]OTH-TRN-CD;SET ELSEWHERE
  1. S $P(ACRA,U,19)=$G(ACR25)
  1. ;
  1. ; [11.5]DOCUMENT NO
  1. S ACRTMP=$E(ACRDOC,1,10)
  1. S ACRTMP=$E("0000000000",1,10-$L(ACRTMP))_ACRTMP
  1. S $P(ACRA,U,20)=ACRTMP
  1. ;
  1. ; [12.5]OTHER DOCUMENT NO
  1. S ACRTMP2=$E(ACRDOC2,1,10)
  1. S ACR125=$E("0000000000",1,10-$L(ACRTMP2))_ACRTMP2
  1. S $P(ACRA,U,21)=$S(ACRTMP2]"":ACRTMP2,1:ACRTMP)
  1. ;
  1. ; [3]PAYMENT TYPE;ACRFIV12
  1. S $P(ACRA,U,22)=$G(ACR3)
  1. ;
  1. ; [26]PROVIDER-EIN/SSN;SET ?
  1. S $P(ACRA,U,23)=$G(ACR26)
  1. ;
  1. ; [27]EMPLOYEE-SSN;ACRFIV12
  1. S $P(ACRA,U,24)=$G(ACR27)
  1. ;
  1. ; [28]PAY ATTENTION;ACRFIV12
  1. S $P(ACRA,U,25)=$G(ACR28)
  1. ;
  1. ; [50]EXPORTED Y/N
  1. S $P(ACRA,U,26)=$G(ACR50)
  1. ;
  1. ; [51]DELETE FLAG
  1. S $P(ACRA,U,27)=$G(ACR51)
  1. ;
  1. ; [29]PAY ADDRESS; ACRFIV12
  1. S $P(ACRA,U,28)=$G(ACR29)
  1. ;
  1. ACRB ; Start setting ACRB
  1. ;
  1. ; [30]PAY CITY; ACRFIV12
  1. S $P(ACRB,U)=$G(ACR30)
  1. ;
  1. ; [31]PAY STATE; ACRFIV12
  1. S $P(ACRB,U,2)=$G(ACR31)
  1. ;
  1. ; [32]PAY ZIP; ACRFIV12
  1. S $P(ACRB,U,3)=$G(ACR32)
  1. ;
  1. ; [33]PAY NAME; ACRFIV12
  1. S $P(ACRB,U,4)=$G(ACR33)
  1. ;
  1. ; [34]INT-SQ ; NOT SET ANYWHERE
  1. S $P(ACRB,U,5)=$E($G(ACR34),1,11)
  1. ;
  1. ; [35]INT-AMT INTEREST AMOUNT
  1. S ACR35=$G(ACRIVDIS(ACRCANDA,ACROBJDA,"P"))
  1. S:+ACR35>0 ACR35=$$17(ACR35)
  1. S $P(ACRB,U,6)=ACR35 ; FIELD ALSO SET IN MORE^ACRFIV11
  1. ;
  1. ; [36]DOC-PMT NODE
  1. S $P(ACRB,U,7)=1
  1. ;
  1. ; [37]INT-DOC
  1. S $P(ACRB,U,8)=$E($G(ACR37),1,10)
  1. ;
  1. ; [38]COST CTR
  1. S $P(ACRB,U,9)=$P(ACRLBDT,U,15)
  1. ;
  1. ; [39]SECONDARY RECIPIENT
  1. S $P(ACRB,U,10)=$E($G(ACR39),1,15)
  1. ;
  1. ; [40]PMT/COLL DOCUMENT
  1. S $P(ACRB,U,11)=$E(ACRBATNO,1,6)
  1. ;
  1. ; [41]V-ADR CHNGE
  1. S $P(ACRB,U,12)=$G(ACR41)
  1. ;
  1. ; [42]E-ADR CHNGE
  1. S $P(ACRB,U,13)=$G(ACR42)
  1. ;
  1. ; [52]DATE OF SERVICE
  1. S $P(ACRB,U,14)=$G(ACR52)
  1. ;
  1. ; [43]DOC-YR NODE (FY OF FUNDS)
  1. S $P(ACRB,U,15)=$E(ACRFYFUN,4)
  1. ;
  1. ; [44]DOC-NODE
  1. S $P(ACRB,U,16)=$G(ACRODDA)
  1. ;
  1. ; [55]CERTIFIED FLAG
  1. S $P(ACRB,U,17)=$G(ACR55)
  1. ;
  1. ; [45]LOC CODE
  1. S $P(ACRB,U,18)=$P($G(ACRLBDT),U,11)
  1. ;
  1. ; [46]PIG-P/F
  1. S $P(ACRB,U,19)=$G(ACR46)
  1. ;
  1. ; [56]VENDOR-EIN-SFX
  1. S $P(ACRB,U,20)=$G(ACR56)
  1. ;
  1. ; [57]APPROPRIATION
  1. S ACRTMP=$E($P($G(^AUTTPRO(+$P(ACRLBDT,U,4),0)),U),1,18)
  1. S $P(ACRB,U,21)=ACRTMP
  1. ;
  1. ; [58]PAY-ID
  1. S $P(ACRB,U,22)=$E($G(ACR58),1,12)
  1. ;
  1. ; [59]ORIGINAL OBLIG.AMT
  1. S $P(ACRB,U,23)=$$DOL^ACRFUTL($P(ACRTADD,U,10))
  1. ;
  1. ; [60]OBLIG.-DATE OF
  1. S $P(ACRB,U,24)=$P(ACRTADD,U,11)
  1. ;
  1. ; [61]DOC-YEAR
  1. S $P(ACRB,U,25)=$S(ACRREF'=116:$E(ACRDOC),1:$E(ACRDOC,6))
  1. ;
  1. ACRC ; Start setting ACRC
  1. ;
  1. ; [62]PMT DUE-DATE
  1. S $P(ACRC,U,1)=$G(ACRPAYDU)
  1. ;
  1. ; [63]ACH ADDENDUM
  1. S $P(ACRC,U,2)=ACRADDN
  1. ;
  1. ; [64]ACHT-POINTER;ACRFIV12
  1. S $P(ACRC,U,3)=$G(ACR64)
  1. ;
  1. ; [65]ACHV-POINTER;ACRFIV12
  1. S $P(ACRC,U,4)=$G(ACR65)
  1. ;
  1. ; [66]PARMFILE-POINTER
  1. S $P(ACRC,U,5)=$G(ACR66)
  1. ;
  1. ; [67]TREASURY#
  1. S $P(ACRC,U,6)=$G(ACR67)
  1. ;
  1. ; [68]PAY ADDRSS-2;ACRFIV12
  1. S $P(ACRC,U,7)=$G(ACR68)
  1. ;
  1. ; INVOICE NUMBERS
  1. S ACR4=ACRINV
  1. S:ACRBTYP="T" ACR4=ACRDOC
  1. ;I ACRACH="C"!(ACRACH="N"),ACRBTYP="V",$D(^TMP("ACRINV",$J)) D ;ACR*2.1*16.06 IM15505
  1. ;.S ACR4=$$INVC(ACRINV) ;MULTIPLE INVOICE NUMBERS ;ACR*2.1*16.06 IM15505
  1. I ACRBTYP="V",$D(^TMP("ACRINV",$J)) D ;ACR*2.1*16.06 IM15505
  1. .I ACRACH="C"!(ACRACH="A") S ACR4=$$INVC(ACRINV) Q ;MULTIPLE INVOICES ;ACR*2.1*16.06 IM15505
  1. I ACR4="" S ACR4=ACRDOC
  1. S $P(ACRC,U,14)=ACR4
  1. ;
  1. ; [69]1099 REPORTING ELIGIBILITY
  1. ;S $P(ACRC,U,15)=?
  1. ;
  1. ACRD ; Start setting ACRD formerly ACRZ3
  1. ;
  1. ; [91]BEGIN DATE
  1. S ACRD=$E($G(ACRBEG),4,5)
  1. S ACRD=ACRD_$E($G(ACRBEG),2,3)
  1. ;
  1. ; [92]END DATE
  1. S ACRD=ACRD_U_$E($G(ACREND),4,5)
  1. S ACRD=ACRD_$E($G(ACREND),2,3)_U
  1. ;
  1. ; 2 DIGIT FY (FY OF FUNDS)
  1. S ACRD=ACRD_$E(ACRFYFUN,3,4)
  1. ;
  1. ACRE ; Start setting ACRE formerly ACRZ4
  1. ;
  1. ; PD FLAG
  1. S ACRTMP="" S:ACRIVDC ACRTMP="D" S:ACRP ACRTMP="P"
  1. S $P(ACRE,U,1)=ACRTMP
  1. ;
  1. ; DISCOUNT/PENALTY AMOUNT
  1. S ACRTMP=$P(ACRTADD,U,2)
  1. S:+ACRTMP>0 ACRTMP=$$DOL^ACRFUTL(ACRTMP)
  1. S $P(ACRE,U,2)=ACRTMP
  1. Q
  1. ;
  1. 17(ACRTMP) ;EP; EXTRINSIC FUNCTION FOR DOLLAR AMOUNT
  1. ;----- EXTRINSIC FUNCTION FOR DOLLAR AMOUNT
  1. ;
  1. S ACRTMP=$$DOL^ACRFUTL(ACRTMP)
  1. S ACRTMP=$$PAD^ACRFUTL(ACRTMP,"L",11,0)
  1. Q ACRTMP
  1. ;
  1. INVC(ACRINV) ;GROUP MULTIPLE INVOICE NUMBERS
  1. N ACRX,ACRY,ACRZ
  1. S ACRX=0,ACRZ=""
  1. F S ACRX=$O(^TMP("ACRINV",$J,ACRX)) Q:'ACRX D
  1. .S ACRZ=ACRZ_$P(^TMP("ACRINV",$J,ACRX),U,2)_","
  1. I $G(ACRZ)]"" D
  1. .S ACRY=ACRZ
  1. .S:$E(ACRY,$L(ACRY))="," ACRY=$E(ACRY,1,$L(ACRY)-1)
  1. .S ACRZ=ACRY
  1. I ACRZ="" S ACRZ=ACRINV
  1. Q ACRZ