source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCEN.m@ 632

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

initial load of WorldVistAEHR

File size: 4.6 KB
RevLine 
[613]1FBUCEN ;ALBISC/TET - ENTER UNAUTHORIZED CLAIM ;7/17/03
2 ;;3.5;FEE BASIS;**32,61**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;FBUC - unauthorized claims site parameter node
5 ;FBTRACK - 1 to track incomplete claims, 0 to track complete claims only
6 ;FBUCP - 0 to not automatically print letters, otherwise default device
7 ;FBOK - 0 if claim is incomplete, 1 if claim is complete.
8 ;FBACT - ENT for enter (fbact represents action type)
9 ;FBINENT = initial entry parameter: 1 if using, 0 if not
10 S FBOUT=0,FBUC=$$FBUC^FBUCUTL2(1),FBTRACK=+$P(FBUC,U),FBOK=$S('FBTRACK:1,1:0),FBACT="ENT",FBINENT=+$P(FBUC,U,7)
11GET ;get info on new claim entry
12 K FBVEN,FBVET
13VET ;get vet info
14 K DIR W !! S DIR(0)="162.7,2O",DIR("A")="Select VETERAN" D ^DIR K DIR G END:$D(DIRUT),VET:+Y'>0 S FBVET=+Y
15VEN ;get vendor info
16 S DIR(0)="162.7,1O",DIR("A")="Select FEE VENDOR" D ^DIR K DIR G VET:$D(DUOUT)!($D(DTOUT)),VEN:+Y<0,VEN:+Y=0&('FBINENT) S FBVEN=+Y
17PROG S DIC="^FBAA(161.8,",DIC(0)="AEQMZ",DIC("S")="I +$P(^(0),U,3)" D ^DIC K DIC S:$D(DTOUT)!($D(DUOUT)) FBOUT=1 G END:FBOUT,GET:Y<0 S FBPR=+Y D S:FBOUT FBOUT=0 G VET
18 .N FBDA,FBMASTER,FBORDER,FBTFROM,FBTTO,FB1725,FBFPPSC
19 .; ask if claim is an EDI claim (patch *61)
20 .S FBFPPSC=$$FPPSC^FBUTL5() I FBFPPSC=-1 S FBFPPSC="",FBOUT=1 Q
21 .; ask if claim is a mill bill emergency care claim (patch *32)
22 .S DIR(0)="Y"
23 .S DIR("A")="Is this claim being considered under Millennium Act 38 U.S.C. 1725 (Y/N)"
24 .D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
25 .S FB1725=$S(Y:1,1:"")
26 .D ASKDT Q:FBOUT I FBTRACK,'FBINENT D Q:FBOUT
27 ..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)
28 ..D REQ^FBUCPEND Q:FBOUT S FBORDER=10 ;display/select pending information,set status order to incomplete if selected pending items
29 .;check for duplicates
30 .I 'FBINENT W !,"Checking for potential duplicates...",! H 1 D ^FBUCDUP
31 .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
32 .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
33 .;file new claim
34 .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
35 ..S FBMASTER=FBDA,FBORDER=$S(+$G(FBORDER)=10:10,'FBINENT:30,1:5)
36 ..S DIE=DIC,DIE("NO^")="BACKOUTOK",DR="[FB UNAUTHORIZED ENTER]",DA=FBDA
37 ..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
38 ..I FBORDER=10 D FREQ^FBUCPEND ;file requested info
39 ..K ^TMP("FBARY",$J),^TMP("FBAR",$J)
40 .D AFTER^FBUCEVT(FBDA,FBACT)
41 .K FBARY,FBLOCK Q:FBOUT D ENTER^FBUCLNK1(FBDA,FBUCA,1) K FBARY,^TMP("FBARY",$J),^TMP("FBAR",$J)
42 .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
43 .;do update
44 .D AFTER^FBUCEVT(FBDA,FBACT),^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
45 ;
46END ;kill and quit
47 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
48 K FBSTATUS,FBTFROM,FBTRACK,FBTTO,FBUC,FBUCA,FBUCP,FBUCAA,FBUCP,FBUCPA,FBVEN,FBVET,X,Y,^TMP("FBAR",$J),^TMP("FBARY",$J)
49 Q
50ASKDT ;ask treatment from/to dates
51 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
52 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
53 I 'FBOUT S FBTTO=+Y
54 Q
55HELP ;help text for complete claim question - ??
56 W !?10,"An unauthorized claim is considered complete (or valid)"
57 W !?10,"if all the necessary information has been received."
58 W !?10,"A claim can never be considered complete if it is missing"
59 W !?10,"form 10-583 or form 10-583 is incomplete."
60 W !?10,"Some examples of other items which are needed are:"
61 W !?20,"Copies of actual bills",!?20,"Original paid receipt"
62 W !?20,"Itemized invoice/UB82",!?20,"Medical records or signature for release"
63 W !?20,"Diagnostic/Procedure code(s)",!
64 Q
65DIRQ ;set dir(?,#)
66 S DIR("?")="Enter Y(es) if complete, N(o) if incomplete."
67 S DIR("??")="^D HELP^FBUCEN"
68 S DIR("?",1)="Enter Y(es) if all required information has been submitted,"
69 S DIR("?",2)=" N(o) if the claim is incomplete."
70 S DIR("?",3)=""
71 Q
Note: See TracBrowser for help on using the repository browser.