FBAACO1 ;AISC/GRR - ENTER PAYMENT CONTINUED ;5/12/2014
;;3.5;FEE BASIS;**4,61,77,108,124,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
SVCPR ;set up service provided multiple
; input FBASSOC (auth ptr,0 if not known)
I '$D(^FBAAC(DFN,1,FBV,1,FBSDI,1,0)) S ^FBAAC(DFN,1,FBV,1,FBSDI,1,0)="^162.03A^0^0"
W ! S DLAYGO=162,DIC="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,",DIC(0)=$S($G(FBCNP):"QL",1:"EQL"),X=""""_FBX_"""",DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI
D
. N ICPTVDT S ICPTVDT=$G(FBAADT) D ^DIC
K DIC,DLAYGO,DA I Y<0 S FBAAOUT=1 Q
S (FBAACPI,DA)=+Y
;
; update zip code, anesthesia time, and authorization pointer
S DIE="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,"
K DA S DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI,DA=FBAACPI
S DR="42////^S X=$G(FBZIP);43////^S X=$G(FBTIME)"
S:$G(FBASSOC)>0 DR=DR_";15.5////^S X=FBASSOC"
D ^DIE K DIE,DA,DR
;
; create CPT MODIFIER entries from data in array FBMODA
D REPMOD^FBAAUTL4(DFN,FBV,FBSDI,FBAACPI)
;
Q
;
PPT(FBDEF,FBDEFC,FB162) ;establishes prompt pay type and contract for entry
; input
; FBDEF = (optional) default for DIR prompt: =1 for yes, else no
; FBDEFC = (optional) default for the contract prompt
; FBAAMM = ppt if 1 ask for each line item; if 0 don't ask
; FBV = vendor (ien) being paid
; FBVEN = vendor (ien) from authorization
; FBCNTRA= contract (ien) from authorization
; FB583 = (optional) $D(FB583) true if unauthorized claim
; FB162 = (optional) = 1 if payment line item in sub-file 162.03 is being edited. FBDEF and FBDEFC must be current values.
; output
; FBAAMM1 = the ppt for the line item
; FBCNTRP = contract ien for the line item
N Y
S (FBAAMM1,FBCNTRP)=""
I FBAAMM="" Q
S:'$D(FBV) FBV=$G(FBVEN) ;SOMETIMES FBV DOES NOT EXIST BUT FBVEN IS SET EQUAL TO THE VENDOR IN FBCH ENTER PAYMENT
I FBAAMM=1,'$D(FB583),$$UCFA^FBUTL7($G(FBV),$G(FBVEN),$G(FBCNTRA)) D Q
. W !,"Contract is ",$P($G(^FBAA(161.43,FBCNTRA,0)),U)," from the authorization."
. S FBAAMM1=1
. S FBCNTRP=FBCNTRA
I FBAAMM=1 D
. ;if editing line in file 162 contracted services can't be changed
. I $G(FB162)=1 D
.. W !,"Invoice ",$S(FBDEF=1:"is",1:"is not")," for contracted services."
.. S Y=$S(FBDEF=1:1,1:0)
. ;if not editing line in file 162 contracted services can be changed
. I $G(FB162)'=1 F D Q:Y]""
. . S DIR(0)="Y",DIR("A")="Is this line item for a contracted service"
. . S DIR("B")=$S($G(FBDEF)=1:"Yes",1:"No")
. . S DIR("?")="Answering no indicates that interest will not be paid for this line item."
. . D ^DIR K DIR I $D(DIRUT) W !,$C(7),"Required Response!" S Y=""
. S FBAAMM1=$S(Y=1:1,1:"")
. Q:FBAAMM1=""
. ;
. S DIR(0)="PO^161.43:AQEM"
. S DIR("A")="CONTRACT"
. S DIR("?",1)="If the line item is under a contract then select it."
. S DIR("?")="Contract must be active and applicable for the vendor."
. S DIR("S")="I $P($G(^(0)),""^"",2)'=""I"",$$VCNTR^FBUTL7($G(FBV),+Y)"
. S:$G(FBDEFC) DIR("B")=$P($G(^FBAA(161.43,FBDEFC,0)),U)
. D ^DIR K DIR
. ; if time-out or '^' and has default value (i.e. edit payment)
. ; return default so existing payment is not altered
. I $D(DTOUT)!$D(DUOUT),$G(FBDEFC)>0 S FBCNTRP=FBDEFC Q
. I Y>0 S FBCNTRP=+Y
Q
;
Q K FBAADT,FBX,FBAACP W:FBINTOT>0 !!,"Invoice: "_FBAAIN_" Totals $ "_$J(FBINTOT,1,2) G Q^FBAACO:$D(FB583),1^FBAACO:'$D(FBCHCO) Q
;
POS ; prompt for place of service
; output
; FBHCFA(30) = place of service (internal)
N Y
S FBHCFA(30)=""
S DIR(0)="P^353.1:EMZ"
D ^DIR K DIR I $D(DIRUT) Q
S FBHCFA(30)=$P(Y,U)
Q
;
GETVEN ;select vendor from vendor file
W !! S DLAYGO=161.2,DIC="^FBAAV(",DIC(0)="AEQLM" D ^DIC K DLAYGO I X="^"!(X="") S FBAAOUT=1 Q
;if new vendor, call in to new vendor setup routine
G GETVEN:Y<0 S DA=+Y,DIE=DIC D:$P(Y,"^",3)=1 NEW^FBAAVD K DIE,DIC,DR,X,DLAYGO
GETVEN1 I $D(FB583) S DA=FBVEN
I $D(^FBAAV(DA,0)),$P($G(^("ADEL")),U)="Y" W !!,$C(7),"Vendor has been flagged for Austin deletion!" G GETVEN:'$D(FB583) S FBAAOUT=1 Q
D:$P(FBSITE(0),"^",11)="Y" EN1^FBAAVD
GETVEN2 I $P(FBSITE(0),"^",11)="Y",$D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ)) S DIR(0)="Y",DIR("A")="Want to Edit data",DIR("B")="NO" D ^DIR K DIR S:$D(DIRUT) FBAAOUT=1 Q:$D(DIRUT) D:Y EDITV^FBAAVD
I $P(FBSITE(0),"^",11)'="Y"!('$D(^XUSEC("FBAA ESTABLISH VENDOR",DUZ))) S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
S FBV=DA,FBAR(DA)="" D ^FBAACO4
Q
;
GETINV ;assign invoice number or select existing invoice number
K FBAAOUT S FBINTOT=0 S DIR(0)="Y",DIR("A")="Want a new Invoice number assigned",DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1 Q
I Y D GETNXI^FBAAUTL W !!,"Invoice # ",FBAAIN," assigned to this Invoice" Q
GETINV1 ;selects existing invoice if user does not choose to assign new number
S DIR(0)="N",DIR("A")="Select Invoice number",DIR("?")="Select one of the previously entered Invoice #'s" D ^DIR K DIR I $D(DIRUT)!(X="") G GETINV:'$G(FB583) S FBAAOUT=1 Q
D CHK1^FBAACO4 G GETINV1:'$G(FBAACK1) K FBAACK1
I '$D(^FBAAC("AJ",FBAABE,X)) D G GETINV1
. W !,$C(7),"Only previously entered invoices in the same batch may be selected!"
S FBAAIN=X D CALC^FBAACO3 W:FBINTOT>0 ?33,"Current Total: $ "_$J(FBINTOT,1,2)
Q
;
GETINDT ;get invoice dates
;input requires FBAABDT (authorization from date)
K FBAAOUT W !,"Enter Date Correct Invoice Received or Last Date of Service" S %DT("A")="(whichever is later): " S:$G(FBAAID) %DT("B")=$$DATX^FBAAUTL(FBAAID) I $G(FBCNH) S %DT(0)=$G(FBENDDT)
S %DT="AEXP" D ^%DT K %DT I X="^"!(X="") S FBAAOUT=1 Q
S FBAAID=Y I $G(CALLERID)="FBCHEP",FBAAID<FBAAEDT D K FBAAID G GETINDT
.N SHOWDOS S SHOWDOS=$E(FBAAEDT,4,5)_"/"_$E(FBAAEDT,6,7)_"/"_$E(FBAAEDT,2,3) ;Convert FBAAEDT (Treatment TO Date) into display format for error message
.W *7,!!?5,"*** Invoice Received Date cannot be before the ",!?8," Treatment TO Date ("_SHOWDOS_") !!!"
I '$G(FBCNP) I FBAAID<FBAABDT D K FBAAID G GETINDT
.N SHOWDOS S SHOWDOS=$E(FBAABDT,4,5)_"/"_$E(FBAABDT,6,7)_"/"_$E(FBAABDT,2,3) ;Convert FBAABDT (Authorization From Date) into display format for error message
.W !!,$C(7),?5,"*** Invoice Received Date cannot be earlier than",!?8," Patient's Authorization Date ("_SHOWDOS_") !!!"
GETIND1 W ! S %DT("A")="Enter Vendor Invoice Date: ",%DT="AEXP" S:$G(FBAAVID) %DT("B")=$$DATX^FBAAUTL(FBAAVID) D ^%DT K %DT G GETINDT:X="" I X="^" S FBAAOUT=1 Q
S FBAAVID=Y I FBAAVID>FBAAID W !!,$C(7),"Vendor's invoice date is later than the date you received it!!" K FBAAVID G GETIND1
Q
;
DISPINV ;display invoice totals
;required inputs FBAADT (auth dt),DFN
S H=$E(FBAADT,1,5)_"00",R=9999999.9999-H,S=$E(FBAADT,1,5)_31,S=9999999.9999-S,G=+$E(FBAADT,4,5)_+$E(FBAADT,2,3) D CKMAX^FBAACO3
S FBTPD=0 I $D(^FBAAC(DFN,3,"AB",FBAADT)) S FBZX=$O(^FBAAC(DFN,3,"AB",FBAADT,0)) I $D(^FBAAC(DFN,3,FBZX,0)) W !!,"$ ",$P(^(0),"^",3)," for travel already entered for this date of service" S FBTPD=1
W:'$D(FBCHCO) !!,"Total already paid on ID Card for month: $ ",A," Maximum allowed: $ ",$P(FBSITE(1),"^",9),!,"Total already paid on All/Other for month: $ ",FBAOT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAACO1 7141 printed Oct 16, 2024@17:55:59 Page 2
FBAACO1 ;AISC/GRR - ENTER PAYMENT CONTINUED ;5/12/2014
+1 ;;3.5;FEE BASIS;**4,61,77,108,124,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
SVCPR ;set up service provided multiple
+1 ; input FBASSOC (auth ptr,0 if not known)
+2 IF '$DATA(^FBAAC(DFN,1,FBV,1,FBSDI,1,0))
SET ^FBAAC(DFN,1,FBV,1,FBSDI,1,0)="^162.03A^0^0"
+3 WRITE !
SET DLAYGO=162
SET DIC="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,"
SET DIC(0)=$SELECT($GET(FBCNP):"QL",1:"EQL")
SET X=""""_FBX_""""
SET DA(3)=DFN
SET DA(2)=FBV
SET DA(1)=FBSDI
+4 Begin DoDot:1
+5 NEW ICPTVDT
SET ICPTVDT=$GET(FBAADT)
DO ^DIC
End DoDot:1
+6 KILL DIC,DLAYGO,DA
IF Y<0
SET FBAAOUT=1
QUIT
+7 SET (FBAACPI,DA)=+Y
+8 ;
+9 ; update zip code, anesthesia time, and authorization pointer
+10 SET DIE="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,"
+11 KILL DA
SET DA(3)=DFN
SET DA(2)=FBV
SET DA(1)=FBSDI
SET DA=FBAACPI
+12 SET DR="42////^S X=$G(FBZIP);43////^S X=$G(FBTIME)"
+13 if $GET(FBASSOC)>0
SET DR=DR_";15.5////^S X=FBASSOC"
+14 DO ^DIE
KILL DIE,DA,DR
+15 ;
+16 ; create CPT MODIFIER entries from data in array FBMODA
+17 DO REPMOD^FBAAUTL4(DFN,FBV,FBSDI,FBAACPI)
+18 ;
+19 QUIT
+20 ;
PPT(FBDEF,FBDEFC,FB162) ;establishes prompt pay type and contract for entry
+1 ; input
+2 ; FBDEF = (optional) default for DIR prompt: =1 for yes, else no
+3 ; FBDEFC = (optional) default for the contract prompt
+4 ; FBAAMM = ppt if 1 ask for each line item; if 0 don't ask
+5 ; FBV = vendor (ien) being paid
+6 ; FBVEN = vendor (ien) from authorization
+7 ; FBCNTRA= contract (ien) from authorization
+8 ; FB583 = (optional) $D(FB583) true if unauthorized claim
+9 ; FB162 = (optional) = 1 if payment line item in sub-file 162.03 is being edited. FBDEF and FBDEFC must be current values.
+10 ; output
+11 ; FBAAMM1 = the ppt for the line item
+12 ; FBCNTRP = contract ien for the line item
+13 NEW Y
+14 SET (FBAAMM1,FBCNTRP)=""
+15 IF FBAAMM=""
QUIT
+16 ;SOMETIMES FBV DOES NOT EXIST BUT FBVEN IS SET EQUAL TO THE VENDOR IN FBCH ENTER PAYMENT
if '$DATA(FBV)
SET FBV=$GET(FBVEN)
+17 IF FBAAMM=1
IF '$DATA(FB583)
IF $$UCFA^FBUTL7($GET(FBV),$GET(FBVEN),$GET(FBCNTRA))
Begin DoDot:1
+18 WRITE !,"Contract is ",$PIECE($GET(^FBAA(161.43,FBCNTRA,0)),U)," from the authorization."
+19 SET FBAAMM1=1
+20 SET FBCNTRP=FBCNTRA
End DoDot:1
QUIT
+21 IF FBAAMM=1
Begin DoDot:1
+22 ;if editing line in file 162 contracted services can't be changed
+23 IF $GET(FB162)=1
Begin DoDot:2
+24 WRITE !,"Invoice ",$SELECT(FBDEF=1:"is",1:"is not")," for contracted services."
+25 SET Y=$SELECT(FBDEF=1:1,1:0)
End DoDot:2
+26 ;if not editing line in file 162 contracted services can be changed
+27 IF $GET(FB162)'=1
FOR
Begin DoDot:2
+28 SET DIR(0)="Y"
SET DIR("A")="Is this line item for a contracted service"
+29 SET DIR("B")=$SELECT($GET(FBDEF)=1:"Yes",1:"No")
+30 SET DIR("?")="Answering no indicates that interest will not be paid for this line item."
+31 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
WRITE !,$CHAR(7),"Required Response!"
SET Y=""
End DoDot:2
if Y]""
QUIT
+32 SET FBAAMM1=$SELECT(Y=1:1,1:"")
+33 if FBAAMM1=""
QUIT
+34 ;
+35 SET DIR(0)="PO^161.43:AQEM"
+36 SET DIR("A")="CONTRACT"
+37 SET DIR("?",1)="If the line item is under a contract then select it."
+38 SET DIR("?")="Contract must be active and applicable for the vendor."
+39 SET DIR("S")="I $P($G(^(0)),""^"",2)'=""I"",$$VCNTR^FBUTL7($G(FBV),+Y)"
+40 if $GET(FBDEFC)
SET DIR("B")=$PIECE($GET(^FBAA(161.43,FBDEFC,0)),U)
+41 DO ^DIR
KILL DIR
+42 ; if time-out or '^' and has default value (i.e. edit payment)
+43 ; return default so existing payment is not altered
+44 IF $DATA(DTOUT)!$DATA(DUOUT)
IF $GET(FBDEFC)>0
SET FBCNTRP=FBDEFC
QUIT
+45 IF Y>0
SET FBCNTRP=+Y
End DoDot:1
+46 QUIT
+47 ;
Q KILL FBAADT,FBX,FBAACP
if FBINTOT>0
WRITE !!,"Invoice: "_FBAAIN_" Totals $ "_$JUSTIFY(FBINTOT,1,2)
if $DATA(FB583)
GOTO Q^FBAACO
if '$DATA(FBCHCO)
GOTO 1^FBAACO
QUIT
+1 ;
POS ; prompt for place of service
+1 ; output
+2 ; FBHCFA(30) = place of service (internal)
+3 NEW Y
+4 SET FBHCFA(30)=""
+5 SET DIR(0)="P^353.1:EMZ"
+6 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+7 SET FBHCFA(30)=$PIECE(Y,U)
+8 QUIT
+9 ;
GETVEN ;select vendor from vendor file
+1 WRITE !!
SET DLAYGO=161.2
SET DIC="^FBAAV("
SET DIC(0)="AEQLM"
DO ^DIC
KILL DLAYGO
IF X="^"!(X="")
SET FBAAOUT=1
QUIT
+2 ;if new vendor, call in to new vendor setup routine
+3 if Y<0
GOTO GETVEN
SET DA=+Y
SET DIE=DIC
if $PIECE(Y,"^",3)=1
DO NEW^FBAAVD
KILL DIE,DIC,DR,X,DLAYGO
GETVEN1 IF $DATA(FB583)
SET DA=FBVEN
+1 IF $DATA(^FBAAV(DA,0))
IF $PIECE($GET(^("ADEL")),U)="Y"
WRITE !!,$CHAR(7),"Vendor has been flagged for Austin deletion!"
if '$DATA(FB583)
GOTO GETVEN
SET FBAAOUT=1
QUIT
+2 if $PIECE(FBSITE(0),"^",11)="Y"
DO EN1^FBAAVD
GETVEN2 IF $PIECE(FBSITE(0),"^",11)="Y"
IF $DATA(^XUSEC("FBAA ESTABLISH VENDOR",DUZ))
SET DIR(0)="Y"
SET DIR("A")="Want to Edit data"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET FBAAOUT=1
if $DATA(DIRUT)
QUIT
if Y
DO EDITV^FBAAVD
+1 IF $PIECE(FBSITE(0),"^",11)'="Y"!('$DATA(^XUSEC("FBAA ESTABLISH VENDOR",DUZ)))
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBAAOUT=1
QUIT
+2 SET FBV=DA
SET FBAR(DA)=""
DO ^FBAACO4
+3 QUIT
+4 ;
GETINV ;assign invoice number or select existing invoice number
+1 KILL FBAAOUT
SET FBINTOT=0
SET DIR(0)="Y"
SET DIR("A")="Want a new Invoice number assigned"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBAAOUT=1
QUIT
+2 IF Y
DO GETNXI^FBAAUTL
WRITE !!,"Invoice # ",FBAAIN," assigned to this Invoice"
QUIT
GETINV1 ;selects existing invoice if user does not choose to assign new number
+1 SET DIR(0)="N"
SET DIR("A")="Select Invoice number"
SET DIR("?")="Select one of the previously entered Invoice #'s"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(X="")
if '$GET(FB583)
GOTO GETINV
SET FBAAOUT=1
QUIT
+2 DO CHK1^FBAACO4
if '$GET(FBAACK1)
GOTO GETINV1
KILL FBAACK1
+3 IF '$DATA(^FBAAC("AJ",FBAABE,X))
Begin DoDot:1
+4 WRITE !,$CHAR(7),"Only previously entered invoices in the same batch may be selected!"
End DoDot:1
GOTO GETINV1
+5 SET FBAAIN=X
DO CALC^FBAACO3
if FBINTOT>0
WRITE ?33,"Current Total: $ "_$JUSTIFY(FBINTOT,1,2)
+6 QUIT
+7 ;
GETINDT ;get invoice dates
+1 ;input requires FBAABDT (authorization from date)
+2 KILL FBAAOUT
WRITE !,"Enter Date Correct Invoice Received or Last Date of Service"
SET %DT("A")="(whichever is later): "
if $GET(FBAAID)
SET %DT("B")=$$DATX^FBAAUTL(FBAAID)
IF $GET(FBCNH)
SET %DT(0)=$GET(FBENDDT)
+3 SET %DT="AEXP"
DO ^%DT
KILL %DT
IF X="^"!(X="")
SET FBAAOUT=1
QUIT
+4 SET FBAAID=Y
IF $GET(CALLERID)="FBCHEP"
IF FBAAID<FBAAEDT
Begin DoDot:1
+5 ;Convert FBAAEDT (Treatment TO Date) into display format for error message
NEW SHOWDOS
SET SHOWDOS=$EXTRACT(FBAAEDT,4,5)_"/"_$EXTRACT(FBAAEDT,6,7)_"/"_$EXTRACT(FBAAEDT,2,3)
+6 WRITE *7,!!?5,"*** Invoice Received Date cannot be before the ",!?8," Treatment TO Date ("_SHOWDOS_") !!!"
End DoDot:1
KILL FBAAID
GOTO GETINDT
+7 IF '$GET(FBCNP)
IF FBAAID<FBAABDT
Begin DoDot:1
+8 ;Convert FBAABDT (Authorization From Date) into display format for error message
NEW SHOWDOS
SET SHOWDOS=$EXTRACT(FBAABDT,4,5)_"/"_$EXTRACT(FBAABDT,6,7)_"/"_$EXTRACT(FBAABDT,2,3)
+9 WRITE !!,$CHAR(7),?5,"*** Invoice Received Date cannot be earlier than",!?8," Patient's Authorization Date ("_SHOWDOS_") !!!"
End DoDot:1
KILL FBAAID
GOTO GETINDT
GETIND1 WRITE !
SET %DT("A")="Enter Vendor Invoice Date: "
SET %DT="AEXP"
if $GET(FBAAVID)
SET %DT("B")=$$DATX^FBAAUTL(FBAAVID)
DO ^%DT
KILL %DT
if X=""
GOTO GETINDT
IF X="^"
SET FBAAOUT=1
QUIT
+1 SET FBAAVID=Y
IF FBAAVID>FBAAID
WRITE !!,$CHAR(7),"Vendor's invoice date is later than the date you received it!!"
KILL FBAAVID
GOTO GETIND1
+2 QUIT
+3 ;
DISPINV ;display invoice totals
+1 ;required inputs FBAADT (auth dt),DFN
+2 SET H=$EXTRACT(FBAADT,1,5)_"00"
SET R=9999999.9999-H
SET S=$EXTRACT(FBAADT,1,5)_31
SET S=9999999.9999-S
SET G=+$EXTRACT(FBAADT,4,5)_+$EXTRACT(FBAADT,2,3)
DO CKMAX^FBAACO3
+3 SET FBTPD=0
IF $DATA(^FBAAC(DFN,3,"AB",FBAADT))
SET FBZX=$ORDER(^FBAAC(DFN,3,"AB",FBAADT,0))
IF $DATA(^FBAAC(DFN,3,FBZX,0))
WRITE !!,"$ ",$PIECE(^(0),"^",3)," for travel already entered for this date of service"
SET FBTPD=1
+4 if '$DATA(FBCHCO)
WRITE !!,"Total already paid on ID Card for month: $ ",A," Maximum allowed: $ ",$PIECE(FBSITE(1),"^",9),!,"Total already paid on All/Other for month: $ ",FBAOT
+5 QUIT
