FBUCEN1 ;ALBISC/TET - UNAUTH CLAIM ENTER (CONT'D.) ;10/29/01
;;3.5;FEE BASIS;**27**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
EN(FBZ,FBDA) ;entry point from fbucen: check if group, and any in group dispositioned
; if any are, ask if claim being entered should be dispostioned
; disposition new claim to what user selects
;INPUT: FBZ = zero node of unauth claim
; FBDA = ien of unauth claim
N DA,DIE,DIRUT,DR,DTOUT,DUOUT,FBALL,FBC,FBD,FBDIRA,FBGCT,FBDISPO,FBGROUP,FBI,FBLOCK,FBOUT,Y ;fbc=flag to determine if u/c dispo'd (1=yes)
I $S('+$G(FBDA):1,$G(FBZ)']"":1,1:0) Q
S (FBOUT,FBALL)=0
D GROUP^FBUCUTL7(FBZ,FBDA) S FBGCT=+$P(FBGROUP,U,5) Q:'FBGCT D
.;VARIABLE: fbdispo(ien disposition)= u/c ien ^ disposition name
.N FBD,FBI,FBO S FBI=0
.F S FBI=$O(FBGROUP(FBI)) Q:'FBI S FBO=$G(FBGROUP(FBI)),FBD=+$P(FBO,U,4) I FBD S FBDISPO(FBD)=FBI_U_$P($$PTR^FBUCUTL("^FB(162.91,",FBD),U)
S FBC=$S(+$P(FBZ,U,11):+$P(FBZ,U,11),1:0) I FBC,FBGCT=1 Q
I FBC D Q:'FBGCT
.I '$$UPOK^FBUCUTL(FBDA) F FBD=2,3,5 I $D(FBDISPO(FBD)) K FBDISPO(FBD) S FBGCT=FBGCT-1
.Q:'FBGCT
.W:FBGCT>1 *7,!,"The disposition for the selected claim is ",$P($G(FBDISPO(FBC)),U,2) K FBDISPO(FBC) S FBGCT=FBGCT-1
Q:'FBGCT
W !!,"At least one other claim in this group has been dispositioned."
W !!,"The existing disposition(s) in the group follow:",! D
.N FBI S FBI=0 F S FBI=$O(FBDISPO(FBI)) Q:'FBI W !?10,$P($G(FBDISPO(FBI)),U,2)
;if u/c not dipo'd, ask to disp/otherwise ask to change dispo
;if group>1 & not dispo'd, don't change prompt/if group>1 & dispo'd add to another/if group=1 add to |dispo|
S FBDIRA=$S('FBC:"Would you like this claim to be dispositioned",1:"Would you like to change the disposition"),FBDIRA=FBDIRA_$S(FBGCT>1&('FBC):"",FBGCT>1&(FBC):" to another",1:" to ")
S:FBGCT=1 FBDIRA=FBDIRA_$P($$PTR^FBUCUTL("^FB(162.91,",+$O(FBDISPO(0))),U),FBD=+$O(FBDISPO(0))
D READ^FBUCUTL7(FBDIRA,.FBOUT) Q:FBOUT!('+$G(FBALL))
GETDISP I FBGCT>1 S DIC("S")="I $D(FBDISPO(+Y))",DIC="^FB(162.91,",DIC(0)="AEMQZ" D ^DIC K DIC Q:$D(DTOUT)!($D(DUOUT)) G:+Y'>0 GETDISP S FBD=+Y
S FBI=0,FBI=+$O(FBDISPO(+$G(FBD),0)) I FBI D
.N FBDR,FBZ1 S FBZ1=$G(^FB583(FBI,0)) Q:FBZ1']""!('+$P(FBZ1,U,13)) S FBDR="10////^S X=FBD;12///^S X=$P(FBZ1,U,13);13///^S X=$P(FBZ1,U,14);14"
.D DIE^FBUCUTL2("^FB583(",FBDA,FBDR)
;Check Vendor field
I $P($G(^FB583(FBDA,0)),U,3)="" W !,"Vendor information is required for disposition.",!,"The claim cannot be dispositioned." Q
;Check PTC and force to fill it out
I $$PTC(FBDA)=1 W !,"The claim cannot be dispositioned." Q
;
S DA=FBDA,DIE="^FB583(",DR="10////^S X=FBD" D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(DA)
Q
;
;checks and force to input PTYPE codes
; returns
; 0 - if OK
; non-zero if no info or not linked, etc
; FBMCL-master claim,FBSCL-secondary claim
PTC(FBSCL) ;
N FBMCL S FBMCL=$P($G(^FB583(FBSCL,0)),"^",20)
Q:FBMCL="" 1 ;not linked
N FBMPT S FBMPT=$P($G(^FB583(FBMCL,0)),U,10)
N FBSPT S FBSPT=$P($G(^FB583(FBSCL,0)),U,10)
I FBSPT'=""&(FBMPT'="") Q 0 ;PTC codes - OK
W !,"Patient Type Code is required to disposition the claim."
S DIR("A")="Do you want to specify the Patient Type Code for the claim",DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR
Q:$D(DIRUT)!(Y=0) 1 ;user doesn't want to enter PTC
I FBMPT="" I $$MSTRPTC(FBMCL,.FBMPT)=1 W !!,"No Patient Type for master claim." Q 1 ;no PTYPE - quit
I FBSPT="" I $$SCNDPTC(FBMCL,FBSCL,FBMPT)=1 W !!,"No Patient Type for secondary claim." Q 1 ;no PTYPE - quit
Q 0 ;OK
;
;FBPT="" - allows selection of Patient type
;FBPT'="" - inserts patient type FBPT
SELPTC(FBDA,FBPT) ;selects Patient type
N FBLOCK
S DIE="^FB583(",DA=FBDA,DR="9//"
S:FBPT'="" DR=DR_"//^S X=FBPT"
D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(DA)
Q
;
;master claim
MSTRPTC(FBCLM,FBPTC) ;
W !,"Master claim doesn't have any Patient Type Code"
S DIR("A")="Do you want to enter Patient Type Code for the master claim",DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR
Q:$D(DIRUT)!(Y=0) 1
D SELPTC(FBCLM,"")
S FBPTC=$P($G(^FB583(FBCLM,0)),U,10)
Q:FBPTC="" 1
Q 0
;
;secondary claim
SCNDPTC(FBMCLM,FBCLM,FBPTC) ;
W !,"Master claim has Patient Type Code : ",$$GET1^DIQ(162.7,FBMCLM_",",9)
S DIR("A")="Do you want to use the same Patient Type for the secondary claim",DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR
Q:$D(DIRUT) 1
D SELPTC(FBCLM,$S(Y=1:FBPTC,1:""))
Q:$P($G(^FB583(FBCLM,0)),U,10)="" 1 ;no PTYPE
Q 0
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCEN1 4537 printed Sep 23, 2025@19:36:17 Page 2
FBUCEN1 ;ALBISC/TET - UNAUTH CLAIM ENTER (CONT'D.) ;10/29/01
+1 ;;3.5;FEE BASIS;**27**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
EN(FBZ,FBDA) ;entry point from fbucen: check if group, and any in group dispositioned
+1 ; if any are, ask if claim being entered should be dispostioned
+2 ; disposition new claim to what user selects
+3 ;INPUT: FBZ = zero node of unauth claim
+4 ; FBDA = ien of unauth claim
+5 ;fbc=flag to determine if u/c dispo'd (1=yes)
NEW DA,DIE,DIRUT,DR,DTOUT,DUOUT,FBALL,FBC,FBD,FBDIRA,FBGCT,FBDISPO,FBGROUP,FBI,FBLOCK,FBOUT,Y
+6 IF $SELECT('+$GET(FBDA):1,$GET(FBZ)']"":1,1:0)
QUIT
+7 SET (FBOUT,FBALL)=0
+8 DO GROUP^FBUCUTL7(FBZ,FBDA)
SET FBGCT=+$PIECE(FBGROUP,U,5)
if 'FBGCT
QUIT
Begin DoDot:1
+9 ;VARIABLE: fbdispo(ien disposition)= u/c ien ^ disposition name
+10 NEW FBD,FBI,FBO
SET FBI=0
+11 FOR
SET FBI=$ORDER(FBGROUP(FBI))
if 'FBI
QUIT
SET FBO=$GET(FBGROUP(FBI))
SET FBD=+$PIECE(FBO,U,4)
IF FBD
SET FBDISPO(FBD)=FBI_U_$PIECE($$PTR^FBUCUTL("^FB(162.91,",FBD),U)
End DoDot:1
+12 SET FBC=$SELECT(+$PIECE(FBZ,U,11):+$PIECE(FBZ,U,11),1:0)
IF FBC
IF FBGCT=1
QUIT
+13 IF FBC
Begin DoDot:1
+14 IF '$$UPOK^FBUCUTL(FBDA)
FOR FBD=2,3,5
IF $DATA(FBDISPO(FBD))
KILL FBDISPO(FBD)
SET FBGCT=FBGCT-1
+15 if 'FBGCT
QUIT
+16 if FBGCT>1
WRITE *7,!,"The disposition for the selected claim is ",$PIECE($GET(FBDISPO(FBC)),U,2)
KILL FBDISPO(FBC)
SET FBGCT=FBGCT-1
End DoDot:1
if 'FBGCT
QUIT
+17 if 'FBGCT
QUIT
+18 WRITE !!,"At least one other claim in this group has been dispositioned."
+19 WRITE !!,"The existing disposition(s) in the group follow:",!
Begin DoDot:1
+20 NEW FBI
SET FBI=0
FOR
SET FBI=$ORDER(FBDISPO(FBI))
if 'FBI
QUIT
WRITE !?10,$PIECE($GET(FBDISPO(FBI)),U,2)
End DoDot:1
+21 ;if u/c not dipo'd, ask to disp/otherwise ask to change dispo
+22 ;if group>1 & not dispo'd, don't change prompt/if group>1 & dispo'd add to another/if group=1 add to |dispo|
+23 SET FBDIRA=$SELECT('FBC:"Would you like this claim to be dispositioned",1:"Would you like to change the disposition")
SET FBDIRA=FBDIRA_$SELECT(FBGCT>1&('FBC):"",FBGCT>1&(FBC):" to another",1:" to ")
+24 if FBGCT=1
SET FBDIRA=FBDIRA_$PIECE($$PTR^FBUCUTL("^FB(162.91,",+$ORDER(FBDISPO(0))),U)
SET FBD=+$ORDER(FBDISPO(0))
+25 DO READ^FBUCUTL7(FBDIRA,.FBOUT)
if FBOUT!('+$GET(FBALL))
QUIT
GETDISP IF FBGCT>1
SET DIC("S")="I $D(FBDISPO(+Y))"
SET DIC="^FB(162.91,"
SET DIC(0)="AEMQZ"
DO ^DIC
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
if +Y'>0
GOTO GETDISP
SET FBD=+Y
+1 SET FBI=0
SET FBI=+$ORDER(FBDISPO(+$GET(FBD),0))
IF FBI
Begin DoDot:1
+2 NEW FBDR,FBZ1
SET FBZ1=$GET(^FB583(FBI,0))
if FBZ1']""!('+$PIECE(FBZ1,U,13))
QUIT
SET FBDR="10////^S X=FBD;12///^S X=$P(FBZ1,U,13);13///^S X=$P(FBZ1,U,14);14"
+3 DO DIE^FBUCUTL2("^FB583(",FBDA,FBDR)
End DoDot:1
+4 ;Check Vendor field
+5 IF $PIECE($GET(^FB583(FBDA,0)),U,3)=""
WRITE !,"Vendor information is required for disposition.",!,"The claim cannot be dispositioned."
QUIT
+6 ;Check PTC and force to fill it out
+7 IF $$PTC(FBDA)=1
WRITE !,"The claim cannot be dispositioned."
QUIT
+8 ;
+9 SET DA=FBDA
SET DIE="^FB583("
SET DR="10////^S X=FBD"
DO LOCK^FBUCUTL(DIE,DA,1)
IF FBLOCK
DO ^DIE
LOCK -^FB583(DA)
+10 QUIT
+11 ;
+12 ;checks and force to input PTYPE codes
+13 ; returns
+14 ; 0 - if OK
+15 ; non-zero if no info or not linked, etc
+16 ; FBMCL-master claim,FBSCL-secondary claim
PTC(FBSCL) ;
+1 NEW FBMCL
SET FBMCL=$PIECE($GET(^FB583(FBSCL,0)),"^",20)
+2 ;not linked
if FBMCL=""
QUIT 1
+3 NEW FBMPT
SET FBMPT=$PIECE($GET(^FB583(FBMCL,0)),U,10)
+4 NEW FBSPT
SET FBSPT=$PIECE($GET(^FB583(FBSCL,0)),U,10)
+5 ;PTC codes - OK
IF FBSPT'=""&(FBMPT'="")
QUIT 0
+6 WRITE !,"Patient Type Code is required to disposition the claim."
+7 SET DIR("A")="Do you want to specify the Patient Type Code for the claim"
SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
+8 ;user doesn't want to enter PTC
if $DATA(DIRUT)!(Y=0)
QUIT 1
+9 ;no PTYPE - quit
IF FBMPT=""
IF $$MSTRPTC(FBMCL,.FBMPT)=1
WRITE !!,"No Patient Type for master claim."
QUIT 1
+10 ;no PTYPE - quit
IF FBSPT=""
IF $$SCNDPTC(FBMCL,FBSCL,FBMPT)=1
WRITE !!,"No Patient Type for secondary claim."
QUIT 1
+11 ;OK
QUIT 0
+12 ;
+13 ;FBPT="" - allows selection of Patient type
+14 ;FBPT'="" - inserts patient type FBPT
SELPTC(FBDA,FBPT) ;selects Patient type
+1 NEW FBLOCK
+2 SET DIE="^FB583("
SET DA=FBDA
SET DR="9//"
+3 if FBPT'=""
SET DR=DR_"//^S X=FBPT"
+4 DO LOCK^FBUCUTL(DIE,DA,1)
IF FBLOCK
DO ^DIE
LOCK -^FB583(DA)
+5 QUIT
+6 ;
+7 ;master claim
MSTRPTC(FBCLM,FBPTC) ;
+1 WRITE !,"Master claim doesn't have any Patient Type Code"
+2 SET DIR("A")="Do you want to enter Patient Type Code for the master claim"
SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
+3 if $DATA(DIRUT)!(Y=0)
QUIT 1
+4 DO SELPTC(FBCLM,"")
+5 SET FBPTC=$PIECE($GET(^FB583(FBCLM,0)),U,10)
+6 if FBPTC=""
QUIT 1
+7 QUIT 0
+8 ;
+9 ;secondary claim
SCNDPTC(FBMCLM,FBCLM,FBPTC) ;
+1 WRITE !,"Master claim has Patient Type Code : ",$$GET1^DIQ(162.7,FBMCLM_",",9)
+2 SET DIR("A")="Do you want to use the same Patient Type for the secondary claim"
SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
+3 if $DATA(DIRUT)
QUIT 1
+4 DO SELPTC(FBCLM,$SELECT(Y=1:FBPTC,1:""))
+5 ;no PTYPE
if $PIECE($GET(^FB583(FBCLM,0)),U,10)=""
QUIT 1
+6 QUIT 0
+7 ;
+8 ;
