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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1FBAASL1 ;AISC/GRR-PRINT SUSPENSION LETTERS CONTINUED ;7/NOV/2006
2 ;;3.5;FEE BASIS;**12,23,69,101**;JAN 30, 1995;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 N FBACRR,FBSCDT
5 F K=0:0 S K=$O(^FBAA(162.1,"AG",K)) Q:K'>0 I $S($G(IFN):IFN=K,1:1) S FBSW=1,FBDT=BEGDATE-.001 F ZZ=0:0 S FBDT=$O(^FBAA(162.1,"AG",K,FBDT)) D WPBOT:FBDT'>0&(FBSW=0)!(FBDT>ENDDATE)&(FBSW=0) Q:FBDT'>0!(FBDT>ENDDATE) S FBSCDT=FBDT D MORE
6 Q
7MORE F J=0:0 S J=$O(^FBAA(162.1,"AG",K,FBDT,J)) Q:J'>0 I $S($G(DFN):DFN=J,1:1) D:$D(^DPT(J,0)) GOTP^FBAASLP I $D(^FBAAV(K,0)) D MID
8 Q
9GOTV S Y(0)=^FBAAV(K,0),VNAM=$P(Y(0),"^",1),FBSW=0
10 I VNAM["," S VNAM=$P(VNAM,",",2)_" "_$P(VNAM,",",1)
11 S VST1=$P(Y(0),"^",3),VST2=$P(Y(0),"^",14),VCITY=$P(Y(0),"^",4),VSTATE=$S($D(^DIC(5,+$P(Y(0),"^",5),0)):$P(^(0),"^",2),1:" "),VZIP=$P(Y(0),"^",6)
12 W @IOF,!!!!!!!,?5,VNAM,!,?5,VST1,! I VST2]"" W ?5,VST2,!
13 W ?5,VCITY," ",VSTATE," ",VZIP,!!!!
14WPBEG S DIWL=1,DIWF="WC79" K ^UTILITY($J,"W")
15 I $D(^FBAA(161.3,FBLET,1,1)) F FBRR=0:0 S FBRR=$O(^FBAA(161.3,FBLET,1,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
16 D ^DIWW:$D(FBXX) K FBXX
17 D HED
18 Q
19MID S FBA=0 F FBAA=0:0 S FBA=$O(^FBAA(162.1,"AG",K,FBDT,J,FBA)) Q:FBA="" I $S(FBSLW=0:1,FBSLW=1&($D(FBAAS(FBA))):1,1:0) D MORE2
20 Q
21MORE2 F L=0:0 S L=$O(^FBAA(162.1,"AG",K,FBDT,J,FBA,L)) Q:L'>0 F M=0:0 S M=$O(^FBAA(162.1,"AG",K,FBDT,J,FBA,L,M)) Q:M'>0 I $D(^FBAA(162.1,L,"RX",M,0)) S Z(0)=^(0) D:$P(Z(0),"^",20)'="R" BOT
22 Q
23WPBOT D:$D(FBACRR) ACT^FBAASLP K FBACRR
24 S DIWL=1,DIWF="WC79" K ^UTILITY($J,"W") W !!
25 I $D(^FBAA(161.3,FBLET,2)) F FBRR=0:0 S FBRR=$O(^FBAA(161.3,FBLET,2,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
26 D ^DIWW:$D(FBXX) K FBXX
27 Q
28BOT Q:$S($G(FBDEN):$P(Z(0),U,16)>0,1:0)
29 N FBFPPSC S FBFPPSC=$P($G(^FBAA(162.1,L,0)),U,13)
30 Q:$S(FBENA=2&(FBFPPSC]""):1,FBENA=1&(FBFPPSC=""):1,1:0)
31 N FBFPPSL,FBX,FBADJLR,FBADJLA,FBRRMKL,T,TAMT,FBJ,FBAC
32 S FBFPPSL=$P($G(^FBAA(162.1,L,"RX",M,3)),U)
33 S FBX=$$ADJLRA^FBRXFA(M_","_L_",")
34 S FBADJLR=$P(FBX,U)
35 F FBJ=1:1 S FBAC=$P(FBADJLR,",",FBJ) Q:FBAC="" S FBACRR(FBAC)=""
36 S FBADJLA=$P(FBX,U,2)
37 S T=$P(Z(0),U,8)
38 I T]"" S T=$P($G(^FBAA(161.27,+T,0)),U)
39 S TAMT=$FN($P(Z(0),U,7),"",2)
40 S FBRRMKL=$$RRL^FBRXFR(M_","_L_",")
41 I FBSW=1 D GOTV^FBAASLP,HED S FBSW=0,FBGOT=1
42 S FBDOS=$P(Z(0),"^",3),FBDRUG=$P(Z(0),"^",2)
43 S FBRX=$P(Z(0),"^",1),A1=$P(Z(0),"^",4)+.0001,A2=$P(Z(0),"^",16)+.0001,A1=$P(A1,".",1)_"."_$E($P(A1,".",2),1,2),A2=$P(A2,".",1)_"."_$E($P(A2,".",2),1,2)
44 I $Y+4>IOSL W @IOF D HED
45 W !!,PNAME,?32,PSSN,?47,$$FMTE^XLFDT(FBDOS),?61,FBRX,!,?15,$J(A1,6),?30,$J(A2,6),?50,FBDRUG,!
46 ; write adjustment reasons, if null then write suspend code
47 W ?15,$S(FBADJLR]"":FBADJLR,1:T)
48 ; write adjustment amounts, if null then write amount suspended
49 W ?31,$S(FBADJLA]"":FBADJLA,1:TAMT)
50 W ?49,FBRRMKL
51 I FBFPPSC]"" W !,?15,"FPPS Claim ID: ",FBFPPSC,?43,"FPPS Line Item: ",FBFPPSL,!
52 I FBADJLR="" G:FBA=4&($D(^FBAA(162.1,L,"RX",M,1))) WPFT D
53 . S DIWL=1,DIWF="WC79",FBI=FBA K ^UTILITY($J,"W")
54 . F FBRR=0:0 S FBRR=$O(^FBAA(161.27,FBI,1,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
55 . D ^DIWW:$D(FBXX) K FBXX
56 Q
57HED W !,"PATIENT NAME",?36,"SSN",?47,"RX DATE",?61,"RX #",!,?15,"AMT CLAIMED",?30,"AMT PAID",?50,"DRUG NAME"
58 W !,?15,"ADJ CODE",?30,"ADJ AMOUNT",?49,"MEDICARE REMITTANCE REMARK"
59 W !,UL,! Q
60 ;
61GOTP ; Utilize new API for Name Standardization
62 ;
63 S Y(0)=^DPT(J,0),PNAME=$P(Y(0),"^",1),PSSN=$TR($$SSNL4^FBAAUTL($$SSN^FBAAUTL(J)),"-","")
64 I PNAME["," D
65 .N FBNAMES
66 .S FBNAMES("FILE")=2,FBNAMES("IENS")=J_",",FBNAMES("FIELD")=.01
67 .S PNAME=$$NAMEFMT^XLFNAME(.FBNAMES)
68 Q
69WPFT S DIWL=1,DIWF="WC79" K ^UTILITY($J,"W")
70 F FBRR=0:0 S FBRR=$O(^FBAA(162.1,L,"RX",M,1,FBRR)) Q:FBRR'>0 S FBXX=^(FBRR,0),X=FBXX D ^DIWP
71 D ^DIWW:$D(FBXX) K FBXX
72 Q
Note: See TracBrowser for help on using the repository browser.