- 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 Feb 18, 2025@23:21:35 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