FBUCED1 ;ALBISC/TET - EDIT UNAUTHORIZED CLAIM, cont'd
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
DEL ;deletes unauthorized claim(s); if any pending info will delete also
;only claims which have not been dispositioned can be deleted.
N FBACT,FBO,DIRUT,DTOUT,DUOUT,Y S FBACT="DEL",FBO="5^10^30^" D LOOKUP^FBUCUTL3(FBO) G END^FBUCED:FBOUT!('+$G(FBARY))
N FBALL,FBDA,FBI,FBNODE,FBOUT,FBPL,FBW,FBZ S (FBALL,FBOUT)=0 D PARSE^FBUCUTL4(FBARY)
S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI S FBNODE=$G(^(FBI)),FBDA=+$P(FBNODE,";"),FBZ=$$FBZ^FBUCUTL(FBDA) I FBZ]"" D G:FBOUT DELQ
.N FBDISP,FBGROUP D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
.N Y,DIRUT,DTOUT,DUOUT S DIR("A")="Are you sure you wish to delete",DIR("B")="Y",DIR(0)="Y" D ^DIR K DIR S:$D(DIRUT) FBOUT=1 Q:'Y
.D GROUP^FBUCUTL7(FBZ,FBDA),DISPLAY^FBUCUTL7(FBDA,.FBGROUP,"^5^10^30^",+$P(FBZ,U,11))
.I $$PRIME^FBUCUTL4(FBDA,FBZ) D PRIME^FBUCLNK1(.FBGROUP,FBDA,FBZ)
.I +FBDISP D Q:FBOUT
..N DA,DIK,FBDIRA,FBI S FBDIRA="Shall all of these claims be deleted"
..D READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP) Q:FBOUT!('FBALL)
..S FBI=0,DIK="^FB583(" F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA S DA=FBI D ^DIK I $$PEND^FBUCUTL(FBDA) D PENDDEL(FBI)
.W !,"Deleting claim" W $S('FBALL:"...",1:" and associated claims not dispositioned ...") S DA=FBDA,DIK="^FB583(" D ^DIK K DA,DIK
.I $$PEND^FBUCUTL(FBDA) D PENDDEL(FBDA)
DELQ D END^FBUCED Q
PENDDEL(FBDA) ;delete pending information on unauthorized claim
;INPUT: FBDA = internal entry number of unauthorized claim
;OUTPUT: none - pending information is deleted from file 162.8
Q:'$G(FBDA) N FBPEND,DA,DIK S DIK="^FBAA(162.8,",FBPEND=0
F S FBPEND=$O(^FBAA(162.8,"AC",FBDA,0)) Q:'FBPEND S DA=FBPEND D ^DIK K DA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCED1 1801 printed Dec 13, 2024@02:00:10 Page 2
FBUCED1 ;ALBISC/TET - EDIT UNAUTHORIZED CLAIM, cont'd
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
DEL ;deletes unauthorized claim(s); if any pending info will delete also
+1 ;only claims which have not been dispositioned can be deleted.
+2 NEW FBACT,FBO,DIRUT,DTOUT,DUOUT,Y
SET FBACT="DEL"
SET FBO="5^10^30^"
DO LOOKUP^FBUCUTL3(FBO)
if FBOUT!('+$GET(FBARY))
GOTO END^FBUCED
+3 NEW FBALL,FBDA,FBI,FBNODE,FBOUT,FBPL,FBW,FBZ
SET (FBALL,FBOUT)=0
DO PARSE^FBUCUTL4(FBARY)
+4 SET FBI=0
FOR
SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
if 'FBI
QUIT
SET FBNODE=$GET(^(FBI))
SET FBDA=+$PIECE(FBNODE,";")
SET FBZ=$$FBZ^FBUCUTL(FBDA)
IF FBZ]""
Begin DoDot:1
+5 NEW FBDISP,FBGROUP
DO LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
+6 NEW Y,DIRUT,DTOUT,DUOUT
SET DIR("A")="Are you sure you wish to delete"
SET DIR("B")="Y"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET FBOUT=1
if 'Y
QUIT
+7 DO GROUP^FBUCUTL7(FBZ,FBDA)
DO DISPLAY^FBUCUTL7(FBDA,.FBGROUP,"^5^10^30^",+$PIECE(FBZ,U,11))
+8 IF $$PRIME^FBUCUTL4(FBDA,FBZ)
DO PRIME^FBUCLNK1(.FBGROUP,FBDA,FBZ)
+9 IF +FBDISP
Begin DoDot:2
+10 NEW DA,DIK,FBDIRA,FBI
SET FBDIRA="Shall all of these claims be deleted"
+11 DO READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP)
if FBOUT!('FBALL)
QUIT
+12 SET FBI=0
SET DIK="^FB583("
FOR
SET FBI=$ORDER(FBGROUP(FBI))
if 'FBI
QUIT
IF FBI'=FBDA
SET DA=FBI
DO ^DIK
IF $$PEND^FBUCUTL(FBDA)
DO PENDDEL(FBI)
End DoDot:2
if FBOUT
QUIT
+13 WRITE !,"Deleting claim"
WRITE $SELECT('FBALL:"...",1:" and associated claims not dispositioned ...")
SET DA=FBDA
SET DIK="^FB583("
DO ^DIK
KILL DA,DIK
+14 IF $$PEND^FBUCUTL(FBDA)
DO PENDDEL(FBDA)
End DoDot:1
if FBOUT
GOTO DELQ
DELQ DO END^FBUCED
QUIT
PENDDEL(FBDA) ;delete pending information on unauthorized claim
+1 ;INPUT: FBDA = internal entry number of unauthorized claim
+2 ;OUTPUT: none - pending information is deleted from file 162.8
+3 if '$GET(FBDA)
QUIT
NEW FBPEND,DA,DIK
SET DIK="^FBAA(162.8,"
SET FBPEND=0
+4 FOR
SET FBPEND=$ORDER(^FBAA(162.8,"AC",FBDA,0))
if 'FBPEND
QUIT
SET DA=FBPEND
DO ^DIK
KILL DA
+5 QUIT
