FBUCEN ;ALBISC/TET - ENTER UNAUTHORIZED CLAIM ;10/07/2014
;;3.5;FEE BASIS;**32,61,114,153,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
;FB*3.5*153 Insure the response to the Millenium Act 38
; U.S.C. 1725 for Y/N is set to 1/0 in field
; #31 of file 162.7.
;
;FBUC - unauthorized claims site parameter node
;FBTRACK - 1 to track incomplete claims, 0 to track complete claims only
;FBUCP - 0 to not automatically print letters, otherwise default device
;FBOK - 0 if claim is incomplete, 1 if claim is complete.
;FBACT - ENT for enter (fbact represents action type)
;FBINENT = initial entry parameter: 1 if using, 0 if not
S FBOUT=0,FBUC=$$FBUC^FBUCUTL2(1),FBTRACK=+$P(FBUC,U),FBOK=$S('FBTRACK:1,1:0),FBACT="ENT",FBINENT=+$P(FBUC,U,7)
GET ;get info on new claim entry
K FBVEN,FBVET
VET ;get vet info
N DIR,DA W !! S DIR(0)="162.7,2O",DIR("A")="Select VETERAN" D ^DIR K DIR,DA G END:$D(DIRUT),VET:+Y'>0 S FBVET=+Y
VEN ;get vendor info
N DIR,DA S DIR(0)="162.7,1O",DIR("A")="Select FEE VENDOR" D ^DIR K DIR,DA G VET:$D(DUOUT)!($D(DTOUT)),VEN:+Y<0,VEN:+Y=0&('FBINENT) S FBVEN=+Y
PROG N DIC,DA S DIC="^FBAA(161.8,",DIC(0)="AEQMZ",DIC("S")="I +$P(^(0),U,3)" D ^DIC K DIC,DA S:$D(DTOUT)!($D(DUOUT)) FBOUT=1 G END:FBOUT,GET:Y<0 S FBPR=+Y D S:FBOUT FBOUT=0 G VET
.N FBDA,FBMASTER,FBORDER,FBTFROM,FBTTO,FB1725,FBFPPSC
.; ask if claim is an EDI claim (patch *61)
.S FBFPPSC=$$FPPSC^FBUTL5() I FBFPPSC=-1 S FBFPPSC="",FBOUT=1 Q
.; ask if claim is a mill bill emergency care claim (patch *32)
.S DIR(0)="Y"
.S DIR("A")="Is this claim being considered under Millennium Act 38 U.S.C. 1725 (Y/N)"
.D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
.S FB1725=+Y ;FB*3.5*153
.D ASKDT Q:FBOUT I FBTRACK,'FBINENT D Q:FBOUT
..S DIR(0)="Y",DIR("A")="Is the unauthorized claim complete for the FEE PROGRAM" D DIRQ,^DIR K DIR S:$D(DIRUT) FBOUT=1 S:'FBOUT FBOK=Y Q:FBOUT!(FBOK)
..D REQ^FBUCPEND Q:FBOUT S FBORDER=10 ;display/select pending information,set status order to incomplete if selected pending items
.;check for duplicates
.I 'FBINENT W !,"Checking for potential duplicates...",! H 1 D ^FBUCDUP
.W !!,"Checking eligibility...",! H 1 S DFN=FBVET D ELIG^VADPT W:VAEL(4)'=1 !,"Patient is not a veteran.",*7 D ELIG^FBAADEM K VAEL,VAERR
.W ! S DIR("A")="Are you sure you wish to enter a new unauthorized claim",DIR(0)="Y" D ^DIR K DIR S:'Y!($D(DIRUT)) FBOUT=1 Q:FBOUT
.;file new claim
.S DIC="^FB583(",DIC(0)="Z",X=DT K DD,DO D FILE^DICN S FBOUT=$S($P(Y,U,3):0,1:1) Q:FBOUT S FBDA=+Y D PRIOR^FBUCEVT(FBDA,FBACT) D
..S FBMASTER=FBDA,FBORDER=$S(+$G(FBORDER)=10:10,'FBINENT:30,1:5)
..S DIE=DIC,DIE("NO^")="BACKOUTOK",DR="[FB UNAUTHORIZED ENTER]",DA=FBDA
..D LOCK^FBUCUTL(DIE,DA,1) S:'FBLOCK FBOUT=1 Q:FBOUT D ^DIE L -^FB583(FBDA) K DA,DIE,DQ,DR,FBLOCK I $D(Y)!($D(DTOUT)) S DIK=DIC,DA=FBDA D ^DIK K DIK W !,"... Deleting incomplete record.",*7 S FBOUT=1 Q
..I FBORDER=10 D FREQ^FBUCPEND ;file requested info
..K ^TMP("FBARY",$J),^TMP("FBAR",$J)
.D AFTER^FBUCEVT(FBDA,FBACT)
.K FBARY,FBLOCK Q:FBOUT D ENTER^FBUCLNK1(FBDA,FBUCA,1) K FBARY,^TMP("FBARY",$J),^TMP("FBAR",$J)
.I FBORDER'=10,+$G(FBVEN)>0,+$G(FBTTO)>0 D AFTER^FBUCEVT(FBDA,FBACT),EN^FBUCEN1(FBUCA,FBDA) ;if claim complete, check if group, any in group dispositioned
.;do update
.D AFTER^FBUCEVT(FBDA,FBACT),UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
;
END ;kill and quit
K DA,DFN,DIC,DIE,DIR,DIRUT,DQ,DR,DTOUT,DUOUT,FBACT,FBARY,FBDA,FBDISP,FBINENT,FBLOCK,FBMASTER,FBOK,FBORDER,FBOUT,FBPEND,FBPI,FBPR,FBPROG
K FBSTATUS,FBTFROM,FBTRACK,FBTTO,FBUC,FBUCA,FBUCP,FBUCAA,FBUCP,FBUCPA,FBVEN,FBVET,X,Y,^TMP("FBAR",$J),^TMP("FBARY",$J)
Q
ASKDT ;ask treatment from/to dates
S DIR(0)="162.7,3" S:FBPR=6 DIR("A")="ADMISSION DATE" D ^DIR K DIR S:'+Y DIRUT="^" S:$D(DIRUT) FBOUT=1 S:'FBOUT FBTFROM=Y
I 'FBOUT S DIR(0)="162.7,4O" S:FBPR=6 DIR("A")="DISCHARGE DATE" S:FBPR'=6&(FBPR'=7) DIR("B")=$$DATX^FBAAUTL(FBTFROM) D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1 I 'FBOUT,'FBINENT G:+Y'>0!(FBTFROM>Y) ASKDT S FBTTO=Y
I 'FBOUT S FBTTO=+Y
Q
HELP ;help text for complete claim question - ??
W !?10,"An unauthorized claim is considered complete (or valid)"
W !?10,"if all the necessary information has been received."
W !?10,"A claim can never be considered complete if it is missing"
W !?10,"form 10-583 or form 10-583 is incomplete."
W !?10,"Some examples of other items which are needed are:"
W !?20,"Copies of actual bills",!?20,"Original paid receipt"
W !?20,"Itemized invoice/UB82",!?20,"Medical records or signature for release"
W !?20,"Diagnostic/Procedure code(s)",!
Q
DIRQ ;set dir(?,#)
S DIR("?")="Enter Y(es) if complete, N(o) if incomplete."
S DIR("??")="^D HELP^FBUCEN"
S DIR("?",1)="Enter Y(es) if all required information has been submitted,"
S DIR("?",2)=" N(o) if the claim is incomplete."
S DIR("?",3)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCEN 4965 printed Nov 22, 2024@17:10:22 Page 2
FBUCEN ;ALBISC/TET - ENTER UNAUTHORIZED CLAIM ;10/07/2014
+1 ;;3.5;FEE BASIS;**32,61,114,153,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;FB*3.5*153 Insure the response to the Millenium Act 38
+5 ; U.S.C. 1725 for Y/N is set to 1/0 in field
+6 ; #31 of file 162.7.
+7 ;
+8 ;FBUC - unauthorized claims site parameter node
+9 ;FBTRACK - 1 to track incomplete claims, 0 to track complete claims only
+10 ;FBUCP - 0 to not automatically print letters, otherwise default device
+11 ;FBOK - 0 if claim is incomplete, 1 if claim is complete.
+12 ;FBACT - ENT for enter (fbact represents action type)
+13 ;FBINENT = initial entry parameter: 1 if using, 0 if not
+14 SET FBOUT=0
SET FBUC=$$FBUC^FBUCUTL2(1)
SET FBTRACK=+$PIECE(FBUC,U)
SET FBOK=$SELECT('FBTRACK:1,1:0)
SET FBACT="ENT"
SET FBINENT=+$PIECE(FBUC,U,7)
GET ;get info on new claim entry
+1 KILL FBVEN,FBVET
VET ;get vet info
+1 NEW DIR,DA
WRITE !!
SET DIR(0)="162.7,2O"
SET DIR("A")="Select VETERAN"
DO ^DIR
KILL DIR,DA
if $DATA(DIRUT)
GOTO END
if +Y'>0
GOTO VET
SET FBVET=+Y
VEN ;get vendor info
+1 NEW DIR,DA
SET DIR(0)="162.7,1O"
SET DIR("A")="Select FEE VENDOR"
DO ^DIR
KILL DIR,DA
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO VET
if +Y<0
GOTO VEN
if +Y=0&('FBINENT)
GOTO VEN
SET FBVEN=+Y
PROG NEW DIC,DA
SET DIC="^FBAA(161.8,"
SET DIC(0)="AEQMZ"
SET DIC("S")="I +$P(^(0),U,3)"
DO ^DIC
KILL DIC,DA
if $DATA(DTOUT)!($DATA(DUOUT))
SET FBOUT=1
if FBOUT
GOTO END
if Y<0
GOTO GET
SET FBPR=+Y
Begin DoDot:1
+1 NEW FBDA,FBMASTER,FBORDER,FBTFROM,FBTTO,FB1725,FBFPPSC
+2 ; ask if claim is an EDI claim (patch *61)
+3 SET FBFPPSC=$$FPPSC^FBUTL5()
IF FBFPPSC=-1
SET FBFPPSC=""
SET FBOUT=1
QUIT
+4 ; ask if claim is a mill bill emergency care claim (patch *32)
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Is this claim being considered under Millennium Act 38 U.S.C. 1725 (Y/N)"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBOUT=1
QUIT
+8 ;FB*3.5*153
SET FB1725=+Y
+9 DO ASKDT
if FBOUT
QUIT
IF FBTRACK
IF 'FBINENT
Begin DoDot:2
+10 SET DIR(0)="Y"
SET DIR("A")="Is the unauthorized claim complete for the FEE PROGRAM"
DO DIRQ
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET FBOUT=1
if 'FBOUT
SET FBOK=Y
if FBOUT!(FBOK)
QUIT
+11 ;display/select pending information,set status order to incomplete if selected pending items
DO REQ^FBUCPEND
if FBOUT
QUIT
SET FBORDER=10
End DoDot:2
if FBOUT
QUIT
+12 ;check for duplicates
+13 IF 'FBINENT
WRITE !,"Checking for potential duplicates...",!
HANG 1
DO ^FBUCDUP
+14 WRITE !!,"Checking eligibility...",!
HANG 1
SET DFN=FBVET
DO ELIG^VADPT
if VAEL(4)'=1
WRITE !,"Patient is not a veteran.",*7
DO ELIG^FBAADEM
KILL VAEL,VAERR
+15 WRITE !
SET DIR("A")="Are you sure you wish to enter a new unauthorized claim"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if 'Y!($DATA(DIRUT))
SET FBOUT=1
if FBOUT
QUIT
+16 ;file new claim
+17 SET DIC="^FB583("
SET DIC(0)="Z"
SET X=DT
KILL DD,DO
DO FILE^DICN
SET FBOUT=$SELECT($PIECE(Y,U,3):0,1:1)
if FBOUT
QUIT
SET FBDA=+Y
DO PRIOR^FBUCEVT(FBDA,FBACT)
Begin DoDot:2
+18 SET FBMASTER=FBDA
SET FBORDER=$SELECT(+$GET(FBORDER)=10:10,'FBINENT:30,1:5)
+19 SET DIE=DIC
SET DIE("NO^")="BACKOUTOK"
SET DR="[FB UNAUTHORIZED ENTER]"
SET DA=FBDA
+20 DO LOCK^FBUCUTL(DIE,DA,1)
if 'FBLOCK
SET FBOUT=1
if FBOUT
QUIT
DO ^DIE
LOCK -^FB583(FBDA)
KILL DA,DIE,DQ,DR,FBLOCK
IF $DATA(Y)!($DATA(DTOUT))
SET DIK=DIC
SET DA=FBDA
DO ^DIK
KILL DIK
WRITE !,"... Deleting incomplete record.",*7
SET FBOUT=1
QUIT
+21 ;file requested info
IF FBORDER=10
DO FREQ^FBUCPEND
+22 KILL ^TMP("FBARY",$JOB),^TMP("FBAR",$JOB)
End DoDot:2
+23 DO AFTER^FBUCEVT(FBDA,FBACT)
+24 KILL FBARY,FBLOCK
if FBOUT
QUIT
DO ENTER^FBUCLNK1(FBDA,FBUCA,1)
KILL FBARY,^TMP("FBARY",$JOB),^TMP("FBAR",$JOB)
+25 ;if claim complete, check if group, any in group dispositioned
IF FBORDER'=10
IF +$GET(FBVEN)>0
IF +$GET(FBTTO)>0
DO AFTER^FBUCEVT(FBDA,FBACT)
DO EN^FBUCEN1(FBUCA,FBDA)
+26 ;do update
+27 DO AFTER^FBUCEVT(FBDA,FBACT)
DO UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
End DoDot:1
if FBOUT
SET FBOUT=0
GOTO VET
+28 ;
END ;kill and quit
+1 KILL DA,DFN,DIC,DIE,DIR,DIRUT,DQ,DR,DTOUT,DUOUT,FBACT,FBARY,FBDA,FBDISP,FBINENT,FBLOCK,FBMASTER,FBOK,FBORDER,FBOUT,FBPEND,FBPI,FBPR,FBPROG
+2 KILL FBSTATUS,FBTFROM,FBTRACK,FBTTO,FBUC,FBUCA,FBUCP,FBUCAA,FBUCP,FBUCPA,FBVEN,FBVET,X,Y,^TMP("FBAR",$JOB),^TMP("FBARY",$JOB)
+3 QUIT
ASKDT ;ask treatment from/to dates
+1 SET DIR(0)="162.7,3"
if FBPR=6
SET DIR("A")="ADMISSION DATE"
DO ^DIR
KILL DIR
if '+Y
SET DIRUT="^"
if $DATA(DIRUT)
SET FBOUT=1
if 'FBOUT
SET FBTFROM=Y
+2 IF 'FBOUT
SET DIR(0)="162.7,4O"
if FBPR=6
SET DIR("A")="DISCHARGE DATE"
if FBPR'=6&(FBPR'=7)
SET DIR("B")=$$DATX^FBAAUTL(FBTFROM)
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET FBOUT=1
IF 'FBOUT
IF 'FBINENT
if +Y'>0!(FBTFROM>Y)
GOTO ASKDT
SET FBTTO=Y
+3 IF 'FBOUT
SET FBTTO=+Y
+4 QUIT
HELP ;help text for complete claim question - ??
+1 WRITE !?10,"An unauthorized claim is considered complete (or valid)"
+2 WRITE !?10,"if all the necessary information has been received."
+3 WRITE !?10,"A claim can never be considered complete if it is missing"
+4 WRITE !?10,"form 10-583 or form 10-583 is incomplete."
+5 WRITE !?10,"Some examples of other items which are needed are:"
+6 WRITE !?20,"Copies of actual bills",!?20,"Original paid receipt"
+7 WRITE !?20,"Itemized invoice/UB82",!?20,"Medical records or signature for release"
+8 WRITE !?20,"Diagnostic/Procedure code(s)",!
+9 QUIT
DIRQ ;set dir(?,#)
+1 SET DIR("?")="Enter Y(es) if complete, N(o) if incomplete."
+2 SET DIR("??")="^D HELP^FBUCEN"
+3 SET DIR("?",1)="Enter Y(es) if all required information has been submitted,"
+4 SET DIR("?",2)=" N(o) if the claim is incomplete."
+5 SET DIR("?",3)=""
+6 QUIT