source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCED0.m@ 1696

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1FBUCED0 ;ALBISC/TET - UPDATE UNAUTHORIZED GROUP ;10/29/01
2 ;;3.5;FEE BASIS;**27**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EDIT(FBDR,FBACT,FBOUT,FBARY) ;called from fbuced, edit to 162.7
5 ;INPUT: FBDR = template to be edited
6 ; FBACT = action on claim (DIS = disposition, REO = reopen, etc)
7 ; FBOUT = exit flag, 1 to exit
8 ; FBARY = count;positions of output array in tmp(fbary
9 ;OUTPUT: FBOUT = 1 if exited
10 ; update unauthorized claim
11 ;get fbda from array
12 Q:'+$G(FBARY)!($G(FBDR)']"")!($G(FBACT)']"") S FBOUT=+$G(FBOUT)
13 N FBDIRA,FBDA,FBI,FBNODE,FBPL,FBW D PARSE^FBUCUTL4(FBARY)
14 S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI S FBNODE=$G(^(FBI)),FBDA=+$P(FBNODE,";") D Q:FBOUT
15 .N DA,DIE,DR,FBALL,FBDISP,FBGROUP,FBUCA,FBUCAA,FBUCP,FBUCPA,FBUCPDX,FBY,Y
16 .I +$G(FBARY)>1 D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
17 .D PRIOR^FBUCEVT(FBDA,FBACT) S:FBACT="EDT"!(FBACT="REO") FBUCPDX=$G(^FB583(FBDA,"DX"))
18 .I FBACT="DIS",$D(FBUCP),$P($G(FBUCP),"^",3)="" W !,"Vendor information is required for disposition." Q
19 .I FBACT="DIS",$D(FBUCP),$P($G(FBUCP),"^",10)="" W !,"Patient Type Code is required for disposition." Q
20 .S DIE="^FB583(",DA=FBDA,DR=FBDR,FBDISP=0 D LOCK^FBUCUTL(DIE,DA,0) I FBLOCK D ^DIE I $D(DTOUT) S FBOUT=1,DR="[FB UNAUTHORIZED PREVIOUS]",DA=FBDA D AFTER^FBUCEVT(DA,FBACT),^DIE L -^FB583(FBDA) K FBLOCK
21 .I 'FBOUT S FBY=$S($D(Y):1,1:0) D AFTER^FBUCEVT(FBDA,FBACT) L -^FB583(FBDA) K FBLOCK D CKAUTH^FBUCUTL6(FBUCP,.FBUCA,FBDA),^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT) I FBACT="REO",'FBY&($$EDOK^FBUCUTL3(FBDA)) D
22 ..;keep authoriziation info in synch for claim being edited via reopen
23 ..N DA,DIE,DR,FBAIEN,FBAUTH,FBIEN,FBLOCK S FBAUTH=$$AUTH^FBUCUTL6(FBUCP,FBUCA)
24 ..Q:FBAUTH=1!(FBAUTH=0) S FBAIEN=+$P(FBUCA,U,27) Q:'FBAIEN S FBIEN=FBAIEN
25 ..S DA=+$P(FBUCP,U,4),DIE="^FBAAA(",DR="[FB UNAUTHORIZED EDIT]"
26 ..D LOCK^FBUCUTL(DIE,DA,0) I FBLOCK D ^DIE L -^FBAAA(+$P(FBUCP,U,4)) S:$D(DTOUT) FBOUT=1 K DTOUT
27 .;keep veteran & treatment from/to (what constitutes a group) in synch for rest in group
28 .S FBALL=0 D GROUP^FBUCUTL7(FBUCP,FBDA),DISPLAY^FBUCUTL7(FBDA,.FBGROUP)
29 .I +$G(FBDISP),$P(FBUCP,U,4,6)'=$P(FBUCA,U,4,6) S FBDIRA="Shall other claims be updated to same veteran & treat. from/to dates" D READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP) D Q:FBOUT
30 ..I FBOUT S FBALL=0 ;if timeout during read, force an unlink
31 ..I 'FBALL D UNLINK^FBUCLNK1(.FBGROUP,FBDA,FBUCA) Q ;unlink claim module
32 ..I FBALL D
33 ...N FBDR
34 ...S FBDR="S:'+$P(FBUCA,U,4) Y=""@1"";2////^S X=+$P(FBUCA,U,4);S Y=3;@1;2///@;S:'+$P(FBUCA,U,5) Y=""@2"";3////^S X=+$P(FBUCA,U,5);S Y=4;@2;3///@;S:'+$P(FBUCA,U,6) Y=""@3"";4////^S X=+$P(FBUCA,U,6);S Y=""@99"";@3;4///@;@99"
35 ...N FBI,FBLOCK S FBI=0 F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA D DIE^FBUCUTL2("^FB583(",FBI,FBDR)
36 .;if reopen or disposition, keep disposition and auth from/to dates in synch for same dispostion for rest in group, also keeps respective authorization in 161.01 in synch
37 .I $S(FBUCA']"":1,FBACT'="REO"&(FBACT'="DIS")&(FBACT'="EDT"):1,FBACT="EDT"&(+$P(FBGROUP,U,5)):0,+$P(FBUCP,U,11)'=+$P(FBUCA,U,11)!($P(FBUCP,U,13,14)'=$P(FBUCA,U,13,14)):0,1:1) Q
38 .S FBALL=0 D DISPLAY^FBUCUTL7(FBDA,.FBGROUP,"^"_+$P(FBUCP,U,24)_"^",+$P(FBUCP,U,11)) Q:'+FBDISP
39 .I +$P(FBUCP,U,11)'=+$P(FBUCA,U,11) S FBDIRA="Shall all other claims be updated to the disposition" S:$P(FBUCP,U,13,14)'=$P(FBUCA,U,13,14) FBDIRA=FBDIRA_" & auth. from/to dates"
40 .I $P(FBUCP,U,11)=$P(FBUCA,U,11) S FBDIRA="Shall all other claims be updated to the auth. from/to dates"
41 .D READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP) I 'FBALL!(FBOUT) Q
42 .I +$P(FBUCA,U,11)'=+$P(FBUCP,U,11),('($P(FBUCA,U,11)=1!($P(FBUCA,U,11)=4))) S DIR(0)="Y",DIR("A")="Shall disapproval reason apply to all other claims" D ^DIR K DIR Q:$D(DIRUT) S FBUCDISR=Y I Y D FBUCDISR(FBDA)
43 .D K FBUCDISR
44 ..N FBDR,FBI,FBODA,FBUCP,FBUCPA
45 ..S FBDR="S:'+$P(FBUCA,U,13) Y=""@1"";12////^S X=+$P(FBUCA,U,13);S Y=13;@1;12///@;S:'+$P(FBUCA,U,14) Y=""@2"";13////^S X=+$P(FBUCA,U,14);S Y=10;@2;13///@;S:'+$P(FBUCA,U,11) Y=""@3"";10////^S X=+$P(FBUCA,U,11);S Y=""@99"";@3;10///@;@99"
46 ..S FBODA=FBDA,FBI=0 F S FBI=$O(FBDISP(FBI)) Q:'FBI I FBI'=FBODA D PRIOR^FBUCEVT(FBI,FBACT) D DIE^FBUCUTL2("^FB583(",FBI,FBDR) N FBUCA,FBUCAA D AFTER^FBUCEVT(FBI,FBACT) S FBDA=FBI D ^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBI,FBACT,$G(FBUCDISR))
47 Q
48FBUCDISR(FBDA) ;set up fbucdisr with disap. reasons for primary claim
49 ;INPUT: ien of unauthorized claim (usually primary)
50 ;OUTPUT: fbucdisr=1^ (1 indicates user wishes for all linked
51 ; claims to contain same disapproval reason as primary
52 ; pieces following will contain the pointer values
53 ; of the disap. reasons for the primary del by ^
54 N I
55 I $D(^FB583(FBDA,"D")) S I=0 F S I=$O(^FB583(FBDA,"D",I)) Q:'I S FBUCDISR=FBUCDISR_"^"_+^FB583(FBDA,"D",I,0)
56 Q
Note: See TracBrowser for help on using the repository browser.