source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCUTL7.m@ 1361

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1FBUCUTL7 ;ALBISC/TET - UTILITY FOR GROUPING/DISPLAYING LINKED CLAIMS ;9/18/93 17:12
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4GROUP(FBZ,FBDA) ;check if claim is in a group
5 ;INPUT: FBZ = zero node of unauthorized claim
6 ; FBDA = ien of unauthorized claim from file 162.7
7 ;OUTPUT: FBGROUP = string, delimited by '^', contains:
8 ; count of group^count of different programs^1 or 0 if any authorizations^count of u/c's with same status as fbda^# of different dispositons
9 ; FBGROUP( = array of entries in group, subsripted by u/c ien
10 ; fee program^authorization ien^status^disposition
11 K FBGROUP S FBGROUP=0 I $S($G(FBZ)']"":1,'+$G(FBDA):1,1:0) G GROUPQ
12 N FB0,FBAIEN,FBACT,FBCT,FBDCT,FBDISPO,FBI,FBMAST,FBPCT,FBPROG,FBSCT
13 S FBMAST=+$P(FBZ,U,20),(FBAIEN,FBCT,FBACT,FBDCT,FBI,FBPCT,FBSCT)=0
14 F S FBI=$O(^FB583("AMC",FBMAST,FBI)) Q:'FBI I FBI'=FBDA S FB0=$G(^FB583(FBI,0)) I FB0]"" D
15 .S FBCT=FBCT+1,FBAIEN=+$P(FB0,U,27),FBGROUP(FBI)=+$P(FB0,U,2)_U_FBAIEN S:FBAIEN FBACT=1 I '$D(FBPROG(+$P(FB0,U,2))) S FBPROG(+$P(FB0,U,2))="",FBPCT=FBPCT+1
16 .S FBDISPO=+$P(FB0,U,11) I FBDISPO,'$D(FBDISPO(FBDISPO)) S FBDISPO(FBDISPO)="",FBDCT=FBDCT+1
17 .I $P(FBZ,U,24)=$P(FB0,U,24) S FBSCT=FBSCT+1
18 .S FBGROUP(FBI)=FBGROUP(FBI)_U_+$P(FB0,U,24)_U_+$P(FB0,U,11)
19 S FBAIEN=+$P(FBZ,U,27),FBDISPO=+$P(FBZ,U,11) S:'FBACT&(FBAIEN) FBACT=1 S FBCT=FBCT+1,FBGROUP(FBDA)=+$P(FBZ,U,2)_U_FBAIEN_U_+$P(FBZ,U,24)_U_FBDISPO I FBDISPO,'$D(FBDISPO(FBDISPO)) S FBDCT=FBDCT+1
20 S FBGROUP=FBCT_U_FBPCT_U_FBACT_U_FBSCT_U_FBDCT
21GROUPQ Q
22DISPLAY(FBDA,FBGROUP,FBS,FBD) ;display associated claims with same status
23 ;INPUT: FBDA = ien of unauthorized claim
24 ; FBGROUP = # in group^# progs^1 if auth else 0^# of u/c w/same status
25 ; FBGROUP( = array subscripted by ien of 162.7=prog^aien^status^disposition
26 ; FBS = status on unauthorized claim (fbda) <optional - if displayed claim should have save status as fbda>
27 ; FBD = disposition of claim (not required if no status)
28 ;OUTPUT: FBDISP = count of u/c within group to be displayed (excludes fbda)^count of different dispositions.
29 ; FBDISP( array of those u/c within group as fbda, but does not include fbda
30 I '+$G(FBDA) Q
31 K FBDISP N FBO,FBI S:$G(FBS)']"" FBS="" S FBD=+$G(FBD),FBDISP=0
32 S FBI=0 F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA D
33 .I FBS]"",FBS[$P(FBGROUP(FBI),U,3),$P(FBGROUP(FBI),U,4)=FBD S FBDISP(FBI)=$P(FBGROUP(FBI),U,4),FBDISP=FBDISP+1
34 .I FBS']"" S FBDISP(FBI)="",FBDISP=FBDISP+1 I '$D(FBD($P(FBGROUP(FBI),U,4))) S FBD($P(FBGROUP(FBI),U,4))="",$P(FBDISP,U,2)=+$P(FBDISP,U,2)+1
35 .;Q:'$D(FBDISP(FBI)) S FB0=$G(^FB583(FBI,0)) I FB0]"" W !,FB0
36 K FBS,FBD Q ;W:$D(FBDISP(FBI)) ! K FBS Q
37READ(DIRA,FBOUT,FBDISP) ;ask if one or all should be updated
38 ;INPUT: DIRA = action prompt: disapprove,approve,change,delete
39 ; FBOUT = exit flag: 1 to exit/0 not to exit
40 ; FBDISP = display array; <optional>; if set will display before asking
41 ;OUTPUT: FBALL = flag to update one or all: 0 for one/1 for all
42 I $D(FBDISP) Q:'+$G(FBDISP) D SHOW(.FBDISP,.FBOUT) Q:FBOUT
43 S DIR(0)="YO" S:$G(DIRA)]"" DIR("A")=DIRA
44 D ^DIR K DIR S:$D(DIRUT)!(Y']"") FBOUT=1 S:'$G(FBOUT) FBALL=Y
45 K DIRUT,DTOUT,DUOUT,DIROUT,Y Q
46SHOW(FBDISP,FBOUT) ;write data in display array
47 ;INPUT: FBDISP = # in array^# of different dispositions
48 ; FBDISP( = display array
49 ; FBOUT = exit flag: 1 to exit/0 not to exit
50 ; display entries in array
51 I $S('$D(FBDISP):1,'+$G(FBDISP):1,1:0) Q
52 N FBI,FBZ ;new variables here
53 I +$G(FBDISP)+$Y>(IOSL-2) D CR(.FBOUT) Q:FBOUT
54 S FBI=0 F S FBI=$O(FBDISP(FBI)) Q:'FBI S FBZ=$G(^FB583(FBI,0)) D Q:FBOUT ;set data similar to utility: vet/ven/date received/status/!/treatment from/treatment to/disposition
55 .I $Y+4>IOSL D CR(.FBOUT) Q:FBOUT ;check page legnth,q:fbout
56 .W !,FBI,?5,$E($$VET^FBUCUTL($P(FBZ,U,4)),1,12),?20,$E($$VEN^FBUCUTL($P(FBZ,U,3)),1,12),?35,$E($$PROG^FBUCUTL($P(FBZ,U,2)),1,12),?52,$$DATX^FBAAUTL($P(FBZ,U)),?63,$E($P($$PTR^FBUCUTL("^FB(162.92,",$P(FBZ,U,24)),U),1,16)
57 .W !?7,"TREATMENT FROM: ",$$DATX^FBAAUTL(+$P(FBZ,U,5)),?33,"TREATMENT TO: ",$$DATX^FBAAUTL(+$P(FBZ,U,6)) I +$P(FBZ,U,11) W !?9,"DISPOSITIONED: ",$E($P($$PTR^FBUCUTL("^FB(162.91,",+$P(FBZ,U,11)),U),1,22)
58 Q
59CR(FBOUT) ;read for display
60 ;INPUT/OUTPUT: FBOUT = exit flag; 1 to exit
61 ;write return to continue, and page if continue or quit
62 S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
63 Q:FBOUT
64PAGE ;new page
65 W @IOF
66 Q
Note: See TracBrowser for help on using the repository browser.