- 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 Feb 18, 2025@23:21:27 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