- 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