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