- FBAACO5 ;AISC/GRR - ENTER PAYMENT CONTINUED ;9/5/2014
- ;;3.5;FEE BASIS;**73,79,124,154**;JAN 30, 1995;Build 12
- ;;Per VA Directive 6402, this routine should not be modified.
- FILEV(DFN,FBV) ;files vendor multiple in outpatient payment file
- ;required input variable DFN,FBV (vendor ien)
- K FBAAOUT
- I '$G(DFN)!('FBV) S FBAAOUT=1 Q
- S:'$D(^FBAAC(DFN,1,0)) ^FBAAC(DFN,1,0)="^162.01P^0^0"
- 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
- Q
- GETSVDT(DFN,FBV,FBASSOC,FBA,X) ;set date of service multiple
- ;required input DFN,FBV (vendor ien)
- ;FBASSOC (auth ptr,0 if not known) not required or used (FB*3.5*154)
- ;required input FBA (1=ask dt,0=do not ask dt)
- ;optional/required input X (dt) - X req if FBA=0 (do not ask)
- ;output FBSDI=ien of svc date mult,FBAADT=svc date
- TRYAGAIN ;
- K FBAAOUT
- I '$G(DFN)!('$G(FBV))!('$D(FBA)) S FBAAOUT=1 Q
- I FBA=0,('$G(X)) S FBAAOUT=1 Q
- I $G(FBA) S DIC("A")="Date of Service: ",DIC(0)="AEQLM"
- I '$G(FBA) S DIC(0)="QLMN"
- I '$D(^FBAAC(DFN,1,FBV,1,0)) S ^FBAAC(DFN,1,FBV,1,0)="^162.02DA^0^0"
- 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
- ;if date of service input transform called skip checks
- I $D(HOLDY),HOLDY=$P(Y,"^",2) GOTO DONASK
- I $D(FBAAID),$P(Y,"^",2)>FBAAID D G TRYAGAIN
- .N SHODAT S SHODAT=$E(FBAAID,4,5)_"/"_$E(FBAAID,6,7)_"/"_$E(FBAAID,2,3)
- .W !!,*7,?5,"*** Date of Service cannot be later than",!?8," Invoice Received Date ("_SHODAT_") !!!",!
- I $D(FBAABDT),$D(FBAAEDT),($P(Y,"^",2)<FBAABDT!($P(Y,"^",2)>FBAAEDT)) D G TRYAGAIN
- .N PRIORLAT,AUTHDAT,SHODAT
- .S PRIORLAT=$S($P(Y,"^",2)<FBAABDT:"prior to ",1:"later than ")
- .S AUTHDAT=$S($P(Y,"^",2)<FBAABDT:FBAABDT,1:FBAAEDT)
- .S SHODAT=$E(AUTHDAT,4,5)_"/"_$E(AUTHDAT,6,7)_"/"_$E(AUTHDAT,2,3)
- .W !!,*7,?5,"*** Date of Service cannot be ",PRIORLAT,!?8," Authorization period ("_SHODAT_") !!!",!
- DONASK ;
- S FBSDI=+Y,FBAADT=$P(Y,"^",2)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAACO5 2068 printed Feb 18, 2025@23:21:39 Page 2
- FBAACO5 ;AISC/GRR - ENTER PAYMENT CONTINUED ;9/5/2014
- +1 ;;3.5;FEE BASIS;**73,79,124,154**;JAN 30, 1995;Build 12
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- FILEV(DFN,FBV) ;files vendor multiple in outpatient payment file
- +1 ;required input variable DFN,FBV (vendor ien)
- +2 KILL FBAAOUT
- +3 IF '$GET(DFN)!('FBV)
- SET FBAAOUT=1
- QUIT
- +4 if '$DATA(^FBAAC(DFN,1,0))
- SET ^FBAAC(DFN,1,0)="^162.01P^0^0"
- +5 SET DLAYGO=162
- SET DIC="^FBAAC("_DFN_",1,"
- SET DIC(0)="QLNM"
- SET DA(1)=DFN
- SET X="`"_FBV
- DO ^DIC
- KILL DIC,DLAYGO
- IF Y<0
- WRITE !,*7,"Cannot select this Vendor at this time"
- SET FBAAOUT=1
- QUIT
- +6 QUIT
- GETSVDT(DFN,FBV,FBASSOC,FBA,X) ;set date of service multiple
- +1 ;required input DFN,FBV (vendor ien)
- +2 ;FBASSOC (auth ptr,0 if not known) not required or used (FB*3.5*154)
- +3 ;required input FBA (1=ask dt,0=do not ask dt)
- +4 ;optional/required input X (dt) - X req if FBA=0 (do not ask)
- +5 ;output FBSDI=ien of svc date mult,FBAADT=svc date
- TRYAGAIN ;
- +1 KILL FBAAOUT
- +2 IF '$GET(DFN)!('$GET(FBV))!('$DATA(FBA))
- SET FBAAOUT=1
- QUIT
- +3 IF FBA=0
- IF ('$GET(X))
- SET FBAAOUT=1
- QUIT
- +4 IF $GET(FBA)
- SET DIC("A")="Date of Service: "
- SET DIC(0)="AEQLM"
- +5 IF '$GET(FBA)
- SET DIC(0)="QLMN"
- +6 IF '$DATA(^FBAAC(DFN,1,FBV,1,0))
- SET ^FBAAC(DFN,1,FBV,1,0)="^162.02DA^0^0"
- +7 SET DLAYGO=162
- SET DA(2)=DFN
- SET DA(1)=FBV
- SET DIC="^FBAAC("_DFN_",1,"_FBV_",1,"
- DO ^DIC
- KILL DLAYGO,DIC,DA
- IF X=""!(X="^")!(Y<0)
- SET FBAAOUT=1
- QUIT
- +8 ;if date of service input transform called skip checks
- +9 IF $DATA(HOLDY)
- IF HOLDY=$PIECE(Y,"^",2)
- GOTO DONASK
- +10 IF $DATA(FBAAID)
- IF $PIECE(Y,"^",2)>FBAAID
- Begin DoDot:1
- +11 NEW SHODAT
- SET SHODAT=$EXTRACT(FBAAID,4,5)_"/"_$EXTRACT(FBAAID,6,7)_"/"_$EXTRACT(FBAAID,2,3)
- +12 WRITE !!,*7,?5,"*** Date of Service cannot be later than",!?8," Invoice Received Date ("_SHODAT_") !!!",!
- End DoDot:1
- GOTO TRYAGAIN
- +13 IF $DATA(FBAABDT)
- IF $DATA(FBAAEDT)
- IF ($PIECE(Y,"^",2)<FBAABDT!($PIECE(Y,"^",2)>FBAAEDT))
- Begin DoDot:1
- +14 NEW PRIORLAT,AUTHDAT,SHODAT
- +15 SET PRIORLAT=$SELECT($PIECE(Y,"^",2)<FBAABDT:"prior to ",1:"later than ")
- +16 SET AUTHDAT=$SELECT($PIECE(Y,"^",2)<FBAABDT:FBAABDT,1:FBAAEDT)
- +17 SET SHODAT=$EXTRACT(AUTHDAT,4,5)_"/"_$EXTRACT(AUTHDAT,6,7)_"/"_$EXTRACT(AUTHDAT,2,3)
- +18 WRITE !!,*7,?5,"*** Date of Service cannot be ",PRIORLAT,!?8," Authorization period ("_SHODAT_") !!!",!
- End DoDot:1
- GOTO TRYAGAIN
- DONASK ;
- +1 SET FBSDI=+Y
- SET FBAADT=$PIECE(Y,"^",2)
- +2 QUIT