Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAACO1

FBAACO1.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. SVCPR ;set up service provided multiple
  1. ; input FBASSOC (auth ptr,0 if not known)
  1. I '$D(^FBAAC(DFN,1,FBV,1,FBSDI,1,0)) S ^FBAAC(DFN,1,FBV,1,FBSDI,1,0)="^162.03A^0^0"
  1. 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
  1. D
  1. . N ICPTVDT S ICPTVDT=$G(FBAADT) D ^DIC
  1. K DIC,DLAYGO,DA I Y<0 S FBAAOUT=1 Q
  1. S (FBAACPI,DA)=+Y
  1. ;
  1. ; update zip code, anesthesia time, and authorization pointer
  1. S DIE="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,"
  1. K DA S DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI,DA=FBAACPI
  1. S DR="42////^S X=$G(FBZIP);43////^S X=$G(FBTIME)"
  1. S:$G(FBASSOC)>0 DR=DR_";15.5////^S X=FBASSOC"
  1. D ^DIE K DIE,DA,DR
  1. ;
  1. ; create CPT MODIFIER entries from data in array FBMODA
  1. D REPMOD^FBAAUTL4(DFN,FBV,FBSDI,FBAACPI)
  1. ;
  1. Q
  1. ;
  1. PPT(FBDEF,FBDEFC,FB162) ;establishes prompt pay type and contract for entry
  1. ; input
  1. ; FBDEF = (optional) default for DIR prompt: =1 for yes, else no
  1. ; FBDEFC = (optional) default for the contract prompt
  1. ; FBAAMM = ppt if 1 ask for each line item; if 0 don't ask
  1. ; FBV = vendor (ien) being paid
  1. ; FBVEN = vendor (ien) from authorization
  1. ; FBCNTRA= contract (ien) from authorization
  1. ; FB583 = (optional) $D(FB583) true if unauthorized claim
  1. ; FB162 = (optional) = 1 if payment line item in sub-file 162.03 is being edited. FBDEF and FBDEFC must be current values.
  1. ; output
  1. ; FBAAMM1 = the ppt for the line item
  1. ; FBCNTRP = contract ien for the line item
  1. N Y
  1. S (FBAAMM1,FBCNTRP)=""
  1. I FBAAMM="" Q
  1. S:'$D(FBV) FBV=$G(FBVEN) ;SOMETIMES FBV DOES NOT EXIST BUT FBVEN IS SET EQUAL TO THE VENDOR IN FBCH ENTER PAYMENT
  1. I FBAAMM=1,'$D(FB583),$$UCFA^FBUTL7($G(FBV),$G(FBVEN),$G(FBCNTRA)) D Q
  1. . W !,"Contract is ",$P($G(^FBAA(161.43,FBCNTRA,0)),U)," from the authorization."
  1. . S FBAAMM1=1
  1. . S FBCNTRP=FBCNTRA
  1. I FBAAMM=1 D
  1. . ;if editing line in file 162 contracted services can't be changed
  1. . I $G(FB162)=1 D
  1. .. W !,"Invoice ",$S(FBDEF=1:"is",1:"is not")," for contracted services."
  1. .. S Y=$S(FBDEF=1:1,1:0)
  1. . ;if not editing line in file 162 contracted services can be changed
  1. . I $G(FB162)'=1 F D Q:Y]""
  1. . . S DIR(0)="Y",DIR("A")="Is this line item for a contracted service"
  1. . . S DIR("B")=$S($G(FBDEF)=1:"Yes",1:"No")
  1. . . S DIR("?")="Answering no indicates that interest will not be paid for this line item."
  1. . . D ^DIR K DIR I $D(DIRUT) W !,$C(7),"Required Response!" S Y=""
  1. . S FBAAMM1=$S(Y=1:1,1:"")
  1. . Q:FBAAMM1=""
  1. . ;
  1. . S DIR(0)="PO^161.43:AQEM"
  1. . S DIR("A")="CONTRACT"
  1. . S DIR("?",1)="If the line item is under a contract then select it."
  1. . S DIR("?")="Contract must be active and applicable for the vendor."
  1. . S DIR("S")="I $P($G(^(0)),""^"",2)'=""I"",$$VCNTR^FBUTL7($G(FBV),+Y)"
  1. . S:$G(FBDEFC) DIR("B")=$P($G(^FBAA(161.43,FBDEFC,0)),U)
  1. . D ^DIR K DIR
  1. . ; if time-out or '^' and has default value (i.e. edit payment)
  1. . ; return default so existing payment is not altered
  1. . I $D(DTOUT)!$D(DUOUT),$G(FBDEFC)>0 S FBCNTRP=FBDEFC Q
  1. . I Y>0 S FBCNTRP=+Y
  1. Q
  1. ;
  1. 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
  1. ;
  1. POS ; prompt for place of service
  1. ; output
  1. ; FBHCFA(30) = place of service (internal)
  1. N Y
  1. S FBHCFA(30)=""
  1. S DIR(0)="P^353.1:EMZ"
  1. D ^DIR K DIR I $D(DIRUT) Q
  1. S FBHCFA(30)=$P(Y,U)
  1. Q
  1. ;
  1. GETVEN ;select vendor from vendor file
  1. W !! S DLAYGO=161.2,DIC="^FBAAV(",DIC(0)="AEQLM" D ^DIC K DLAYGO I X="^"!(X="") S FBAAOUT=1 Q
  1. ;if new vendor, call in to new vendor setup routine
  1. G GETVEN:Y<0 S DA=+Y,DIE=DIC D:$P(Y,"^",3)=1 NEW^FBAAVD K DIE,DIC,DR,X,DLAYGO
  1. GETVEN1 I $D(FB583) S DA=FBVEN
  1. 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
  1. D:$P(FBSITE(0),"^",11)="Y" EN1^FBAAVD
  1. 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
  1. 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
  1. S FBV=DA,FBAR(DA)="" D ^FBAACO4
  1. Q
  1. ;
  1. GETINV ;assign invoice number or select existing invoice number
  1. 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
  1. I Y D GETNXI^FBAAUTL W !!,"Invoice # ",FBAAIN," assigned to this Invoice" Q
  1. GETINV1 ;selects existing invoice if user does not choose to assign new number
  1. 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
  1. D CHK1^FBAACO4 G GETINV1:'$G(FBAACK1) K FBAACK1
  1. I '$D(^FBAAC("AJ",FBAABE,X)) D G GETINV1
  1. . W !,$C(7),"Only previously entered invoices in the same batch may be selected!"
  1. S FBAAIN=X D CALC^FBAACO3 W:FBINTOT>0 ?33,"Current Total: $ "_$J(FBINTOT,1,2)
  1. Q
  1. ;
  1. GETINDT ;get invoice dates
  1. ;input requires FBAABDT (authorization from date)
  1. 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)
  1. S %DT="AEXP" D ^%DT K %DT I X="^"!(X="") S FBAAOUT=1 Q
  1. S FBAAID=Y I $G(CALLERID)="FBCHEP",FBAAID<FBAAEDT D K FBAAID G GETINDT
  1. .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
  1. .W *7,!!?5,"*** Invoice Received Date cannot be before the ",!?8," Treatment TO Date ("_SHOWDOS_") !!!"
  1. I '$G(FBCNP) I FBAAID<FBAABDT D K FBAAID G GETINDT
  1. .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
  1. .W !!,$C(7),?5,"*** Invoice Received Date cannot be earlier than",!?8," Patient's Authorization Date ("_SHOWDOS_") !!!"
  1. 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
  1. 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
  1. Q
  1. ;
  1. DISPINV ;display invoice totals
  1. ;required inputs FBAADT (auth dt),DFN
  1. 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
  1. 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
  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
  1. Q