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