FBUCED1.m

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 ---FBUCED1   1801     printed  Apr 09, 2024@21:06:59                                                                                                                                                                                                     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