FBUCUTL7 ;ALBISC/TET - UTILITY FOR GROUPING/DISPLAYING LINKED CLAIMS ;9/18/93 17:12
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
GROUP(FBZ,FBDA) ;check if claim is in a group
;INPUT: FBZ = zero node of unauthorized claim
; FBDA = ien of unauthorized claim from file 162.7
;OUTPUT: FBGROUP = string, delimited by '^', contains:
; 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
; FBGROUP( = array of entries in group, subsripted by u/c ien
; fee program^authorization ien^status^disposition
K FBGROUP S FBGROUP=0 I $S($G(FBZ)']"":1,'+$G(FBDA):1,1:0) G GROUPQ
N FB0,FBAIEN,FBACT,FBCT,FBDCT,FBDISPO,FBI,FBMAST,FBPCT,FBPROG,FBSCT
S FBMAST=+$P(FBZ,U,20),(FBAIEN,FBCT,FBACT,FBDCT,FBI,FBPCT,FBSCT)=0
F S FBI=$O(^FB583("AMC",FBMAST,FBI)) Q:'FBI I FBI'=FBDA S FB0=$G(^FB583(FBI,0)) I FB0]"" D
.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
.S FBDISPO=+$P(FB0,U,11) I FBDISPO,'$D(FBDISPO(FBDISPO)) S FBDISPO(FBDISPO)="",FBDCT=FBDCT+1
.I $P(FBZ,U,24)=$P(FB0,U,24) S FBSCT=FBSCT+1
.S FBGROUP(FBI)=FBGROUP(FBI)_U_+$P(FB0,U,24)_U_+$P(FB0,U,11)
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
S FBGROUP=FBCT_U_FBPCT_U_FBACT_U_FBSCT_U_FBDCT
GROUPQ Q
DISPLAY(FBDA,FBGROUP,FBS,FBD) ;display associated claims with same status
;INPUT: FBDA = ien of unauthorized claim
; FBGROUP = # in group^# progs^1 if auth else 0^# of u/c w/same status
; FBGROUP( = array subscripted by ien of 162.7=prog^aien^status^disposition
; FBS = status on unauthorized claim (fbda) <optional - if displayed claim should have save status as fbda>
; FBD = disposition of claim (not required if no status)
;OUTPUT: FBDISP = count of u/c within group to be displayed (excludes fbda)^count of different dispositions.
; FBDISP( array of those u/c within group as fbda, but does not include fbda
I '+$G(FBDA) Q
K FBDISP N FBO,FBI S:$G(FBS)']"" FBS="" S FBD=+$G(FBD),FBDISP=0
S FBI=0 F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA D
.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
.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
.;Q:'$D(FBDISP(FBI)) S FB0=$G(^FB583(FBI,0)) I FB0]"" W !,FB0
K FBS,FBD Q ;W:$D(FBDISP(FBI)) ! K FBS Q
READ(DIRA,FBOUT,FBDISP) ;ask if one or all should be updated
;INPUT: DIRA = action prompt: disapprove,approve,change,delete
; FBOUT = exit flag: 1 to exit/0 not to exit
; FBDISP = display array; <optional> if set will display before asking
;OUTPUT: FBALL = flag to update one or all: 0 for one/1 for all
I $D(FBDISP) Q:'+$G(FBDISP) D SHOW(.FBDISP,.FBOUT) Q:FBOUT
S DIR(0)="YO" S:$G(DIRA)]"" DIR("A")=DIRA
D ^DIR K DIR S:$D(DIRUT)!(Y']"") FBOUT=1 S:'$G(FBOUT) FBALL=Y
K DIRUT,DTOUT,DUOUT,DIROUT,Y Q
SHOW(FBDISP,FBOUT) ;write data in display array
;INPUT: FBDISP = # in array^# of different dispositions
; FBDISP( = display array
; FBOUT = exit flag: 1 to exit/0 not to exit
; display entries in array
I $S('$D(FBDISP):1,'+$G(FBDISP):1,1:0) Q
N FBI,FBZ ;new variables here
I +$G(FBDISP)+$Y>(IOSL-2) D CR(.FBOUT) Q:FBOUT
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
.I $Y+4>IOSL D CR(.FBOUT) Q:FBOUT ;check page legnth,q:fbout
.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)
.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)
Q
CR(FBOUT) ;read for display
;INPUT/OUTPUT: FBOUT = exit flag; 1 to exit
;write return to continue, and page if continue or quit
S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
Q:FBOUT
PAGE ;new page
W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCUTL7 4592 printed Sep 23, 2025@19:36:41 Page 2
FBUCUTL7 ;ALBISC/TET - UTILITY FOR GROUPING/DISPLAYING LINKED CLAIMS ;9/18/93 17:12
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
GROUP(FBZ,FBDA) ;check if claim is in a group
+1 ;INPUT: FBZ = zero node of unauthorized claim
+2 ; FBDA = ien of unauthorized claim from file 162.7
+3 ;OUTPUT: FBGROUP = string, delimited by '^', contains:
+4 ; 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
+5 ; FBGROUP( = array of entries in group, subsripted by u/c ien
+6 ; fee program^authorization ien^status^disposition
+7 KILL FBGROUP
SET FBGROUP=0
IF $SELECT($GET(FBZ)']"":1,'+$GET(FBDA):1,1:0)
GOTO GROUPQ
+8 NEW FB0,FBAIEN,FBACT,FBCT,FBDCT,FBDISPO,FBI,FBMAST,FBPCT,FBPROG,FBSCT
+9 SET FBMAST=+$PIECE(FBZ,U,20)
SET (FBAIEN,FBCT,FBACT,FBDCT,FBI,FBPCT,FBSCT)=0
+10 FOR
SET FBI=$ORDER(^FB583("AMC",FBMAST,FBI))
if 'FBI
QUIT
IF FBI'=FBDA
SET FB0=$GET(^FB583(FBI,0))
IF FB0]""
Begin DoDot:1
+11 SET FBCT=FBCT+1
SET FBAIEN=+$PIECE(FB0,U,27)
SET FBGROUP(FBI)=+$PIECE(FB0,U,2)_U_FBAIEN
if FBAIEN
SET FBACT=1
IF '$DATA(FBPROG(+$PIECE(FB0,U,2)))
SET FBPROG(+$PIECE(FB0,U,2))=""
SET FBPCT=FBPCT+1
+12 SET FBDISPO=+$PIECE(FB0,U,11)
IF FBDISPO
IF '$DATA(FBDISPO(FBDISPO))
SET FBDISPO(FBDISPO)=""
SET FBDCT=FBDCT+1
+13 IF $PIECE(FBZ,U,24)=$PIECE(FB0,U,24)
SET FBSCT=FBSCT+1
+14 SET FBGROUP(FBI)=FBGROUP(FBI)_U_+$PIECE(FB0,U,24)_U_+$PIECE(FB0,U,11)
End DoDot:1
+15 SET FBAIEN=+$PIECE(FBZ,U,27)
SET FBDISPO=+$PIECE(FBZ,U,11)
if 'FBACT&(FBAIEN)
SET FBACT=1
SET FBCT=FBCT+1
SET FBGROUP(FBDA)=+$PIECE(FBZ,U,2)_U_FBAIEN_U_+$PIECE(FBZ,U,24)_U_FBDISPO
IF FBDISPO
IF '$DATA(FBDISPO(FBDISPO))
SET FBDCT=FBDCT+1
+16 SET FBGROUP=FBCT_U_FBPCT_U_FBACT_U_FBSCT_U_FBDCT
GROUPQ QUIT
DISPLAY(FBDA,FBGROUP,FBS,FBD) ;display associated claims with same status
+1 ;INPUT: FBDA = ien of unauthorized claim
+2 ; FBGROUP = # in group^# progs^1 if auth else 0^# of u/c w/same status
+3 ; FBGROUP( = array subscripted by ien of 162.7=prog^aien^status^disposition
+4 ; FBS = status on unauthorized claim (fbda) <optional - if displayed claim should have save status as fbda>
+5 ; FBD = disposition of claim (not required if no status)
+6 ;OUTPUT: FBDISP = count of u/c within group to be displayed (excludes fbda)^count of different dispositions.
+7 ; FBDISP( array of those u/c within group as fbda, but does not include fbda
+8 IF '+$GET(FBDA)
QUIT
+9 KILL FBDISP
NEW FBO,FBI
if $GET(FBS)']""
SET FBS=""
SET FBD=+$GET(FBD)
SET FBDISP=0
+10 SET FBI=0
FOR
SET FBI=$ORDER(FBGROUP(FBI))
if 'FBI
QUIT
IF FBI'=FBDA
Begin DoDot:1
+11 IF FBS]""
IF FBS[$PIECE(FBGROUP(FBI),U,3)
IF $PIECE(FBGROUP(FBI),U,4)=FBD
SET FBDISP(FBI)=$PIECE(FBGROUP(FBI),U,4)
SET FBDISP=FBDISP+1
+12 IF FBS']""
SET FBDISP(FBI)=""
SET FBDISP=FBDISP+1
IF '$DATA(FBD($PIECE(FBGROUP(FBI),U,4)))
SET FBD($PIECE(FBGROUP(FBI),U,4))=""
SET $PIECE(FBDISP,U,2)=+$PIECE(FBDISP,U,2)+1
+13 ;Q:'$D(FBDISP(FBI)) S FB0=$G(^FB583(FBI,0)) I FB0]"" W !,FB0
End DoDot:1
+14 ;W:$D(FBDISP(FBI)) ! K FBS Q
KILL FBS,FBD
QUIT
READ(DIRA,FBOUT,FBDISP) ;ask if one or all should be updated
+1 ;INPUT: DIRA = action prompt: disapprove,approve,change,delete
+2 ; FBOUT = exit flag: 1 to exit/0 not to exit
+3 ; FBDISP = display array; <optional> if set will display before asking
+4 ;OUTPUT: FBALL = flag to update one or all: 0 for one/1 for all
+5 IF $DATA(FBDISP)
if '+$GET(FBDISP)
QUIT
DO SHOW(.FBDISP,.FBOUT)
if FBOUT
QUIT
+6 SET DIR(0)="YO"
if $GET(DIRA)]""
SET DIR("A")=DIRA
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)!(Y']"")
SET FBOUT=1
if '$GET(FBOUT)
SET FBALL=Y
+8 KILL DIRUT,DTOUT,DUOUT,DIROUT,Y
QUIT
SHOW(FBDISP,FBOUT) ;write data in display array
+1 ;INPUT: FBDISP = # in array^# of different dispositions
+2 ; FBDISP( = display array
+3 ; FBOUT = exit flag: 1 to exit/0 not to exit
+4 ; display entries in array
+5 IF $SELECT('$DATA(FBDISP):1,'+$GET(FBDISP):1,1:0)
QUIT
+6 ;new variables here
NEW FBI,FBZ
+7 IF +$GET(FBDISP)+$Y>(IOSL-2)
DO CR(.FBOUT)
if FBOUT
QUIT
+8 ;set data similar to utility: vet/ven/date received/status/!/treatment from/treatment to/disposition
SET FBI=0
FOR
SET FBI=$ORDER(FBDISP(FBI))
if 'FBI
QUIT
SET FBZ=$GET(^FB583(FBI,0))
Begin DoDot:1
+9 ;check page legnth,q:fbout
IF $Y+4>IOSL
DO CR(.FBOUT)
if FBOUT
QUIT
+10 WRITE !,FBI,?5,$EXTRACT($$VET^FBUCUTL($PIECE(FBZ,U,4)),1,12),?20,$EXTRACT($$VEN^FBUCUTL($PIECE(FBZ,U,3)),1,12),?35,$EXTRACT($$PROG^FBUCUTL($PIECE(FBZ,U,2)),1,12),?52,$$DATX^FBAAUTL(...
... $PIECE(FBZ,U)),?63,$EXTRACT($PIECE($$PTR^FBUCUTL("^FB(162.92,",$PIECE(FBZ,U,24)),U),1,16)
+11 WRITE !?7,"TREATMENT FROM: ",$$DATX^FBAAUTL(+$PIECE(FBZ,U,5)),?33,"TREATMENT TO: ",$$DATX^FBAAUTL(+$PIECE(FBZ,U,6))
IF +$PIECE(FBZ,U,11)
WRITE !?9,"DISPOSITIONED: ",$EXTRACT($PIECE($$PTR^FBUCUTL("^FB(162.91,",+$PIECE(FBZ,U,11)),U),1,22)
End DoDot:1
if FBOUT
QUIT
+12 QUIT
CR(FBOUT) ;read for display
+1 ;INPUT/OUTPUT: FBOUT = exit flag; 1 to exit
+2 ;write return to continue, and page if continue or quit
+3 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET FBOUT=1
+4 if FBOUT
QUIT
PAGE ;new page
+1 WRITE @IOF
+2 QUIT
