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

FBUTL7.m

Go to the documentation of this file.
  1. FBUTL7 ;WIOFO/SAB - FEE BASIS UTILITY FOR CONTRACT ;9/24/2009
  1. ;;3.5;FEE BASIS;**108**;JAN 30, 1995;Build 115
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. EDCNTRA(FBDFN,FBAUTH) ; determine if CONTRACT can be edited
  1. ; Input
  1. ; FBDFN = IEN of patient in file 161 (and file 2)
  1. ; FBAUTH = IEN of authorization in sub-file 161.01
  1. ; Returns a string value flag^message where
  1. ; flag = 1 if contract field in sub-file 161.01 can be edited
  1. ; = 0 if it cannot be edited
  1. ; message = optional text that if present should be displayed
  1. ;
  1. N FBPAY,FBRET,FBY
  1. S FBRET=0
  1. ;
  1. ; check inputs
  1. I '$G(FBDFN) G EDCNTRAX ; missing patient IEN
  1. I '$G(FBAUTH) G EDCNTRAX ; missing authorization IEN
  1. S FBY=$G(^FBAAA(FBDFN,1,FBAUTH,0))
  1. I FBY']"" G EDCNTRAX ; no authorization data
  1. ;
  1. ; check if contract is applicable to the authorization type
  1. ; must be outpatient or civil hospital fee program
  1. I "^2^6^"'[("^"_$P(FBY,"^",3)_"^") G EDCNTRAX
  1. ; must not be an unauthorized claim
  1. I $P(FBY,"^",9)["FB583" G EDCNTRAX
  1. ;
  1. ; check if any existing payments on file
  1. S FBPAY=0
  1. I $P(FBY,"^",3)=2 S FBPAY=$$OUTPA(FBDFN,FBAUTH) ; check outpatient
  1. I $P(FBY,"^",9)["FB7078" S FBPAY=$$PAY^FBUCUTL(+$P(FBY,"^",9),$P($P(FBY,"^",9),";",2)) ; check using the associated 7078
  1. I FBPAY=1 D G EDCNTRAX
  1. . N FBX
  1. . S FBX="Can't change contract ("
  1. . S FBX=FBX_$S($P(FBY,"^",22):$$GET1^DIQ(161.43,$P(FBY,"^",22)_",",.01),1:"")
  1. . S FBX=FBX_") because payments exist."
  1. . S $P(FBRET,"^",2)=FBX
  1. ;
  1. ;passed all checks - OK to edit field
  1. S FBRET=1
  1. ;
  1. EDCNTRAX ; EDCNTRA exit
  1. Q FBRET
  1. ;
  1. OUTPA(FBDFN,FBAUTH) ; Outpatient Authorization Has Payments?
  1. ; input
  1. ; patient IEN
  1. ; authorization IEN
  1. ; output
  1. ; FBPAY = 1 or 0, =1 if any payments on file for the authorization
  1. N FBPAY,FBVEN
  1. S FBPAY=0
  1. ;
  1. S FBVEN=+$P($G(^FBAAA(FBDFN,1,FBAUTH,0)),"^",4) ; vendor on auth
  1. I FBVEN D OUTPAV
  1. E F S FBVEN=$O(^FBAAC(FBDFN,1,FBVEN)) Q:'FBVEN D OUTPAV Q:FBPAY
  1. Q FBPAY
  1. ;
  1. OUTPAV ;
  1. N FBDTI
  1. S FBDTI=0
  1. F S FBDTI=$O(^FBAAC(FBDFN,1,FBVEN,1,FBDTI)) Q:'FBDTI D Q:FBPAY
  1. . Q:$P($G(^FBAAC(FBDFN,1,FBVEN,1,FBDTI,0)),"^",4)'=FBAUTH
  1. . Q:'$O(^FBAAC(FBDFN,1,FBVEN,1,FBDTI,1,0))
  1. . S FBPAY=1
  1. Q
  1. CNTRPTR(FBDA) ; Contract pointed-to
  1. ; input FBDA = ien of contract in file 161.43
  1. ; result 0 or 1, =1 if contract is pointed-to
  1. N FBRET
  1. S FBRET=0
  1. ; check fee basis patient (authorizations)
  1. I $D(^FBAAA("ACN",FBDA)) S FBRET=1
  1. ; check fee basis payment
  1. I 'FBRET,$D(^FBAAC("ACN",FBDA)) S FBRET=1
  1. ; check fee basis invoice
  1. I 'FBRET,$D(^FBAAI("ACN",FBDA)) S FBRET=1
  1. Q FBRET
  1. ;
  1. ;
  1. UCFA(FBVENI,FBVENA,FBCNTRA) ; Use Contract From Authorization
  1. ; input
  1. ; FBVENI = vendor IEN for invoice/payment
  1. ; FBVENA = vendor IEN for associated authorization
  1. ; FBCNTRA = contract IEN for associated authorization
  1. ; returns 0 or 1
  1. ; = 1 if invoice must have same contract as associated authorization
  1. N FBAR,FBI,FBRET
  1. S FBRET=0
  1. ; if authorization has a contract
  1. I FBCNTRA D
  1. . ; does the vendor being paid match the vendor on the authorizaton
  1. . I FBVENI=FBVENA S FBRET=1
  1. . Q:FBRET=1
  1. . ; build a list of linked vendors for the vendor being paid
  1. . I FBVENI D ; build list of linked vendors in FBAR(
  1. . . N DA,FBA,FBDA,FBJ
  1. . . S DA=FBVENI
  1. . . S FBAR(DA)=""
  1. . . D ^FBAACO4
  1. . ; loop thru linked vendors to see if any match
  1. . S FBI=0 F S FBI=$O(FBAR(FBI)) Q:'FBI D Q:FBRET
  1. . . I FBI=FBVENA S FBRET=1
  1. Q FBRET
  1. ;
  1. CNTRSCR(FBDFN,FBAUT,FBCNTRA) ; contract screen
  1. ; called by 161.01 CONTRACT field screen
  1. ; input
  1. ; FEE BASIS PATIENT ien
  1. ; AUTHORIZATION ien
  1. ; CONTRACT ien
  1. ; return 0 or 1, =1 if contract passes screen
  1. N FBRET,FBVEN
  1. S FBRET=1
  1. ; check status of contract
  1. I $G(DIUTIL)'="VERIFY FIELDS",$P($G(^FBAA(161.43,FBCNTRA,0)),"^",2)'="A" S FBRET=0
  1. ; if authorization iens provided, then screen on vendor
  1. I FBRET,$G(FBDFN),$G(FBAUT) D
  1. . S FBVEN=$P($G(^FBAAA(FBDFN,1,FBAUT,0)),"^",4)
  1. . I FBVEN'>0 S FBRET=0 Q
  1. . S FBRET=$$VCNTR(FBVEN,FBCNTRA)
  1. Q FBRET
  1. ;
  1. VCNTR(FBV,FBC) ; vendor applicable for the contract
  1. ; input
  1. ; FBV = IEN of vendor (FEE BASIS VENDOR file)
  1. ; FBC = IEN on contract (FEE BASIS CONTRACT file)
  1. ; returns 0 or 1
  1. ; =1 if vendor is applicable for the contract
  1. N FBAR,FBI,FBRET
  1. S FBRET=0
  1. I $G(FBV),$G(FBC) D
  1. . ; is vendor applicable?
  1. . I $D(^FBAA(161.43,"AV",FBV,FBC)) S FBRET=1
  1. . Q:FBRET=1
  1. . ; try linked vendors (if any)
  1. . D ; build list of linked vendors in FBAR(
  1. . . N DA,FBA,FBDA,FBJ
  1. . . S DA=FBV
  1. . . S FBAR(DA)=""
  1. . . D ^FBAACO4
  1. . ; loop thru linked vendors to see if any are applicable
  1. . S FBI=0 F S FBI=$O(FBAR(FBI)) Q:'FBI D Q:FBRET
  1. . . I $D(^FBAA(161.43,"AV",FBI,FBC)) S FBRET=1
  1. Q FBRET
  1. ;
  1. ;FBUTL7