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

FBAACO5.m

Go to the documentation of this file.
  1. FBAACO5 ;AISC/GRR - ENTER PAYMENT CONTINUED ;9/5/2014
  1. ;;3.5;FEE BASIS;**73,79,124,154**;JAN 30, 1995;Build 12
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. FILEV(DFN,FBV) ;files vendor multiple in outpatient payment file
  1. ;required input variable DFN,FBV (vendor ien)
  1. K FBAAOUT
  1. I '$G(DFN)!('FBV) S FBAAOUT=1 Q
  1. S:'$D(^FBAAC(DFN,1,0)) ^FBAAC(DFN,1,0)="^162.01P^0^0"
  1. S DLAYGO=162,DIC="^FBAAC("_DFN_",1,",DIC(0)="QLNM",DA(1)=DFN,X="`"_FBV D ^DIC K DIC,DLAYGO I Y<0 W !,*7,"Cannot select this Vendor at this time" S FBAAOUT=1 Q
  1. Q
  1. GETSVDT(DFN,FBV,FBASSOC,FBA,X) ;set date of service multiple
  1. ;required input DFN,FBV (vendor ien)
  1. ;FBASSOC (auth ptr,0 if not known) not required or used (FB*3.5*154)
  1. ;required input FBA (1=ask dt,0=do not ask dt)
  1. ;optional/required input X (dt) - X req if FBA=0 (do not ask)
  1. ;output FBSDI=ien of svc date mult,FBAADT=svc date
  1. TRYAGAIN ;
  1. K FBAAOUT
  1. I '$G(DFN)!('$G(FBV))!('$D(FBA)) S FBAAOUT=1 Q
  1. I FBA=0,('$G(X)) S FBAAOUT=1 Q
  1. I $G(FBA) S DIC("A")="Date of Service: ",DIC(0)="AEQLM"
  1. I '$G(FBA) S DIC(0)="QLMN"
  1. I '$D(^FBAAC(DFN,1,FBV,1,0)) S ^FBAAC(DFN,1,FBV,1,0)="^162.02DA^0^0"
  1. S DLAYGO=162,DA(2)=DFN,DA(1)=FBV,DIC="^FBAAC("_DFN_",1,"_FBV_",1," D ^DIC K DLAYGO,DIC,DA I X=""!(X="^")!(Y<0) S FBAAOUT=1 Q
  1. ;if date of service input transform called skip checks
  1. I $D(HOLDY),HOLDY=$P(Y,"^",2) GOTO DONASK
  1. I $D(FBAAID),$P(Y,"^",2)>FBAAID D G TRYAGAIN
  1. .N SHODAT S SHODAT=$E(FBAAID,4,5)_"/"_$E(FBAAID,6,7)_"/"_$E(FBAAID,2,3)
  1. .W !!,*7,?5,"*** Date of Service cannot be later than",!?8," Invoice Received Date ("_SHODAT_") !!!",!
  1. I $D(FBAABDT),$D(FBAAEDT),($P(Y,"^",2)<FBAABDT!($P(Y,"^",2)>FBAAEDT)) D G TRYAGAIN
  1. .N PRIORLAT,AUTHDAT,SHODAT
  1. .S PRIORLAT=$S($P(Y,"^",2)<FBAABDT:"prior to ",1:"later than ")
  1. .S AUTHDAT=$S($P(Y,"^",2)<FBAABDT:FBAABDT,1:FBAAEDT)
  1. .S SHODAT=$E(AUTHDAT,4,5)_"/"_$E(AUTHDAT,6,7)_"/"_$E(AUTHDAT,2,3)
  1. .W !!,*7,?5,"*** Date of Service cannot be ",PRIORLAT,!?8," Authorization period ("_SHODAT_") !!!",!
  1. DONASK ;
  1. S FBSDI=+Y,FBAADT=$P(Y,"^",2)
  1. Q