source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBAAV1.m@ 1540

Last change on this file since 1540 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1FBAAV1 ;AISC/GRR-ELECTRONICALLY TRANSMIT FEE (VENDOR MRA'S) PART 2 ;07/18/06
2 ;;3.5;FEE BASIS;**10,36,39,98**;JAN 30, 1995;Build 54
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 S (ZMCNT,ZPCNT,FB("M"),FB("P"))=0
5 ;D STATION^FBAAUTL,HD^FBAAUTL Q:$D(FB("ERROR"))
6 S FBTXT=0
7 F J="O","P" I $D(^FBAA(161.25,"AE",J)) F K=0:0 S K=$O(^FBAA(161.25,"AE",J,K)) Q:K'>0 S FBTC=$G(^FBAA(161.25,K,0)),FBTC=$S(FBTC']"":"N",J="P":$P(FBTC,U,2),J="O":$P(FBTC,U,3),1:"N") S Y(0)=$G(^FBAAV(K,0)) I Y(0)]"" D
8 .S Y(1)=$G(^FBAAV(K,"ADEL")),Y(2)=$G(^FBAAV(K,"AMS")),Y(3)=$G(^FBAAV(K,1)) D GETGRP^FBAAUTL6(K,5)
9 .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01
10 .D GOT
11 D:+$G(FBOKTX) XMIT^FBAAV01 Q
12GOT S FBNAME=$P(Y(0),"^",1),FBNAME=$S(FBNAME[",":$E($P(FBNAME,",",2),1)_" "_$E($P(FBNAME,",",2),$F($P(FBNAME,",",2)," "))_$S($F($P(FBNAME,",",2)," "):" ",1:" ")_$P(FBNAME,",",1),1:FBNAME)
13 S FBNAME=$S($L(FBNAME)<30:FBNAME_$E(PAD,$L(FBNAME)+1,30),1:$E(FBNAME,1,30)),FBID=$P(Y(0),"^",2),FBID=FBID_$E(PAD,$L(FBID)+1,11),FBPART=$P(Y(0),"^",7),FBSN=FBSN_$E(" ",$L(FBSN)+1,6)
14 S FBSC=$S($P(Y(0),"^",8)]"":$P(Y(0),"^",8),1:" "),FBSC=$S(FBSC=" ":FBSC,$D(^FBAA(161.6,FBSC,0)):$P(^(0),"^",2),1:" "),FBTC=$S(FBTC]"":FBTC,1:"N"),OCDT=$S(Y(1)]"":$P(Y(1),"^",2),1:"")
15 S FBPC=$S($P(Y(0),"^",9)]"":$P(Y(0),"^",9),1:" "),FBPC=$S(FBPC=" ":FBPC,$D(^FBAA(161.81,FBPC,0)):$P(^(0),"^",2),1:" ")
16 S FBTC=$S(FBTC="N":"A",1:FBTC),FBAD=$P(Y(0),"^",3),FBAD=FBAD_$E(PAD,$L(FBAD)+1,30),FBAD1=$P(Y(0),"^",14),FBAD1=FBAD1_$E(PAD,$L(FBAD1)+1,30),FBCITY=$E($P(Y(0),"^",4),1,19),FBCITY=FBCITY_$E(PAD,$L(FBCITY)+1,19)
17 S FBSTCD=$P(Y(0),"^",5),FBSTATE=$S(FBSTCD']"":" ",$D(^DIC(5,FBSTCD,0)):$P(^(0),"^",2),1:" "),FBSTATE=$S($L(FBSTATE)'=2:" ",1:FBSTATE),FBZIP=$P(Y(0),"^",6),FBZIP=$TR(FBZIP,"-","")_$E("000000000",$L(FBZIP)+1,9)
18 S FBMRC=$P(Y(0),"^",18),FBMRC=$S(FBMRC]"":FBMRC,1:" "),FBCHAIN=$P(Y(0),"^",10),FBCHAIN=$E("0000",$L(FBCHAIN)+1,4)_FBCHAIN
19 S STCC=$P(Y(0),"^",13),FBCC="000" I STCC]"",FBSTCD]"" S FBCC=$S($D(^DIC(5,FBSTCD,1,STCC,0)):$P(^(0),"^",3),1:"000")
20 S FBCC=$E("000",$L(FBCC)+1,3)_FBCC,FBRT=$S(J="P":4,1:1),FBICN=$E(FBSN,1,3)_K,FBICN=$E("000000000000000",$L(FBICN)+1,15)_FBICN,FBTID=$P(Y(2),"^",6),FBTID=$S(FBTID]"":FBTID,1:"T"),FBFMST=$P(Y(2),"^",4),FBFMST=$S(FBFMST]"":FBFMST,1:"C")
21 S FBNPI=$$EN^FBNPILK(K)
22 ; pad FPDS data
23 S FBBT=$S($P(Y(3),U,10)]"":$P(Y(3),U,10),1:" ")_" "
24 F I=1:1:5 S FBSG(I)=$G(FBSG(I))_$E(" ",1,2-$L($G(FBSG(I))))
25 ;
26 D SETP:J="P",SETM:J="O",UPDT
27 ;S ^FBAA(161.25,"AD","T",K)="",$P(^FBAA(161.25,K,0),"^",3)="T" K ^FBAA(161.25,"AD",J,K)
28 D STORE Q
29SETM S ZMCNT=ZMCNT+1 D:FB("M")=0!(ZMCNT>100) BHEDM S FBSTR=FBRT_FBTC_FBSN_FBID_" "
30 I FBTC="D"!(FBTC="R") S FBSTR=FBSTR_"$" Q
31 S FBSTR=FBSTR_"1"_FBSC_FBPC_FBNAME_FBAD_FBAD1_FBCITY_FBSTATE_FBZIP_FBMRC_FBCC_"B"_FBTID_"Y"_FBFMST_FBICN_FBBT_FBSG(1)_FBSG(2)_FBSG(3)_FBSG(4)_FBSG(5)_FBNPI_"$"
32 Q
33SETP S ZPCNT=ZPCNT+1 D:FB("P")=0!(ZPCNT>100) BHEDP S FBSTR=FBRT_FBTC_FBSN_$E(FBID,1,9)_FBCHAIN
34 I FBTC="D"!(FBTC="R") S FBSTR=FBSTR_"$" Q
35 S FBSTR=FBSTR_"1"_FBNAME_FBAD_FBAD1_FBCITY_FBSTATE_FBZIP_FBMRC_FBCC_"B"_FBTID_"Y"_FBFMST_FBICN_FBBT_FBSG(1)_FBSG(2)_FBSG(3)_FBSG(4)_FBSG(5)_FBNPI_"$"
36 Q
37BHEDM S BTYPE="M" D GETB S FB("M")=1,FBSTR=FBHD_"C1"_$E(DT,4,7)_$E(DT,2,3)_FBSN_FBZBNM_"$" D STORE S ZMCNT=1 Q
38BHEDP S BTYPE="P" D GETB S FB("P")=1,FBSTR=FBHD_"C4"_$E(DT,4,7)_$E(DT,2,3)_FBSN_FBZBNP_"$" D STORE S ZPCNT=1 Q
39UPDT L +^FBAA(161.25,K) K ^FBAA(161.25,"AE",J,K)
40 ;I $D(^FBAA(161.25,"AE",$S(J="P":"O",1:"P"),K)) S $P(^FBAA(161.25,K,0),"^",3)="N" L -^FBAA(161.25,K) Q ;commented out since don't know why it is set
41 ;K:OCDT]"" ^FBAAV("AC",OCDT,K) S $P(^FBAAV(K,0),"^",15)=DT,^FBAAV("AC",DT,K)="" L -^FBAA(161.25,K)
42 S DA=K,(DIC,DIE)="^FBAA(161.25,",DR="4///^S X=DT" D ^DIE L -^FBAA(161.25,K)
43 S DIE="^FBAAV(",DA=K,DR="12///^S X=DT" D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAV(DA)
44 K DA,DIE,DR,FBLOCK Q
45GETB D GETNXB^FBAAUTL
46 I BTYPE="M" S FBZBNM=$E("00000",$L(FBBN)+1,5)_FBBN Q
47 I BTYPE="P" S FBZBNP=$E("00000",$L(FBBN)+1,5)_FBBN
48 Q
49STORE I TOTSTR+$L(FBSTR)>13900!(ZMCNT>100)!(ZPCNT>100) S TOTSTR=0 D XMIT^FBAAV01,NEWMSG^FBAAV01 S FBTMP=FBSTR D BHEDM:J="O",BHEDP:J="P" S FBSTR=FBTMP K FBTMP
50 S TOTSTR=TOTSTR+$L(FBSTR) D STORE^FBAAV01
51 Q
52KILL K FBATCH,FBCHB,J,K,L,M,N,FBAABN,FBAAON,FBAASN,FBAACP,FBAACD,FBAABT,FBAAAP,FBSTR,PAD,PAD1,FBPAYT,FBVID,FBPOV,FBTT,FBPATT,FBTD,FBSUSP,FBAP,FBEXMPT,FBFNI,FBFNY,^TMP($J)
53 K A,FBTYPE,DO,DI,DIC,DIE,DOD,DQ,ER,FBADD,FBAUTH,FBBD,FBBN,FBCHAIN,FBFDC,FBFLNAM,FBFR,FBLNAM,FBMST,FBRECT,FBRT,FBSEX,FBSTAT,FBSTCD,FBTC,FBTO,BTYPE,POS,POV,POW,STCC,STCD,T,TOTSTR,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,XMZ,ZMCNT,ZPCNT
54 K FBINVN,FBDIN,FBSSN,FBNAME,FBLNAME,FBFI,FBMI,XMDUZ,DA,DR,X,Y,FBPART,FBC,FBSN,FBID,FEEO,FBSC,FBPC,FBAD,FBCITY,FBSTATE,FBZIP,FBCC,FBZBN,FBZBNM,FBZBNP,FB,D,Z,Q,VAT,VATERR,VATNAME,FBSDI
55 K FBCTY,FBDX,FBFTD,FBPRC,FBPSA,FBST,OCDT,X1,X2,FB7078,FBBILL,FBCLAIM,FBCTY,FBDISP,FBDOB,FBFDT,FBJ,FBLOS,FBMED,FBPART1,FBSTABR,FBTDT,FBTTD,FBVEN,PAD,VAPA,FBSITE,FBK,FBNPI
56 K FB0,FBFEE,FBHD,FBI,FBLN,FBNVP,FBOKTX,FBTXT,FBVAR,FBXMFEE,FBXMNVP,FBXMZ,XMDUN,FBRESUB,FBAD1,FBFMST,FBICN,FBMRC,FBTID,FBPOP,FBCPT,FBHCFA,FBPD,FBPOS,FBVTOS,FBAC,FBCSN,FBRX,FBVFN
57 Q
Note: See TracBrowser for help on using the repository browser.