31 lines
2.0 KiB
Mathematica
31 lines
2.0 KiB
Mathematica
FBAACCB0 ;AISC/GRR-CLERK CLOSE BATCH CONTINUED ;5/12/1999
|
|
;;3.5;FEE BASIS;**5,4**;JAN 30, 1995
|
|
;;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 I FBINOLD'=FBIN&(FBINTOT>0) 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
|