| [623] | 1 | FBPCR ;AISC/DMK,GRR,TET-POTENTIAL COST RECOVERY OUTPUT DRIVER ;23 May 2006 10:06 AM
|
|---|
| 2 | ;;3.5;FEE BASIS;**12,48,76,98**;JAN 30, 1995;Build 54
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | DOC ;Refer to fbdoc, tag fbpcr, for documentation of fbpcr* routines
|
|---|
| 5 | PSF ;select one/many/all primary service failities
|
|---|
| 6 | S FBARRLTC=""
|
|---|
| 7 | W !! S DIC="^DIC(4,",VAUTSTR="Primary Service Facility",VAUTNI=2,VAUTVB="FBPSV" D FIRST^VAUTOMA K DIC I Y=-1 G EXIT
|
|---|
| 8 | ARRAY ;set fee program array for all programs
|
|---|
| 9 | S FBPI=0 F S FBPI=$O(^FBAA(161.8,FBPI)) Q:'FBPI S FBPIN=$G(^(FBPI,0)) I $P(FBPIN,U,3) S FBPROG(FBPI)=$P(FBPIN,U)
|
|---|
| 10 | I '$D(FBPROG) G EXIT
|
|---|
| 11 | ;prepare array with LTC POV codes
|
|---|
| 12 | D MKARRLTC^FBPCR4
|
|---|
| 13 | ;what party to include
|
|---|
| 14 | K DIR
|
|---|
| 15 | S DIR(0)="SO^P:Patient;I:Insurance;B:Both",DIR("A")="Include (P)atient Co-pays / (I)nsurance / (B)oth",DIR("B")="Both"
|
|---|
| 16 | S DIR("?")=" Select type of recover to include",DIR("?",1)=" P - include only recover from patient copays",DIR("?",2)=" I - include only recover from insurance",DIR("?",3)=" B - include both",DIR("L")=""
|
|---|
| 17 | D ^DIR S FBPARTY=$S($G(Y(0))="Patient":1,$G(Y(0))="Insurance":2,$G(Y(0))="Both":3,X="Both":3,1:0)
|
|---|
| 18 | K DIR
|
|---|
| 19 | G:FBPARTY=0 EXIT
|
|---|
| 20 | ;what type of copay to include
|
|---|
| 21 | S FBCOPAY=3
|
|---|
| 22 | I FBPARTY'=2 D
|
|---|
| 23 | . S DIR(0)="SO^M:MeansTest;L:LTC;B:Both",DIR("A")="Include (M)eans Test Co-pays /(L)TC Co-pays /(B)oth",DIR("B")="Both"
|
|---|
| 24 | . S DIR("?")=" Select services to include",DIR("?",1)=" M - include only Means Test copays",DIR("?",2)=" L - include only LTC copays",DIR("?",3)=" B - include both",DIR("L")=""
|
|---|
| 25 | . D ^DIR S FBCOPAY=$S($G(Y(0))="LTC":1,$G(Y(0))="MeansTest":2,$G(Y(0))="Both":3,X="Both":3,1:0)
|
|---|
| 26 | . K DIR
|
|---|
| 27 | G:FBCOPAY=0 EXIT
|
|---|
| 28 | ;
|
|---|
| 29 | ;include patients if their insurance informations is unavailable?
|
|---|
| 30 | S FBINCUNK=0
|
|---|
| 31 | I FBPARTY=2!(FBPARTY=3) D
|
|---|
| 32 | . S FBINCUNK=1
|
|---|
| 33 | . N Y,X
|
|---|
| 34 | . W !!
|
|---|
| 35 | . S DIR("A")="Do you want to include patients whose insurance status is unavailable? "
|
|---|
| 36 | . S DIR("?")="Please answer Yes or No."
|
|---|
| 37 | . S DIR("B")="YES",DIR(0)="YA^^"
|
|---|
| 38 | . D ^DIR K DIR
|
|---|
| 39 | . I $G(DIRUT) S FBINCUNK=-1 Q
|
|---|
| 40 | . I $G(Y)=0 S FBINCUNK=0
|
|---|
| 41 | I FBINCUNK=-1 G EXIT ;uparrow - exit
|
|---|
| 42 | ;
|
|---|
| 43 | DATE ;select date range
|
|---|
| 44 | D DATE^FBAAUTL I FBPOP G PSF
|
|---|
| 45 | S FBBDATE=BEGDATE,FBEDATE=ENDDATE
|
|---|
| 46 | S Z=9999999.9999,FBBEG=Z-FBEDATE,FBEND=Z-FBBDATE
|
|---|
| 47 | Q K ^TMP($J,"FB"),^TMP($J,"FBINSIBAPI"),DIC
|
|---|
| 48 | ;
|
|---|
| 49 | S VAR="FBINCUNK^FBARRLTC^FBARRLTC(^FBPARTY^FBCOPAY^FBNAME^FBIEN^FBID^FBBEG^FBEND^FBBDATE^FBEDATE^FBPSV^FBPSV(^FBPROG(",VAL=VAR,PGM="DQ^FBPCR",IOP="Q" D ZIS^FBAAUTL G:FBPOP EXIT
|
|---|
| 50 | DQ S $P(FBDASH,"=",80)="",$P(FBDASH1,"-",80)="",FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBOUT=0,FBBEG=FBBEG-.9 U IO
|
|---|
| 51 | SORT ;sort driver for payment output(s)
|
|---|
| 52 | S FBPI=0 F S FBPI=$O(FBPROG(FBPI)) Q:'FBPI S FBXPROG=FBPROG(FBPI) D
|
|---|
| 53 | .I FBPI=2 D EN^FBPCR2 ;outpatient payments
|
|---|
| 54 | .I FBPI=3 D EN^FBPCR3 ;pharmacy payments
|
|---|
| 55 | .I FBPI=6!(FBPI=7) S:FBPI=6&($D(FBPROG(7))) FBPI=67 D EN^FBPCR67 S:FBPI=67 FBPI=7 ;civil hospital/cnh payments
|
|---|
| 56 | PRINT ;print driver for payment output(s)
|
|---|
| 57 | I $G(^TMP($J,"FBINSIBAPI"))>0 D HDRUNK
|
|---|
| 58 | S FBPI=$O(^TMP($J,"FB",0)) I FBPI']"" D WMSG G OUT
|
|---|
| 59 | S FBSTA=0
|
|---|
| 60 | S FBPSF=0 F S FBPSF=$O(^TMP($J,"FB",FBPSF)) Q:'FBPSF!FBOUT D STA S FBPT="" F S FBPT=$O(^TMP($J,"FB",FBPSF,FBPT)) Q:FBPT']""!FBOUT S DFN=$P(FBPT,";",2) D VET S FBPI=0 F S FBPI=$O(FBPROG(FBPI)) Q:'FBPI S FBXPROG=FBPROG(FBPI) D Q:FBOUT
|
|---|
| 61 | .I FBPSF_FBPT'=FBSTA D HDR Q:FBOUT
|
|---|
| 62 | .I FBPI=2,$D(^TMP($J,"FB",FBPSF,FBPT,FBPI)) D PRINT^FBPCR2 Q
|
|---|
| 63 | .I FBPI=3 D:$D(^TMP($J,"FB",FBPSF,FBPT,FBPI)) PRINT^FBPCR3 Q
|
|---|
| 64 | .I FBPI=6!(FBPI=7) D:$D(^TMP($J,"FB",FBPSF,FBPT,FBPI)) PRINT^FBPCR671 Q
|
|---|
| 65 | OUT I $G(^TMP($J,"FBINSIBAPI"))>0 D ERRHDL^FBPCR4
|
|---|
| 66 | I FBOUT!$D(ZTQUEUED) G EXIT
|
|---|
| 67 | D EXIT G PSF
|
|---|
| 68 | Q
|
|---|
| 69 | EXIT ;kill and quit
|
|---|
| 70 | KILL ;kill all variables set in the FBPCR* routines, other than fbx
|
|---|
| 71 | D CLOSE^FBAAUTL K ^TMP($J,"FB")
|
|---|
| 72 | K A1,A2,A3,BEGDATE,C,D,D2,DFN,DIC,DIR,DTOUT,DUOUT,ENDDATE,FBPDXC,FBPARTY,FBCOPAY,FBARRLTC,FBINCUNK
|
|---|
| 73 | K FBAAA,FBAACPTC,FBAC,FBAP,FBBATCH,FBBDATE,FBBEG,FBBN,FBCATC,FBCNT,FBCP,FBCRT,FBDA1,FBDASH,FBDASH1,FBDATA,FBDOB,FBDRUG,FBDT,FBDT1,FBDOS,FBDX,FBDX1,FBEDATE,FBEND,FBERR,FBFD,FBFD1,FBHEAD
|
|---|
| 74 | K FBI,FBID,FBIEN,FBIN,FBINS,FBINVN,FBIX,FBJ,FBLOC,FBM,FBNAME,FBOB,FBOPI,FBOUT,FBOV,FBP,FBPAT,FBPD,FBPDX,FBPG,FBPI,FBPID,FBPIN,FBPNAME,FBPROC,FBPROC1,FBPROG,FBPSF,FBPSFNAM,FBPSFNUM,FBPSV,FBPT,FBPV,FBQTY,FBREIM,FBRX
|
|---|
| 75 | K FBSC,FBSL,FBSTA,FBSTR,FBSUSP,FBTA,FBTYPE,FBV,FBVCHAIN,FBVEN,FBVENID,FBVNAME,FBVI,FBVID,FBVP,FBXPROG,FBY,FBZ,I,IOP,J,K,L,M,N,PGM,T,V,VA,VAERR,VAL,VAR,VAUTNI,VAUTSTR,VAUTVB,X,Y,Z,FBSTANPI,FBXX
|
|---|
| 76 | Q
|
|---|
| 77 | WMSG ;write message if no matches found
|
|---|
| 78 | D HDR W !!?3,"There are no potential cost recoveries on file"
|
|---|
| 79 | W !?5,"for specified date range: ",$$DATX^FBAAUTL(FBBDATE)," through ",$$DATX^FBAAUTL(FBEDATE)
|
|---|
| 80 | I 'FBPSV D
|
|---|
| 81 | .W ",",!?5,"and selected Primary Service Area(s):"
|
|---|
| 82 | .S FBPSF=0 F S FBPSF=$O(FBPSV(FBPSF)) Q:'FBPSF W !?31,$G(FBPSV(FBPSF))
|
|---|
| 83 | E W !?5,"and ALL Primary Service Areas "
|
|---|
| 84 | W ".",*7,!!
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | CATC(DFN,FBDT,FBPOV) ;
|
|---|
| 88 | ;treats all copays as Means test for date < 3020705 (JULY 5,2002)
|
|---|
| 89 | ;check if patient is liable for copay
|
|---|
| 90 | ;INPUT:
|
|---|
| 91 | ; DFN = IEN of Patient file
|
|---|
| 92 | ; FBDT= Date
|
|---|
| 93 | ; FBPOV = POV code (for LTC determination)
|
|---|
| 94 | ;OUTPUT:
|
|---|
| 95 | ;0 - the patient is not liable for any co-pay;
|
|---|
| 96 | ;1 - if Means test catc or pending adjudication and agree to pay deduc
|
|---|
| 97 | ;2 - the patient is liable for LTC co-pay;
|
|---|
| 98 | ;3 - no 1010EC on file
|
|---|
| 99 | ;4 - more analysis is needed to determine the patient liability
|
|---|
| 100 | N FBLTC,FBISLTC
|
|---|
| 101 | S FBCATC=$$BIL^DGMTUB(DFN,FBDT)
|
|---|
| 102 | I '$D(FBPOV)!(FBDT<3020705) Q $S(FBCATC:1,1:0)
|
|---|
| 103 | S FBISLTC=$$ISLTC^FBPCR4(FBPOV)
|
|---|
| 104 | I FBISLTC=0 Q $S(FBCATC:1,1:0) ;Means test
|
|---|
| 105 | I FBISLTC=2 Q 0 ;LTC-service, but LTC-copay is not applicable
|
|---|
| 106 | S FBLTC=$$LTCST^FBPCR4(DFN,FBDT)
|
|---|
| 107 | I FBLTC=2 Q 2 ;LTC copay
|
|---|
| 108 | I FBLTC=0 Q 3 ;no 1010EC on file
|
|---|
| 109 | I FBLTC=4 Q 4 ;more info needed
|
|---|
| 110 | Q 0 ;exemption from LTC -copay
|
|---|
| 111 | ;
|
|---|
| 112 | VET ;set vet name/ssn/dob info
|
|---|
| 113 | ;INPUT: DFN = IEN of Patient file
|
|---|
| 114 | ; FBPI = IEN of fee program (optional)
|
|---|
| 115 | ;OUTPUT: FBPNAME = Patient's name
|
|---|
| 116 | ; FBPID = Patient's pid
|
|---|
| 117 | ; FBDOB = Patient's dob (if pharmacy fee program)
|
|---|
| 118 | N N
|
|---|
| 119 | S N=$G(^DPT(DFN,0)),FBPNAME=$P(N,U),FBPID=$$SSN^FBAAUTL(DFN),FBDOB=$$FMTE^XLFDT($P(N,U,3))
|
|---|
| 120 | Q
|
|---|
| 121 | STA ;set station name & number
|
|---|
| 122 | ;INPUT = FBPSF - IEN to institution file
|
|---|
| 123 | ;OUTPUT = FBPSFNAM = station name
|
|---|
| 124 | ; FBPSFNUM = station number
|
|---|
| 125 | S FBPSFNAM=$P($G(^DIC(4,FBPSF,0)),U),FBPSFNUM=$P($G(^DIC(4,FBPSF,99)),U)
|
|---|
| 126 | S:FBPSFNAM=+FBPSFNAM FBPSFNAM="UNKNOWN"
|
|---|
| 127 | S FBSTANPI=$S($G(FBPSFNAM)="":"",FBPSFNAM="UNKNOWN":"",1:$P($$NPI^XUSNPI("Organization_ID",FBPSF),U,1))
|
|---|
| 128 | Q
|
|---|
| 129 | PAGE ;form feed when new station/patient
|
|---|
| 130 | S FBSTA=$G(FBPSF)_$G(FBPT)
|
|---|
| 131 | I FBCRT&(FBPG'=0) D CR Q:FBOUT
|
|---|
| 132 | I FBPG>0!FBCRT W @IOF
|
|---|
| 133 | S FBPG=FBPG+1
|
|---|
| 134 | Q
|
|---|
| 135 | CR ;read for display
|
|---|
| 136 | S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
|
|---|
| 137 | Q
|
|---|
| 138 | HDR ;general header for potential recoveries
|
|---|
| 139 | D PAGE Q:FBOUT
|
|---|
| 140 | W !?(IOM-30/2),"POTENTIAL COST RECOVERY REPORT"
|
|---|
| 141 | W !?(IOM-(11+$L($G(FBPSFNAM))+$L($G(FBPSFNUM)))/2),"Division: ",$G(FBPSFNUM)," ",$G(FBPSFNAM)
|
|---|
| 142 | W !?(IOM-14/2),"NPI: ",$S($G(FBSTANPI)="":"",$G(FBSTANPI)=-1:"",1:$G(FBSTANPI))
|
|---|
| 143 | W !?(IOM-19/2),$$DATX^FBAAUTL(FBBDATE)," - ",$$DATX^FBAAUTL(FBEDATE)
|
|---|
| 144 | W !?71,"Page: ",FBPG
|
|---|
| 145 | W !,"Patient: ",$G(FBPNAME),?40,"Pat. ID: ",$G(FBPID),?62,"DOB: ",$G(FBDOB)
|
|---|
| 146 | W !
|
|---|
| 147 | I FBINCUNK=1,$D(^TMP($J,"FBINSIBAPI",+$G(DFN))) W ">> Warning: accurate insurance information for the patient is unavailable"
|
|---|
| 148 | W !?3,"('*' Represents Reimbursement to Patient",?50,"'#' Represents Voided Payment)"
|
|---|
| 149 | W !,FBDASH
|
|---|
| 150 | W ! D:$D(DFN) INS^DGRPDB
|
|---|
| 151 | Q
|
|---|
| 152 | HDRUNK ;Warning message if patient's insurance status is unknown
|
|---|
| 153 | D PAGE Q:FBOUT
|
|---|
| 154 | W !?(IOM-30/2),"POTENTIAL COST RECOVERY REPORT"
|
|---|
| 155 | W !?(IOM-(11+$L($G(FBPSFNAM))+$L($G(FBPSFNUM)))/2),"Division: ",$G(FBPSFNUM)," ",$G(FBPSFNAM)
|
|---|
| 156 | W !?(IOM-19/2),$$DATX^FBAAUTL(FBBDATE)," - ",$$DATX^FBAAUTL(FBEDATE)
|
|---|
| 157 | W !?71,"Page: ",FBPG
|
|---|
| 158 | W !,"------------------------------ !!! WARNING !!! --------------------------------"
|
|---|
| 159 | W !,"This report is incomplete due to problems with obtaining insurance information"
|
|---|
| 160 | W !,"for those patients listed in a separate section in the end of the report. You"
|
|---|
| 161 | W !,"may want to rerun the report again to get more accurate results."
|
|---|
| 162 | W !,FBDASH
|
|---|
| 163 | I FBINCUNK=1 D
|
|---|
| 164 | . W !,"Note: You have chosen to include patients with unknown insurance status in"
|
|---|
| 165 | . W !,"this report. Please be aware that these patients will be treated as if they"
|
|---|
| 166 | . W !,"have billable insurance and their treatment details will be marked accordingly."
|
|---|
| 167 | . W !,"The names of these patients will be accompanied with the following message"
|
|---|
| 168 | . W !,"to order to identify them:"
|
|---|
| 169 | . W !,">> Warning: accurate insurance information for the patient is unavailable"
|
|---|
| 170 | . W !,FBDASH
|
|---|
| 171 | Q
|
|---|
