FBAAPET ;AISC/DMK - EDIT PAYMENT ;10/1/14 17:10
;;3.5;FEE BASIS;**4,38,55,61,77,116,122,133,108,124,132,139,123,154,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
S FBOT=1
GETPT I $G(BAT) D
.I '$D(^FBAAC("AC",+BAT)) F I=9,10,11 S $P(^FBAA(161.7,+BAT,0),U,I)=""
.I $D(^FBAAC("AC",+BAT)) D S $P(^FBAA(161.7,+BAT,0),U,11)=I,$P(^(0),U,9)=$G(FBTOT) K I,FBTOT
..N J,K,L,M S (I,J,K,L,M,FBTOT)=0
..F S J=$O(^FBAAC("AC",+BAT,J)) Q:'J F S K=$O(^FBAAC("AC",+BAT,J,K)) Q:'K F S L=$O(^FBAAC("AC",+BAT,J,K,L)) Q:'L F S M=$O(^FBAAC("AC",+BAT,J,K,L,M)) Q:'M I $D(^FBAAC(J,1,K,1,L,1,M,0)) S I=I+1,FBTOT=FBTOT+$P(^(0),U,3)
W !! S DIC="^FBAAC(",DIC(0)="AEQM" D ^DIC G END:X="^"!(X=""),GETPT:Y<0 S (DFN,FBDA(3))=+Y
S:'$D(^FBAAC(DFN,1,0)) ^FBAAC(DFN,1,0)="^162.01P^0^0"
S DIC=DIC_DFN_",1,"
GETVD W !! S DIC(0)="AEQM" D ^DIC G GETPT:X="^"!(X=""),GETVD:Y<0 S (FBV,FBVD,FBDA(2))=+Y
S:'$D(^FBAAC(DFN,1,FBDA(2),1,0)) ^FBAAC(DFN,1,FBDA(2),1,0)="^162.02DA^0^0"
S DIC=DIC_FBVD_",1,"
GETDT S DIC(0)="AEQM",DIC("A")="Date of Service: " D ^DIC K DIC("A") G GETPT:X="^"!(X=""),GETDT:Y<0 S (FBSD,FBSDI,FBDA(1))=+Y,FBAADT=$P(Y,U,2)
S:'$D(^FBAAC(DFN,1,FBDA(2),1,FBDA(1),1,0)) ^FBAAC(DFN,1,FBDA(2),1,FBDA(1),1,0)="^162.03A^0^0"
S FBZ=DIC_FBSD_",1,"
SERV S DA(3)=FBDA(3),DA(2)=FBDA(2),DA(1)=FBDA(1)
S DIC("W")="N FBX S FBX=$$MODL^FBAAUTL4(""^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,+Y,""""M"""")"",""E"") W:FBX]"""" "" CPT Modifier(s): "",FBX Q"
S DIC=FBZ,DIC(0)="AEQMZ"
D
. N ICPTVDT S ICPTVDT=$G(FBAADT) D ^DIC
G GETPT:X="^"!(X=""),SERV:Y<0 S (FBSV,FBAACPI,FBDA)=+Y,BAT=$P(Y(0),U,8),FBDUZ=$P(Y(0),U,7),(FBAACP,FBAACP(0))=$P(Y,U,2),K=$P(Y(0),U,3),FBAAPTC=$P(Y(0),U,20),J(0)=$P(Y(0),U,2)
;
S FTP=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,9)
I '$$UOKPAY^FBUTL9(DFN,FTP) D G GETPT
. W !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP
. W !,"due to separation of duties."
;
; set FB1725 true (1) if payment is for a Mill Bill claim
S FB1725=$S($P(Y(0),U,13)["FB583":+$P($G(^FB583(+$P(Y(0),U,13),0)),U,28),1:0)
I FBDUZ'=DUZ&('$D(^XUSEC("FBAA LEVEL 2",DUZ))) W !!,*7,"Sorry, only the clerk who entered the payment or",!," a holder of the FBAA LEVEL 2 key can edit this payment." G GETPT
;S FBAAMM1=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,2)),U,2)
S FBFSAMT(0)=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,2)),U,12)
; determine lesser of original fee schedule amount and amount claimed
S FBAMTPD(0)=$S(FBFSAMT(0)="":J(0),FBFSAMT(0)>J(0):J(0),1:FBFSAMT(0))
S FBMODL=$$MODL^FBAAUTL4("^FBAAC("_FBDA(3)_",1,"_FBDA(2)_",1,"_FBDA(1)_",1,"_FBDA_",""M"")")
; load current adjustment data
D LOADADJ^FBAAFA(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBADJ)
; save adjustment data prior to edit session in sorted list
S FBADJL(0)=$$ADJL^FBUTL2(.FBADJ) ; sorted list of original adjustments
; load current remittance remark data
D LOADRR^FBAAFR(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBRRMK)
; save remittance remarks prior to edit session in sorted list
S FBRRMKL(0)=$$RRL^FBUTL4(.FBRRMK)
; save FPPS data prior to edit session
S FBFPPSC(0)=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U)
S FBFPPSC=FBFPPSC(0)
S FBFPPSL(0)=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,2)
S FBFPPSL=FBFPPSL(0)
G:BAT']"" EDIT
; check batch status
S FBSTAT=$P($G(^FBAA(161.7,BAT,"ST")),U) ; batch status
I FBSTAT="S",'$D(^XUSEC("FBAA LEVEL 2",DUZ)) W !!,*7,"Sorry, only a holder of the FBAA LEVEL 2 key can edit",!," a payment once the batch has been released." G GETPT
I "^T^F^V^"[(U_FBSTAT_U) W !!,*7,"Sorry, you cannot edit a payment when the batch has been sent to Austin." G GETPT
K FBSTAT
;
EDIT S DA=FBSV
;
; first edit CPT code and modifiers
D CPTM^FBAALU(FBAADT,DFN,FBAACP(0),FBMODL) I '$G(FBGOT) G GETPT
; if CPT was changed then update file
I FBAACP'=FBAACP(0) D I FBAACP="@" G GETPT
. N FBIENS,FBFDA
. S FBIENS=FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_","
. S FBFDA(162.03,FBIENS,.01)=FBAACP
. D FILE^DIE("","FBFDA") D MSG^DIALOG()
; if modifiers changed then update file
I FBMODL'=$$MODL^FBAAUTL4("FBMODA") D REPMOD^FBAAUTL4(FBDA(3),FBDA(2),FBDA(1),FBDA)
;
; Check for IPAC data requirements for Federal Vendors (FB*3.5*123)
I '$$IPACEDIT^FBAAPET1(162.03,.FBDA) G SERV
;
; now edit remaining fields
S DIE("NO^")=""
; FB*3.5*139-JLG-ICD10 REMEDIATION -added FBDXCHK1 and FBDXCHK2
N FBDXCHK1 S FBDXCHK1="S:FBAADT<$$IMPDATE^FBCSV1(""10D"") Y=""@7"";@60;S XX1=-1 S XX1=$$ASKICD10^FBAACO2(FBAADT,""Y"") S:XX1<0 Y=""@60"";28////^S X=XX1;S Y=31;"
N FBDXCHK2 S FBDXCHK2="S:FBAADT<$$IMPDATE^FBCSV1(""10D"") Y=""@8"";@15;S XX1=-1 S XX1=$$ASKICD10^FBAACO2(FBAADT) S:XX1<0 Y=""@15"";28////^S X=XX1;S Y=31;"
S DR="48;47;S FBUNITS=X;42R;S FBZIP=X;S:$$ANES^FBAAFS($$CPT^FBAAUTL4(FBAACP)) Y=""@2"";43///@;S FBTIME=X;S Y=""@3"";@2;43R;S FBTIME=X;@3"
; fb*3.5*116 remove edit of interest indicator (162.03,34) to prevent different interest indicator values at line item level; interest indicator set at invoice level only;
S DR(1,162.03,1)="S FBAAMM=$S(FBAAPTC=""R"":"""",1:1);D PPT^FBAACO1(FBAAMM1,FBCNTRP,1);54///@;54////^S X=FBCNTRP;30R;S FBHCFA(30)=X;1;S J=X;Q"
;S DR(1,162.03,1)="30R;S FBHCFA(30)=X;1;S J=X;Q"
S DR(1,162.03,2)="D FEEDT^FBAACO3;44///@;44///^S X=FBFSAMT;45///@;45///^S X=FBFSUSD;S:FBAMTPD'>0!(FBAMTPD=FBAMTPD(0)) Y=""@4"";2///^S X=FBAMTPD;@4;2//^S X=FBAMTPD;S K=X"
;S DR(1,162.03,3)="3////^S X=$S(J-K:J-K,1:"""");I X S Y=""@11"";4////@;S Y=""@5"";@11;3R;4R;S:X'=4 Y=""@5"";22"
S DR(1,162.03,3)="K FBADJD;M FBADJD=FBADJ;S FBX=$$ADJ^FBUTL2(J-K,.FBADJ,5,,.FBADJD,1,.FBRRMK,1)"
S DR(1,162.03,4)="S FBX=$$FPPSC^FBUTL5(1,FBFPPSC);S:FBX=-1 Y=0;S:FBX="""" Y=""@5"";50///^S X=FBX;S FBFPPSC=X;S FBX=$$FPPSL^FBUTL5(FBFPPSL);S:FBX=-1 Y=0;51///^S X=FBX;S FBFPPCL=X;S Y=""@55"";@5;50///@;S FBFPPSC="""";51///@;S FBFPPSL="""";@55"
S DR(1,162.03,5)="K DIE(""NO^"");W !,""Exit ('^') allowed now"";26;S PRC(""SITE"")=X;8;@13;13;I $$BADDATE^FBAAPET(FBAADT,X) S Y=""@13"";Q;33;49"
;JAS - 09/11/13 - PATCH 139 - Modified next two lines (previously one line) for ICD-10
S DR(1,162.03,6)="15;17;16;S:X=1 Y=""@1"";@6;"_FBDXCHK1_"@7;S FBI9=$$ASKICD9^FBAACO2(FBAADT,""Y"") S:+FBI9<0 Y=""@7"";28////^S X=+FBI9;31;32R;S Y=""@9"";"
S DR(1,162.03,7)="@1;"_FBDXCHK2_"@8;S FBI9=$$ASKICD9^FBAACO2(FBAADT) S:+FBI9<0 Y=""@8"";28////^S X=+FBI9;31"
S DR(1,162.03,8)="@9"
S DR(1,162.03,9)="73;74;75;58;59;60;61;62;63;64;65;66;67;76;77;78;79;68;69" ;FB*3.5*122,FB*3.5*133 edit line item provider fields
S DR(1,162.03,10)="@999;K FBDXCHK1,FBDXCHK2,XX1" ;DEM;139 ICD-10 ASF
S DR(1,162.03,11)="82///^S X=$$PYMTH^FBAAUTL(FBFSUSD)" ;FB*3.5*158
S DIE=FBZ
D
. N ICPTVDT,ICDVDT,FB583,FBAAMM,FBAAMM1,FBCNTRA,FBCNTRP,FBVEN,FTP
. S (ICPTVDT,ICDVDT)=$G(FBAADT)
. ; set variables for call to PPT^FBAACO1
. S FBAAMM1=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,2)),U,2)
. S FBCNTRP=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,8)
. S X=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,0)),U,13)
. S:X[";FB583(" FB583=+X
. S FTP=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,9)
. S FBVEN=$S(FTP:$P($G(^FBAAA(DFN,1,FTP,0)),U,4),1:"")
. S FBCNTRA=$S(FTP:$P($G(^FBAAA(DFN,1,FTP,0)),U,22),1:"")
. D ^DIE
; if adjustment data changed then file
I $$ADJL^FBUTL2(.FBADJ)'=FBADJL(0) D FILEADJ^FBAAFA(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBADJ)
; if remit remark data changed then file
I $$RRL^FBUTL4(.FBRRMK)'=FBRRMKL(0) D FILERR^FBAAFR(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBRRMK)
; if FPPS CLAIM ID changed, update other line items on invoice
I FBFPPSC'=FBFPPSC(0) D
. N FBAAIN
. S FBAAIN=$$GET1^DIQ(162.03,FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",14)
. D CKINVEDI^FBAAPET1(FBFPPSC(0),FBFPPSC,FBAAIN,FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",")
K FBSV W !! G SERV
;
BADDATE(FBDOS,INVRCVDT) ;Reject entry if InvRcvDt is Prior to the Date of Service on the Invoice
I INVRCVDT<FBDOS D Q 1 ;Reject entry
.N SHOWDOS S SHOWDOS=$E(FBDOS,4,5)_"/"_$E(FBDOS,6,7)_"/"_$E(FBDOS,2,3) ;Convert FBDOS into display format for error message
.W *7,!!?5,"*** Invoice Received Date cannot be prior to the",!?8,"Date of Service ("_SHOWDOS_") !!!"
Q 0 ;Accept entry
;
END K DR,DIC,DIE,X,DFN,FBOT,FBVD,FBSD,BAT,FBAADT,FBSV,DA,FBDA,FBZ,FBDUZ,FBAACP,FBFY,FY,FBAMTPD,J,K,Y,ZZ,PRC,FBHOLDX,FBV,FBSDI,FBAACPI
K FBFSAMT,FBFSUSD,FBMODA,FBZIP,FBTIME,FBHCFA(30),FBAAPTC,FB1725,FBADJ,FBADJD,FBADJL(0),FBRRMK,FBRRMKD,FBRRMKL(0),FBX,FBUNITS,FTP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPET 8615 printed Apr 09, 2024@21:03:49 Page 2
FBAAPET ;AISC/DMK - EDIT PAYMENT ;10/1/14 17:10
+1 ;;3.5;FEE BASIS;**4,38,55,61,77,116,122,133,108,124,132,139,123,154,158**;JAN 30, 1995;Build 94
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 SET FBOT=1
GETPT IF $GET(BAT)
Begin DoDot:1
+1 IF '$DATA(^FBAAC("AC",+BAT))
FOR I=9,10,11
SET $PIECE(^FBAA(161.7,+BAT,0),U,I)=""
+2 IF $DATA(^FBAAC("AC",+BAT))
Begin DoDot:2
+3 NEW J,K,L,M
SET (I,J,K,L,M,FBTOT)=0
+4 FOR
SET J=$ORDER(^FBAAC("AC",+BAT,J))
if 'J
QUIT
FOR
SET K=$ORDER(^FBAAC("AC",+BAT,J,K))
if 'K
QUIT
FOR
SET L=$ORDER(^FBAAC("AC",+BAT,J,K,L))
if 'L
QUIT
FOR
SET M=$ORDER(^FBAAC("AC",+BAT,J,K,L,M))
if 'M
QUIT
IF $DATA(^FBAAC(J,1,K,1,L,1,M,0))
SET I=I+1
SET FBTOT=FBTOT+$PIECE(^(0),U,3)
End DoDot:2
SET $PIECE(^FBAA(161.7,+BAT,0),U,11)=I
SET $PIECE(^(0),U,9)=$GET(FBTOT)
KILL I,FBTOT
End DoDot:1
+5 WRITE !!
SET DIC="^FBAAC("
SET DIC(0)="AEQM"
DO ^DIC
if X="^"!(X="")
GOTO END
if Y<0
GOTO GETPT
SET (DFN,FBDA(3))=+Y
+6 if '$DATA(^FBAAC(DFN,1,0))
SET ^FBAAC(DFN,1,0)="^162.01P^0^0"
+7 SET DIC=DIC_DFN_",1,"
GETVD WRITE !!
SET DIC(0)="AEQM"
DO ^DIC
if X="^"!(X="")
GOTO GETPT
if Y<0
GOTO GETVD
SET (FBV,FBVD,FBDA(2))=+Y
+1 if '$DATA(^FBAAC(DFN,1,FBDA(2),1,0))
SET ^FBAAC(DFN,1,FBDA(2),1,0)="^162.02DA^0^0"
+2 SET DIC=DIC_FBVD_",1,"
GETDT SET DIC(0)="AEQM"
SET DIC("A")="Date of Service: "
DO ^DIC
KILL DIC("A")
if X="^"!(X="")
GOTO GETPT
if Y<0
GOTO GETDT
SET (FBSD,FBSDI,FBDA(1))=+Y
SET FBAADT=$PIECE(Y,U,2)
+1 if '$DATA(^FBAAC(DFN,1,FBDA(2),1,FBDA(1),1,0))
SET ^FBAAC(DFN,1,FBDA(2),1,FBDA(1),1,0)="^162.03A^0^0"
+2 SET FBZ=DIC_FBSD_",1,"
SERV SET DA(3)=FBDA(3)
SET DA(2)=FBDA(2)
SET DA(1)=FBDA(1)
+1 SET DIC("W")="N FBX S FBX=$$MODL^FBAAUTL4(""^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,+Y,""""M"""")"",""E"") W:FBX]"""" "" CPT Modifier(s): "",FBX Q"
+2 SET DIC=FBZ
SET DIC(0)="AEQMZ"
+3 Begin DoDot:1
+4 NEW ICPTVDT
SET ICPTVDT=$GET(FBAADT)
DO ^DIC
End DoDot:1
+5 if X="^"!(X="")
GOTO GETPT
if Y<0
GOTO SERV
SET (FBSV,FBAACPI,FBDA)=+Y
SET BAT=$PIECE(Y(0),U,8)
SET FBDUZ=$PIECE(Y(0),U,7)
SET (FBAACP,FBAACP(0))=$PIECE(Y,U,2)
SET K=$PIECE(Y(0),U,3)
SET FBAAPTC=$PIECE(Y(0),U,20)
SET J(0)=$PIECE(Y(0),U,2)
+6 ;
+7 SET FTP=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,9)
+8 IF '$$UOKPAY^FBUTL9(DFN,FTP)
Begin DoDot:1
+9 WRITE !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP
+10 WRITE !,"due to separation of duties."
End DoDot:1
GOTO GETPT
+11 ;
+12 ; set FB1725 true (1) if payment is for a Mill Bill claim
+13 SET FB1725=$SELECT($PIECE(Y(0),U,13)["FB583":+$PIECE($GET(^FB583(+$PIECE(Y(0),U,13),0)),U,28),1:0)
+14 IF FBDUZ'=DUZ&('$DATA(^XUSEC("FBAA LEVEL 2",DUZ)))
WRITE !!,*7,"Sorry, only the clerk who entered the payment or",!," a holder of the FBAA LEVEL 2 key can edit this payment."
GOTO GETPT
+15 ;S FBAAMM1=$P($G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,2)),U,2)
+16 SET FBFSAMT(0)=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,2)),U,12)
+17 ; determine lesser of original fee schedule amount and amount claimed
+18 SET FBAMTPD(0)=$SELECT(FBFSAMT(0)="":J(0),FBFSAMT(0)>J(0):J(0),1:FBFSAMT(0))
+19 SET FBMODL=$$MODL^FBAAUTL4("^FBAAC("_FBDA(3)_",1,"_FBDA(2)_",1,"_FBDA(1)_",1,"_FBDA_",""M"")")
+20 ; load current adjustment data
+21 DO LOADADJ^FBAAFA(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBADJ)
+22 ; save adjustment data prior to edit session in sorted list
+23 ; sorted list of original adjustments
SET FBADJL(0)=$$ADJL^FBUTL2(.FBADJ)
+24 ; load current remittance remark data
+25 DO LOADRR^FBAAFR(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBRRMK)
+26 ; save remittance remarks prior to edit session in sorted list
+27 SET FBRRMKL(0)=$$RRL^FBUTL4(.FBRRMK)
+28 ; save FPPS data prior to edit session
+29 SET FBFPPSC(0)=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U)
+30 SET FBFPPSC=FBFPPSC(0)
+31 SET FBFPPSL(0)=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,2)
+32 SET FBFPPSL=FBFPPSL(0)
+33 if BAT']""
GOTO EDIT
+34 ; check batch status
+35 ; batch status
SET FBSTAT=$PIECE($GET(^FBAA(161.7,BAT,"ST")),U)
+36 IF FBSTAT="S"
IF '$DATA(^XUSEC("FBAA LEVEL 2",DUZ))
WRITE !!,*7,"Sorry, only a holder of the FBAA LEVEL 2 key can edit",!," a payment once the batch has been released."
GOTO GETPT
+37 IF "^T^F^V^"[(U_FBSTAT_U)
WRITE !!,*7,"Sorry, you cannot edit a payment when the batch has been sent to Austin."
GOTO GETPT
+38 KILL FBSTAT
+39 ;
EDIT SET DA=FBSV
+1 ;
+2 ; first edit CPT code and modifiers
+3 DO CPTM^FBAALU(FBAADT,DFN,FBAACP(0),FBMODL)
IF '$GET(FBGOT)
GOTO GETPT
+4 ; if CPT was changed then update file
+5 IF FBAACP'=FBAACP(0)
Begin DoDot:1
+6 NEW FBIENS,FBFDA
+7 SET FBIENS=FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_","
+8 SET FBFDA(162.03,FBIENS,.01)=FBAACP
+9 DO FILE^DIE("","FBFDA")
DO MSG^DIALOG()
End DoDot:1
IF FBAACP="@"
GOTO GETPT
+10 ; if modifiers changed then update file
+11 IF FBMODL'=$$MODL^FBAAUTL4("FBMODA")
DO REPMOD^FBAAUTL4(FBDA(3),FBDA(2),FBDA(1),FBDA)
+12 ;
+13 ; Check for IPAC data requirements for Federal Vendors (FB*3.5*123)
+14 IF '$$IPACEDIT^FBAAPET1(162.03,.FBDA)
GOTO SERV
+15 ;
+16 ; now edit remaining fields
+17 SET DIE("NO^")=""
+18 ; FB*3.5*139-JLG-ICD10 REMEDIATION -added FBDXCHK1 and FBDXCHK2
+19 NEW FBDXCHK1
SET FBDXCHK1="S:FBAADT<$$IMPDATE^FBCSV1(""10D"") Y=""@7"";@60;S XX1=-1 S XX1=$$ASKICD10^FBAACO2(FBAADT,""Y"") S:XX1<0 Y=""@60"";28////^S X=XX1;S Y=31;"
+20 NEW FBDXCHK2
SET FBDXCHK2="S:FBAADT<$$IMPDATE^FBCSV1(""10D"") Y=""@8"";@15;S XX1=-1 S XX1=$$ASKICD10^FBAACO2(FBAADT) S:XX1<0 Y=""@15"";28////^S X=XX1;S Y=31;"
+21 SET DR="48;47;S FBUNITS=X;42R;S FBZIP=X;S:$$ANES^FBAAFS($$CPT^FBAAUTL4(FBAACP)) Y=""@2"";43///@;S FBTIME=X;S Y=""@3"";@2;43R;S FBTIME=X;@3"
+22 ; fb*3.5*116 remove edit of interest indicator (162.03,34) to prevent different interest indicator values at line item level; interest indicator set at invoice level only;
+23 SET DR(1,162.03,1)="S FBAAMM=$S(FBAAPTC=""R"":"""",1:1);D PPT^FBAACO1(FBAAMM1,FBCNTRP,1);54///@;54////^S X=FBCNTRP;30R;S FBHCFA(30)=X;1;S J=X;Q"
+24 ;S DR(1,162.03,1)="30R;S FBHCFA(30)=X;1;S J=X;Q"
+25 SET DR(1,162.03,2)="D FEEDT^FBAACO3;44///@;44///^S X=FBFSAMT;45///@;45///^S X=FBFSUSD;S:FBAMTPD'>0!(FBAMTPD=FBAMTPD(0)) Y=""@4"";2///^S X=FBAMTPD;@4;2//^S X=FBAMTPD;S K=X"
+26 ;S DR(1,162.03,3)="3////^S X=$S(J-K:J-K,1:"""");I X S Y=""@11"";4////@;S Y=""@5"";@11;3R;4R;S:X'=4 Y=""@5"";22"
+27 SET DR(1,162.03,3)="K FBADJD;M FBADJD=FBADJ;S FBX=$$ADJ^FBUTL2(J-K,.FBADJ,5,,.FBADJD,1,.FBRRMK,1)"
+28 SET DR(1,162.03,4)="S FBX=$$FPPSC^FBUTL5(1,FBFPPSC);S:FBX=-1 Y=0;S:FBX="""" Y=""@5"";50///^S X=FBX;S FBFPPSC=X;S FBX=$$FPPSL^FBUTL5(FBFPPSL);S:FBX=-1 Y=0;51///^S X=FBX;S FBFPPCL=X;S Y=""@55"";@5;50///@;S FBFPPSC="""";51///@;S FBFPPSL="""";@55"
+29 SET DR(1,162.03,5)="K DIE(""NO^"");W !,""Exit ('^') allowed now"";26;S PRC(""SITE"")=X;8;@13;13;I $$BADDATE^FBAAPET(FBAADT,X) S Y=""@13"";Q;33;49"
+30 ;JAS - 09/11/13 - PATCH 139 - Modified next two lines (previously one line) for ICD-10
+31 SET DR(1,162.03,6)="15;17;16;S:X=1 Y=""@1"";@6;"_FBDXCHK1_"@7;S FBI9=$$ASKICD9^FBAACO2(FBAADT,""Y"") S:+FBI9<0 Y=""@7"";28////^S X=+FBI9;31;32R;S Y=""@9"";"
+32 SET DR(1,162.03,7)="@1;"_FBDXCHK2_"@8;S FBI9=$$ASKICD9^FBAACO2(FBAADT) S:+FBI9<0 Y=""@8"";28////^S X=+FBI9;31"
+33 SET DR(1,162.03,8)="@9"
+34 ;FB*3.5*122,FB*3.5*133 edit line item provider fields
SET DR(1,162.03,9)="73;74;75;58;59;60;61;62;63;64;65;66;67;76;77;78;79;68;69"
+35 ;DEM;139 ICD-10 ASF
SET DR(1,162.03,10)="@999;K FBDXCHK1,FBDXCHK2,XX1"
+36 ;FB*3.5*158
SET DR(1,162.03,11)="82///^S X=$$PYMTH^FBAAUTL(FBFSUSD)"
+37 SET DIE=FBZ
+38 Begin DoDot:1
+39 NEW ICPTVDT,ICDVDT,FB583,FBAAMM,FBAAMM1,FBCNTRA,FBCNTRP,FBVEN,FTP
+40 SET (ICPTVDT,ICDVDT)=$GET(FBAADT)
+41 ; set variables for call to PPT^FBAACO1
+42 SET FBAAMM1=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,2)),U,2)
+43 SET FBCNTRP=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,8)
+44 SET X=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,0)),U,13)
+45 if X[";FB583("
SET FB583=+X
+46 SET FTP=$PIECE($GET(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)),U,9)
+47 SET FBVEN=$SELECT(FTP:$PIECE($GET(^FBAAA(DFN,1,FTP,0)),U,4),1:"")
+48 SET FBCNTRA=$SELECT(FTP:$PIECE($GET(^FBAAA(DFN,1,FTP,0)),U,22),1:"")
+49 DO ^DIE
End DoDot:1
+50 ; if adjustment data changed then file
+51 IF $$ADJL^FBUTL2(.FBADJ)'=FBADJL(0)
DO FILEADJ^FBAAFA(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBADJ)
+52 ; if remit remark data changed then file
+53 IF $$RRL^FBUTL4(.FBRRMK)'=FBRRMKL(0)
DO FILERR^FBAAFR(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.FBRRMK)
+54 ; if FPPS CLAIM ID changed, update other line items on invoice
+55 IF FBFPPSC'=FBFPPSC(0)
Begin DoDot:1
+56 NEW FBAAIN
+57 SET FBAAIN=$$GET1^DIQ(162.03,FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",14)
+58 DO CKINVEDI^FBAAPET1(FBFPPSC(0),FBFPPSC,FBAAIN,FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",")
End DoDot:1
+59 KILL FBSV
WRITE !!
GOTO SERV
+60 ;
BADDATE(FBDOS,INVRCVDT) ;Reject entry if InvRcvDt is Prior to the Date of Service on the Invoice
+1 ;Reject entry
IF INVRCVDT<FBDOS
Begin DoDot:1
+2 ;Convert FBDOS into display format for error message
NEW SHOWDOS
SET SHOWDOS=$EXTRACT(FBDOS,4,5)_"/"_$EXTRACT(FBDOS,6,7)_"/"_$EXTRACT(FBDOS,2,3)
+3 WRITE *7,!!?5,"*** Invoice Received Date cannot be prior to the",!?8,"Date of Service ("_SHOWDOS_") !!!"
End DoDot:1
QUIT 1
+4 ;Accept entry
QUIT 0
+5 ;
END KILL DR,DIC,DIE,X,DFN,FBOT,FBVD,FBSD,BAT,FBAADT,FBSV,DA,FBDA,FBZ,FBDUZ,FBAACP,FBFY,FY,FBAMTPD,J,K,Y,ZZ,PRC,FBHOLDX,FBV,FBSDI,FBAACPI
+1 KILL FBFSAMT,FBFSUSD,FBMODA,FBZIP,FBTIME,FBHCFA(30),FBAAPTC,FB1725,FBADJ,FBADJD,FBADJL(0),FBRRMK,FBRRMKD,FBRRMKL(0),FBX,FBUNITS,FTP
+2 QUIT
