source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAV0.m@ 1495

FBAAV0 ;AISC/GRR-ELECTRONICALLY TRANSMIT FEE DATA ;11 Apr 2006  2:51 PM
 ;;3.5;FEE BASIS;**3,4,55,89,98**;JAN 30, 1995;Build 54
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 K ^TMP($J,"FBAABATCH"),^TMP($J,"FBVADAT") D DT^DICRW
 I '$D(^FBAA(161.7,"AC","S")),'$D(^FBAA(161.7,"AC","R")),'$D(^FBAA(161.25,"AE")),$S('$D(^FBAA(161.26,"AC","P")):1,$O(^FBAA(161.26,"AC","P",0))'>0:1,1:0) W !,*7,"There are no transactions requiring transmission",*7 Q
 W !!,"This option will transmit all Batches and MRA's ready to be transmitted",!,"to Austin"
RD W !! S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="No" D ^DIR K DIR G END:'Y
 L +^FBAA(161.7,"AC"):0 G:'$T LOCK^FBAAUTL1
 W !!,"The following Batches will be transmitted: " F FBSTAT="S","R" F J=0:0 S J=$O(^FBAA(161.7,"AC",FBSTAT,J)) Q:J'>0  S FBATCH=$G(^FBAA(161.7,J,0)) D
 .Q:'+FBATCH
 .I (FBSTAT="S"&($P(FBATCH,U,15)="Y"))!(+$P(FBATCH,U,9)) S ^TMP($J,"FBAABATCH",J)="" W !,+FBATCH
RTRAN ;Entry from Re-transmit MRA routine
 D ADDRESS^FBAAV01 G END:VATERR K VAT
 D WAIT^DICD,STATION^FBAAUTL,HD^FBAAUTL I $D(FB("ERROR")) G END
 S TOTSTR=0,$P(PAD," ",200)=" "
 D ^FBAAV1:$D(^FBAA(161.25,"AE"))
 D ^FBAAV4:$D(^FBAA(161.26,"AC","P"))
 F J=0:0 S J=$O(^TMP($J,"FBAABATCH",J)) Q:J'>0  I $D(^FBAA(161.7,J,0)) S Y(0)=^(0) D SET1,DET:FBAABT="B3",DETP^FBAAV2:FBAABT="B5",DETT^FBAAV3:FBAABT="B2",^FBAAV5:FBAABT="B9"
END L -^FBAA(161.7,"AC") D KILL^FBAAV1 Q
SET1 ; build the payment batch header string (used by all four formats)
 S FBAABN=$P(Y(0),"^",1),FBAABN=$E("00000",$L(FBAABN)+1,5)_FBAABN
 S FBAAON=$E($P(Y(0),"^",2),3,6)
 S FBAACD=$$AUSDT^FBAAV3(DT)
 S FBAACP=$E($P(Y(0),"^",2),1,2)
 S FBAABT=$P(Y(0),"^",3)
 S FBAAAP=$$AUSAMT^FBAAV3($P(Y(0),"^",9),10)
 S FBSTAT=$P(^FBAA(161.7,J,"ST"),"^")
 S FBCHB=$P(Y(0),"^",15)
 S FBEXMPT=$P(Y(0),"^",18)
 S X=$$SUB^FBAAUTL5(+$P(Y(0),U,8)_"-"_$P(Y(0),U,2))
 S FBAASN=$$LJ^XLFSTR($S(X]"":X,1:FBAASN),6," ")
 I FBSTAT="R"!(FBSTAT="S"&(FBCHB'["Y"))!(FBSTAT="S"&($G(FBEXMPT)="Y")) S FBSTR=FBHD_$S(FBAABT="B2":"BT",1:FBAABT)_FBAACD_FBAASN_FBAABN_"  "_FBAAAP_FBAACP_" $"
 Q
DET ;entry point to process B3 (outpatient/ancillary) batch
 ; input (partial list)
 ;   J      - Batch IEN in file 161.7
 ;   FBAAON - last 4 of obligation number
 ;   FBAASN - station number (formatted)
 S FBTXT=0
 D CKB3V^FBAAV01 I $G(FBERR) K FBERR Q
 F K=0:0 S K=$O(^FBAAC("AC",J,K)) Q:K'>0  F L=0:0 S L=$O(^FBAAC("AC",J,K,L)) Q:L'>0  F M=0:0 S M=$O(^FBAAC("AC",J,K,L,M)) Q:M'>0  F N=0:0 S N=$O(^FBAAC("AC",J,K,L,M,N)) Q:N'>0  S Y(0)=$G(^FBAAC(K,1,L,1,M,1,N,0)) I Y(0)]"",+$P(Y(0),U,3) D
 .N FBDTSR1,FBPICN
 .S FBDTSR1=+$G(^FBAAC(K,1,L,1,M,0))
 .S FBPICN=K_U_L_U_M_U_N
 .S FBY=$G(^FBAAC(K,1,L,1,M,1,N,2))
 .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD
 .D GOT
 ;
 D:FBTXT XMIT^FBAAV01
 Q
 ;
GOT ; process a B3 line item
 ;
 N DFN,FBADJ,FBADJA1,FBADJA2,FBADJR1,FBADJR2,FBADMIT,FBAUTHF,FBIENS
 N FBMOD1,FBMOD2,FBMOD3,FBMOD4,FBPNAMX,FBUNITS,FBX,FBNPI
 ;
 S FBIENS=N_","_M_","_L_","_K_","
 ;
 ; get CPT modifiers
 D
 . N FBMODA,FBMODL
 . D MODDATA^FBAAUTL4(K,L,M,N)
 . S FBMODL=$$MODL^FBAAUTL4("FBMODA","E")
 . S FBMOD1=$$RJ^XLFSTR($P(FBMODL,",",1),5," ")
 . S FBMOD2=$$RJ^XLFSTR($P(FBMODL,",",2),5," ")
 . S FBMOD3=$$RJ^XLFSTR($P(FBMODL,",",3),5," ")
 . S FBMOD4=$$RJ^XLFSTR($P(FBMODL,",",4),5," ")
 ;
 S FBPAYT=$P(Y(0),"^",20),FBPAYT=$S(FBPAYT]"":FBPAYT,1:"V")
 ;
 S FBVID=$P($G(^FBAAV(L,0)),U,2)
 S FBVID=FBVID_$E(PAD,$L(FBVID)+1,11)
 S:FBPAYT="R" FBVID=$E(PAD,1,11)
 S FBNPI=$$EN^FBNPILK(L)  ;SET THE NPI TO BE PASSED TO FBAAV01,FBAAV2,FBAAV5
 ;
 D POV^FBAAUTL2
 S POV=$S(POV']"":"",POV="A":6,POV="B":7,POV="C":8,POV="D":9,POV="E":10,1:POV)
 S POV=$S(POV']"":99,$D(^FBAA(161.82,POV,0)):$P(^(0),"^",3),1:99)
 S FBPOV=POV
 S FBTT=$S(FBTT]"":FBTT,1:1)
 S FBCPT=$$CPT^FBAAUTL4($P(Y(0),"^")),FBCPT=$S($L(FBCPT)=5:FBCPT,1:"     ")
 S FBPSA=$$PSA^FBAAV5(+$P(Y(0),U,12),+FBAASN) I $L(+FBPSA)'=3 S FBPSA=999
 S FBPATT=$P(Y(0),"^",17),FBPATT=$S(FBPATT]"":FBPATT,1:10)
 S FBTD=$$AUSDT^FBAAV3(FBDTSR1) ; formatted treatment date
 S FBSUSP=$P(Y(0),"^",5),FBSUSP=$S(FBSUSP]"":FBSUSP,1:" ")
 S FBSUSP=$S(FBSUSP=" ":" ",$D(^FBAA(161.27,+FBSUSP,0)):$P(^(0),"^"),1:" ")
 S FBAP=$$AUSAMT^FBAAV3($P(Y(0),"^",3),8) ; amount paid
 S FBPOS=+$P(Y(0),"^",25),FBPOS=$S(FBPOS:$P(^IBE(353.1,FBPOS,0),"^"),1:"  ")
 S FBHCFA=+$P(Y(0),"^",26),FBHCFA=$S(FBHCFA:$P(^IBE(353.2,FBHCFA,0),"^"),1:""),FBHCFA=$E(PAD,$L(FBHCFA)+1,2)_FBHCFA
 S FBVTOS=+$P(Y(0),"^",24),FBVTOS=$S(FBVTOS:$P(^FBAA(163.85,FBVTOS,0),"^",2),1:"  ")
 S FBPD=+$P(Y(0),"^",23),FBPD=$S(FBPD:$$ICD9^FBCSV1(FBPD,$G(FBDTSR1)),1:""),FBPD=$E(PAD,$L(FBPD)+1,7)_FBPD
 S FBINVN=$P(Y(0),"^",16)
 S FBINVN=$E("000000000",$L(FBINVN)+1,9)_FBINVN
 S FBAUTHF=$S($P(Y(0),U,13)["FB583":"U",1:"A") ; auth/unauth flag
 S FBDIN=$$AUSDT^FBAAV3($P(Y(0),"^",15)) ; invoice date rec'd
 S FBADMIT=$$AUSDT^FBAAV3($$B3ADMIT(FBIENS)) ; formatted admission date
 ;
 S VAPA("P")=""
 S DFN=K
 ; Note - before this point Y(0) was the 0 node of subfile #162.03
 ;      - after this point Y(0) will be the 0 node of file #2
 S Y(0)=$G(^DPT(+K,0)) Q:Y(0)']""
 D PAT^FBAAUTL2
 ; obtain date of birth, must follow call to PAT^FBAAUTL2 to overwrite 
 ; the value returned from it
 S FBDOB=$$AUSDT^FBAAV3($P(Y(0),"^",3)) ; date of birth
 D ADD^VADPT
 S FBPNAMX=$$HL7NAME^FBAAV4(DFN) ; patient name
 S FBUNITS=$P(FBY,U,14)
 S:FBUNITS<1 FBUNITS=1
 S FBUNITS=$$RJ^XLFSTR(FBUNITS,5,0) ; volume indicator (units paid)
 ;
 ; get and format adjustment reason codes and amounts (if any)
 D LOADADJ^FBAAFA(FBIENS,.FBADJ)
 S FBX=$$ADJL^FBUTL2(.FBADJ)
 S FBADJR1=$$RJ^XLFSTR($P(FBX,U,1),5," ")
 S FBADJA1=$$AUSAMT^FBAAV3($P(FBX,U,3),9,1)
 S FBADJR2=$$RJ^XLFSTR($P(FBX,U,4),5," ")
 S FBADJA2=$$AUSAMT^FBAAV3($P(FBX,U,6),9,1)
 K FBADJ,FBX
 ;
 S FBST=$S($P(VAPA(5),"^")="":"  ",$D(^DIC(5,$P(VAPA(5),"^"),0)):$P(^(0),"^",2),1:"  ")
 S:$L(FBST)'=2 FBST=$E(PAD,$L(FBST)+1,2)_FBST
 S FBCTY=$S($P(VAPA(7),"^",1)="":"   ",FBST="  ":"   ",$D(^DIC(5,$P(VAPA(5),"^"),1,$P(VAPA(7),"^"),0)):$P(^(0),"^",3),1:"   ")
 I $L(FBCTY)'=3 S FBCTY=$E("000",$L(FBCTY)+1,3)_FBCTY
 S FBZIP=$S('+$G(VAPA(11)):VAPA(6),+VAPA(11):$P(VAPA(11),U),1:VAPA(6)),FBZIP=$TR(FBZIP,"-","")_$E("000000000",$L(FBZIP)+1,9)
 D STRING^FBAAV01
 Q
 ;
UPD ; update the batch file
 N Y
 S DA=J,(DIC,DIE)="^FBAA(161.7,"
 S DR="11////^S X=""T"";12////^S X=DT"
 D ^DIE
 Q
 ;
STORE D STORE^FBAAV01 Q
 ;
B3ADMIT(FBIENS) ; Determine Admission Date for a B3 payment line item
 ; input
 ;   FBIENS - IENS (FileMan format) for subfile 162.03 entry
 ; returns admission date in internal FileMan format or null value
 ;
 N FB7078,FBRET
 S FBRET=""
 S FB7078=$$GET1^DIQ(162.03,FBIENS,27,"I") ; associated 7078/583
 ; (the unauthorized ancillary claims will have the treatment date
 ;  instead of the inpatient admission date so nothing is sent to
 ;  Austin for them)
 ;
 ; if line items points to a 7078 authorization then return a date
 I $P(FB7078,";",2)="FB7078(" D
 . N FBY
 . S FBY=$G(^FB7078(+FB7078,0))
 . ; if fee program is civil hospital then return 7078 date of admission
 . I $P(FBY,U,11)=6 S FBRET=$P(FBY,U,15)
 . ; if fee program is CNH then return 7078 authorized from date
 . I $P(FBY,U,11)=7 S FBRET=$P(FBY,U,4)
 ;
 Q FBRET