- 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 Mar 13, 2025@21:05:05 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
