FBAACCB0 ;AISC/GRR-CLERK CLOSE BATCH CONTINUED ;5/12/1999
;;3.5;FEE BASIS;**5,4,116**;JAN 30, 1995;Build 30
;;Per VHA Directive 10-93-142, this routine should not be modified.
LISTT S Q="",$P(Q,"=",80)="="
S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
ENT S FBAAOUT=0
D HEDP F J=0:0 S J=$O(^FBAAC("AD",B,J)) Q:J'>0!($G(FBAAOUT)) F K=0:0 S K=$O(^FBAAC("AD",B,J,K)) Q:K'>0!($G(FBAAOUT)) I $D(^FBAAC(J,3,K,0)) S Y(0)=^(0) D SETT
K FBCAN,FBCANDT,FBCANR,FBCK,FBCKDT,FBCKINT,FBDIS
Q
HEDP W ?23,"'+' Represents Cancellation Activity",!?4,"Patient Name",?36,"SSN",?49,"Date",?56,"Travel Amount",!,Q,! Q
WRTT I $Y+7>IOSL D ASKH:$E(IOST,1,2)["C-" Q:FBAAOUT W @IOF D HEDP
I A2'=".00" W !,$S($D(QQ):QQ_") ",1:""),$S($G(FBCAN)]"":"+",1:""),?4,N,?32,$E(S,1,3),"-",$E(S,4,5),"-",$E(S,6,10),?47,$E(D,4,5),"/",$E(D,6,7),"/",$E(D,2,3),?59,"$ ",$J(A2,4,2) D PMNT^FBAACCB2 Q
SETT S N=$S($D(^DPT(J,0)):$P(^(0),"^",1),1:""),S=$S(N]"":$P(^(0),"^",9),1:""),A2=$P(Y(0),"^",3),D=$P(Y(0),"^",1) D FBCKT(J,K),WRTT Q
Q
SETV S K=$S($D(^FBAA(162.1,A,0)):$P(^(0),"^",4),1:"")
ENV S (V,VID)="" I K]"" S V=$S($D(^FBAAV(K,0)):$P(^(0),"^",1),1:""),VID=$S(V]"":$P(^(0),"^",2),1:"")
Q
ASKH S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q
GMORE F K=0:0 S K=$O(^FBAAC("AJ",B,FBIN,J,K)) Q:K'>0!(FBAAOUT) F L=0:0 S L=$O(^FBAAC("AJ",B,FBIN,J,K,L)) Q:L'>0!(FBAAOUT) F M=0:0 S M=$O(^FBAAC("AJ",B,FBIN,J,K,L,M)) Q:M'>0!(FBAAOUT) D SET^FBAACCB
Q
INTOT ;; HIPAA 5010 - count line items that have 0.00 amount paid
;I FBINOLD'=FBIN&(FBINTOT>0) W !!,?15,"Invoice #: "_FBINOLD_" Totals: $ "_$J(FBINTOT,1,2) S FBINTOT=0 Q
I +FBINOLD'=0,FBINOLD'=FBIN&(FBINTOT]"") W !!,?15,"Invoice #: "_FBINOLD_" Totals: $ "_$J(FBINTOT,1,2) S FBINTOT=0 Q
Q
Q K C,B,J,K,L,M,T,X,Y,FZ,A,A1,A2,B2,CPTDESC,DO,DA,DIC,DIRUT,DL,DR,DRX,DX,FBAACPT,FBAAOUT,FBIN,FBINOLD,FBINTOT,FBVP,FBTYPE,FBPV,N,Q,S,V,VID,ZIS,XY,ZS,FBMODLE,FBVCHDT
K FBAC,FBAP,FBDX,FBFD,FBI,FBK,FBLISTC,FBPDT,FBSC,FBTD Q
FBCKT(J,K) ;set travel check variables
;j,k required variables j=DA(1),k=DA
I 'J!('K) S (FBCAN,FBCK,FBCANDT,FBCANR,FBDIS,FBCKDT,FBCKINT)="" Q
S FBCKIN=$G(^FBAAC(J,3,K,0))
S FBCAN=$P(FBCKIN,"^",10),FBCK=$P(FBCKIN,"^",7),FBCANDT=$P(FBCKIN,"^",8),FBCANR=$P(FBCKIN,"^",9),FBDIS=$P(FBCKIN,"^",11),FBCKDT=$P(FBCKIN,"^",6),FBCKINT=$P(FBCKIN,"^",12)
K FBCKIN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAACCB0 2317 printed Dec 13, 2024@01:55:01 Page 2
FBAACCB0 ;AISC/GRR-CLERK CLOSE BATCH CONTINUED ;5/12/1999
+1 ;;3.5;FEE BASIS;**5,4,116**;JAN 30, 1995;Build 30
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
LISTT SET Q=""
SET $PIECE(Q,"=",80)="="
+1 SET IOP=$SELECT($DATA(ION):ION,1:"HOME")
DO ^%ZIS
KILL IOP
ENT SET FBAAOUT=0
+1 DO HEDP
FOR J=0:0
SET J=$ORDER(^FBAAC("AD",B,J))
if J'>0!($GET(FBAAOUT))
QUIT
FOR K=0:0
SET K=$ORDER(^FBAAC("AD",B,J,K))
if K'>0!($GET(FBAAOUT))
QUIT
IF $DATA(^FBAAC(J,3,K,0))
SET Y(0)=^(0)
DO SETT
+2 KILL FBCAN,FBCANDT,FBCANR,FBCK,FBCKDT,FBCKINT,FBDIS
+3 QUIT
HEDP WRITE ?23,"'+' Represents Cancellation Activity",!?4,"Patient Name",?36,"SSN",?49,"Date",?56,"Travel Amount",!,Q,!
QUIT
WRTT IF $Y+7>IOSL
if $EXTRACT(IOST,1,2)["C-"
DO ASKH
if FBAAOUT
QUIT
WRITE @IOF
DO HEDP
+1 IF A2'=".00"
WRITE !,$SELECT($DATA(QQ):QQ_") ",1:""),$SELECT($GET(FBCAN)]"":"+",1:""),?4,N,?32,$EXTRACT(S,1,3),"-",$EXTRACT(S,4,5),"-",$EXTRACT(S,6,10),?47,$EXTRACT(D,4,5),"/",$EXTRACT(D,6,7),"/",$EXTRACT(D,2,3),?59,"$ ",$JUSTIFY(A2,4,2)
DO PMNT^FBAACCB2
QUIT
SETT SET N=$SELECT($DATA(^DPT(J,0)):$PIECE(^(0),"^",1),1:"")
SET S=$SELECT(N]"":$PIECE(^(0),"^",9),1:"")
SET A2=$PIECE(Y(0),"^",3)
SET D=$PIECE(Y(0),"^",1)
DO FBCKT(J,K)
DO WRTT
QUIT
+1 QUIT
SETV SET K=$SELECT($DATA(^FBAA(162.1,A,0)):$PIECE(^(0),"^",4),1:"")
ENV SET (V,VID)=""
IF K]""
SET V=$SELECT($DATA(^FBAAV(K,0)):$PIECE(^(0),"^",1),1:"")
SET VID=$SELECT(V]"":$PIECE(^(0),"^",2),1:"")
+1 QUIT
ASKH SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET FBAAOUT=1
QUIT
GMORE FOR K=0:0
SET K=$ORDER(^FBAAC("AJ",B,FBIN,J,K))
if K'>0!(FBAAOUT)
QUIT
FOR L=0:0
SET L=$ORDER(^FBAAC("AJ",B,FBIN,J,K,L))
if L'>0!(FBAAOUT)
QUIT
FOR M=0:0
SET M=$ORDER(^FBAAC("AJ",B,FBIN,J,K,L,M))
if M'>0!(FBAAOUT)
QUIT
DO SET^FBAACCB
+1 QUIT
INTOT ;; HIPAA 5010 - count line items that have 0.00 amount paid
+1 ;I FBINOLD'=FBIN&(FBINTOT>0) W !!,?15,"Invoice #: "_FBINOLD_" Totals: $ "_$J(FBINTOT,1,2) S FBINTOT=0 Q
+2 IF +FBINOLD'=0
IF FBINOLD'=FBIN&(FBINTOT]"")
WRITE !!,?15,"Invoice #: "_FBINOLD_" Totals: $ "_$JUSTIFY(FBINTOT,1,2)
SET FBINTOT=0
QUIT
+3 QUIT
Q KILL C,B,J,K,L,M,T,X,Y,FZ,A,A1,A2,B2,CPTDESC,DO,DA,DIC,DIRUT,DL,DR,DRX,DX,FBAACPT,FBAAOUT,FBIN,FBINOLD,FBINTOT,FBVP,FBTYPE,FBPV,N,Q,S,V,VID,ZIS,XY,ZS,FBMODLE,FBVCHDT
+1 KILL FBAC,FBAP,FBDX,FBFD,FBI,FBK,FBLISTC,FBPDT,FBSC,FBTD
QUIT
FBCKT(J,K) ;set travel check variables
+1 ;j,k required variables j=DA(1),k=DA
+2 IF 'J!('K)
SET (FBCAN,FBCK,FBCANDT,FBCANR,FBDIS,FBCKDT,FBCKINT)=""
QUIT
+3 SET FBCKIN=$GET(^FBAAC(J,3,K,0))
+4 SET FBCAN=$PIECE(FBCKIN,"^",10)
SET FBCK=$PIECE(FBCKIN,"^",7)
SET FBCANDT=$PIECE(FBCKIN,"^",8)
SET FBCANR=$PIECE(FBCKIN,"^",9)
SET FBDIS=$PIECE(FBCKIN,"^",11)
SET FBCKDT=$PIECE(FBCKIN,"^",6)
SET FBCKINT=$PIECE(FBCKIN,"^",12)
+5 KILL FBCKIN
QUIT
