source: FOIAVistA/tag/r/FEE_BASIS-FB/FBAAV1.m@ 628

FBAAV1 ;AISC/GRR-ELECTRONICALLY TRANSMIT FEE (VENDOR MRA'S) PART 2 ;07/18/06
 ;;3.5;FEE BASIS;**10,36,39,98**;JAN 30, 1995;Build 54
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 S (ZMCNT,ZPCNT,FB("M"),FB("P"))=0
 ;D STATION^FBAAUTL,HD^FBAAUTL Q:$D(FB("ERROR"))
 S FBTXT=0
 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
 .S Y(1)=$G(^FBAAV(K,"ADEL")),Y(2)=$G(^FBAAV(K,"AMS")),Y(3)=$G(^FBAAV(K,1)) D GETGRP^FBAAUTL6(K,5)
 .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01
 .D GOT
 D:+$G(FBOKTX) XMIT^FBAAV01 Q
GOT 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)
 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)
 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:"")
 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:"  ")
 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)
 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)
 S FBMRC=$P(Y(0),"^",18),FBMRC=$S(FBMRC]"":FBMRC,1:"  "),FBCHAIN=$P(Y(0),"^",10),FBCHAIN=$E("0000",$L(FBCHAIN)+1,4)_FBCHAIN
 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")
 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")
 S FBNPI=$$EN^FBNPILK(K)
 ; pad FPDS data
 S FBBT=$S($P(Y(3),U,10)]"":$P(Y(3),U,10),1:" ")_" "
 F I=1:1:5 S FBSG(I)=$G(FBSG(I))_$E("  ",1,2-$L($G(FBSG(I))))
 ;
 D SETP:J="P",SETM:J="O",UPDT
 ;S ^FBAA(161.25,"AD","T",K)="",$P(^FBAA(161.25,K,0),"^",3)="T" K ^FBAA(161.25,"AD",J,K)
 D STORE Q
SETM S ZMCNT=ZMCNT+1 D:FB("M")=0!(ZMCNT>100) BHEDM S FBSTR=FBRT_FBTC_FBSN_FBID_"  "
 I FBTC="D"!(FBTC="R") S FBSTR=FBSTR_"$" Q
 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_"$"
 Q
SETP S ZPCNT=ZPCNT+1 D:FB("P")=0!(ZPCNT>100) BHEDP S FBSTR=FBRT_FBTC_FBSN_$E(FBID,1,9)_FBCHAIN
 I FBTC="D"!(FBTC="R") S FBSTR=FBSTR_"$" Q
 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_"$"
 Q
BHEDM 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
BHEDP 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
UPDT L +^FBAA(161.25,K) K ^FBAA(161.25,"AE",J,K)
 ;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
 ;K:OCDT]"" ^FBAAV("AC",OCDT,K) S $P(^FBAAV(K,0),"^",15)=DT,^FBAAV("AC",DT,K)="" L -^FBAA(161.25,K)
 S DA=K,(DIC,DIE)="^FBAA(161.25,",DR="4///^S X=DT" D ^DIE L -^FBAA(161.25,K)
 S DIE="^FBAAV(",DA=K,DR="12///^S X=DT" D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAV(DA)
 K DA,DIE,DR,FBLOCK Q
GETB D GETNXB^FBAAUTL
 I BTYPE="M" S FBZBNM=$E("00000",$L(FBBN)+1,5)_FBBN Q
 I BTYPE="P" S FBZBNP=$E("00000",$L(FBBN)+1,5)_FBBN
 Q
STORE 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
 S TOTSTR=TOTSTR+$L(FBSTR) D STORE^FBAAV01
 Q
KILL 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)
 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
 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
 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
 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
 Q