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

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

initial load of WorldVistAEHR
File size: 7.0 KB
Line 
1FBAAV0 ;AISC/GRR-ELECTRONICALLY TRANSMIT FEE DATA ;11 Apr 2006 2:51 PM
2 ;;3.5;FEE BASIS;**3,4,55,89,98**;JAN 30, 1995;Build 54
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 K ^TMP($J,"FBAABATCH"),^TMP($J,"FBVADAT") D DT^DICRW
5 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
6 W !!,"This option will transmit all Batches and MRA's ready to be transmitted",!,"to Austin"
7RD W !! S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="No" D ^DIR K DIR G END:'Y
8 L +^FBAA(161.7,"AC"):0 G:'$T LOCK^FBAAUTL1
9 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
10 .Q:'+FBATCH
11 .I (FBSTAT="S"&($P(FBATCH,U,15)="Y"))!(+$P(FBATCH,U,9)) S ^TMP($J,"FBAABATCH",J)="" W !,+FBATCH
12RTRAN ;Entry from Re-transmit MRA routine
13 D ADDRESS^FBAAV01 G END:VATERR K VAT
14 D WAIT^DICD,STATION^FBAAUTL,HD^FBAAUTL I $D(FB("ERROR")) G END
15 S TOTSTR=0,$P(PAD," ",200)=" "
16 D ^FBAAV1:$D(^FBAA(161.25,"AE"))
17 D ^FBAAV4:$D(^FBAA(161.26,"AC","P"))
18 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"
19END L -^FBAA(161.7,"AC") D KILL^FBAAV1 Q
20SET1 ; build the payment batch header string (used by all four formats)
21 S FBAABN=$P(Y(0),"^",1),FBAABN=$E("00000",$L(FBAABN)+1,5)_FBAABN
22 S FBAAON=$E($P(Y(0),"^",2),3,6)
23 S FBAACD=$$AUSDT^FBAAV3(DT)
24 S FBAACP=$E($P(Y(0),"^",2),1,2)
25 S FBAABT=$P(Y(0),"^",3)
26 S FBAAAP=$$AUSAMT^FBAAV3($P(Y(0),"^",9),10)
27 S FBSTAT=$P(^FBAA(161.7,J,"ST"),"^")
28 S FBCHB=$P(Y(0),"^",15)
29 S FBEXMPT=$P(Y(0),"^",18)
30 S X=$$SUB^FBAAUTL5(+$P(Y(0),U,8)_"-"_$P(Y(0),U,2))
31 S FBAASN=$$LJ^XLFSTR($S(X]"":X,1:FBAASN),6," ")
32 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_" $"
33 Q
34DET ;entry point to process B3 (outpatient/ancillary) batch
35 ; input (partial list)
36 ; J - Batch IEN in file 161.7
37 ; FBAAON - last 4 of obligation number
38 ; FBAASN - station number (formatted)
39 S FBTXT=0
40 D CKB3V^FBAAV01 I $G(FBERR) K FBERR Q
41 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
42 .N FBDTSR1,FBPICN
43 .S FBDTSR1=+$G(^FBAAC(K,1,L,1,M,0))
44 .S FBPICN=K_U_L_U_M_U_N
45 .S FBY=$G(^FBAAC(K,1,L,1,M,1,N,2))
46 .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD
47 .D GOT
48 ;
49 D:FBTXT XMIT^FBAAV01
50 Q
51 ;
52GOT ; process a B3 line item
53 ;
54 N DFN,FBADJ,FBADJA1,FBADJA2,FBADJR1,FBADJR2,FBADMIT,FBAUTHF,FBIENS
55 N FBMOD1,FBMOD2,FBMOD3,FBMOD4,FBPNAMX,FBUNITS,FBX,FBNPI
56 ;
57 S FBIENS=N_","_M_","_L_","_K_","
58 ;
59 ; get CPT modifiers
60 D
61 . N FBMODA,FBMODL
62 . D MODDATA^FBAAUTL4(K,L,M,N)
63 . S FBMODL=$$MODL^FBAAUTL4("FBMODA","E")
64 . S FBMOD1=$$RJ^XLFSTR($P(FBMODL,",",1),5," ")
65 . S FBMOD2=$$RJ^XLFSTR($P(FBMODL,",",2),5," ")
66 . S FBMOD3=$$RJ^XLFSTR($P(FBMODL,",",3),5," ")
67 . S FBMOD4=$$RJ^XLFSTR($P(FBMODL,",",4),5," ")
68 ;
69 S FBPAYT=$P(Y(0),"^",20),FBPAYT=$S(FBPAYT]"":FBPAYT,1:"V")
70 ;
71 S FBVID=$P($G(^FBAAV(L,0)),U,2)
72 S FBVID=FBVID_$E(PAD,$L(FBVID)+1,11)
73 S:FBPAYT="R" FBVID=$E(PAD,1,11)
74 S FBNPI=$$EN^FBNPILK(L) ;SET THE NPI TO BE PASSED TO FBAAV01,FBAAV2,FBAAV5
75 ;
76 D POV^FBAAUTL2
77 S POV=$S(POV']"":"",POV="A":6,POV="B":7,POV="C":8,POV="D":9,POV="E":10,1:POV)
78 S POV=$S(POV']"":99,$D(^FBAA(161.82,POV,0)):$P(^(0),"^",3),1:99)
79 S FBPOV=POV
80 S FBTT=$S(FBTT]"":FBTT,1:1)
81 S FBCPT=$$CPT^FBAAUTL4($P(Y(0),"^")),FBCPT=$S($L(FBCPT)=5:FBCPT,1:" ")
82 S FBPSA=$$PSA^FBAAV5(+$P(Y(0),U,12),+FBAASN) I $L(+FBPSA)'=3 S FBPSA=999
83 S FBPATT=$P(Y(0),"^",17),FBPATT=$S(FBPATT]"":FBPATT,1:10)
84 S FBTD=$$AUSDT^FBAAV3(FBDTSR1) ; formatted treatment date
85 S FBSUSP=$P(Y(0),"^",5),FBSUSP=$S(FBSUSP]"":FBSUSP,1:" ")
86 S FBSUSP=$S(FBSUSP=" ":" ",$D(^FBAA(161.27,+FBSUSP,0)):$P(^(0),"^"),1:" ")
87 S FBAP=$$AUSAMT^FBAAV3($P(Y(0),"^",3),8) ; amount paid
88 S FBPOS=+$P(Y(0),"^",25),FBPOS=$S(FBPOS:$P(^IBE(353.1,FBPOS,0),"^"),1:" ")
89 S FBHCFA=+$P(Y(0),"^",26),FBHCFA=$S(FBHCFA:$P(^IBE(353.2,FBHCFA,0),"^"),1:""),FBHCFA=$E(PAD,$L(FBHCFA)+1,2)_FBHCFA
90 S FBVTOS=+$P(Y(0),"^",24),FBVTOS=$S(FBVTOS:$P(^FBAA(163.85,FBVTOS,0),"^",2),1:" ")
91 S FBPD=+$P(Y(0),"^",23),FBPD=$S(FBPD:$$ICD9^FBCSV1(FBPD,$G(FBDTSR1)),1:""),FBPD=$E(PAD,$L(FBPD)+1,7)_FBPD
92 S FBINVN=$P(Y(0),"^",16)
93 S FBINVN=$E("000000000",$L(FBINVN)+1,9)_FBINVN
94 S FBAUTHF=$S($P(Y(0),U,13)["FB583":"U",1:"A") ; auth/unauth flag
95 S FBDIN=$$AUSDT^FBAAV3($P(Y(0),"^",15)) ; invoice date rec'd
96 S FBADMIT=$$AUSDT^FBAAV3($$B3ADMIT(FBIENS)) ; formatted admission date
97 ;
98 S VAPA("P")=""
99 S DFN=K
100 ; Note - before this point Y(0) was the 0 node of subfile #162.03
101 ; - after this point Y(0) will be the 0 node of file #2
102 S Y(0)=$G(^DPT(+K,0)) Q:Y(0)']""
103 D PAT^FBAAUTL2
104 ; obtain date of birth, must follow call to PAT^FBAAUTL2 to overwrite
105 ; the value returned from it
106 S FBDOB=$$AUSDT^FBAAV3($P(Y(0),"^",3)) ; date of birth
107 D ADD^VADPT
108 S FBPNAMX=$$HL7NAME^FBAAV4(DFN) ; patient name
109 S FBUNITS=$P(FBY,U,14)
110 S:FBUNITS<1 FBUNITS=1
111 S FBUNITS=$$RJ^XLFSTR(FBUNITS,5,0) ; volume indicator (units paid)
112 ;
113 ; get and format adjustment reason codes and amounts (if any)
114 D LOADADJ^FBAAFA(FBIENS,.FBADJ)
115 S FBX=$$ADJL^FBUTL2(.FBADJ)
116 S FBADJR1=$$RJ^XLFSTR($P(FBX,U,1),5," ")
117 S FBADJA1=$$AUSAMT^FBAAV3($P(FBX,U,3),9,1)
118 S FBADJR2=$$RJ^XLFSTR($P(FBX,U,4),5," ")
119 S FBADJA2=$$AUSAMT^FBAAV3($P(FBX,U,6),9,1)
120 K FBADJ,FBX
121 ;
122 S FBST=$S($P(VAPA(5),"^")="":" ",$D(^DIC(5,$P(VAPA(5),"^"),0)):$P(^(0),"^",2),1:" ")
123 S:$L(FBST)'=2 FBST=$E(PAD,$L(FBST)+1,2)_FBST
124 S FBCTY=$S($P(VAPA(7),"^",1)="":" ",FBST=" ":" ",$D(^DIC(5,$P(VAPA(5),"^"),1,$P(VAPA(7),"^"),0)):$P(^(0),"^",3),1:" ")
125 I $L(FBCTY)'=3 S FBCTY=$E("000",$L(FBCTY)+1,3)_FBCTY
126 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)
127 D STRING^FBAAV01
128 Q
129 ;
130UPD ; update the batch file
131 N Y
132 S DA=J,(DIC,DIE)="^FBAA(161.7,"
133 S DR="11////^S X=""T"";12////^S X=DT"
134 D ^DIE
135 Q
136 ;
137STORE D STORE^FBAAV01 Q
138 ;
139B3ADMIT(FBIENS) ; Determine Admission Date for a B3 payment line item
140 ; input
141 ; FBIENS - IENS (FileMan format) for subfile 162.03 entry
142 ; returns admission date in internal FileMan format or null value
143 ;
144 N FB7078,FBRET
145 S FBRET=""
146 S FB7078=$$GET1^DIQ(162.03,FBIENS,27,"I") ; associated 7078/583
147 ; (the unauthorized ancillary claims will have the treatment date
148 ; instead of the inpatient admission date so nothing is sent to
149 ; Austin for them)
150 ;
151 ; if line items points to a 7078 authorization then return a date
152 I $P(FB7078,";",2)="FB7078(" D
153 . N FBY
154 . S FBY=$G(^FB7078(+FB7078,0))
155 . ; if fee program is civil hospital then return 7078 date of admission
156 . I $P(FBY,U,11)=6 S FBRET=$P(FBY,U,15)
157 . ; if fee program is CNH then return 7078 authorized from date
158 . I $P(FBY,U,11)=7 S FBRET=$P(FBY,U,4)
159 ;
160 Q FBRET
Note: See TracBrowser for help on using the repository browser.