DGDEP5 ;ALB/CAW - Delete Duplicate Dependents ;12/15/94
;;5.3;Registration;**45,1015**;Aug 13, 1993;Build 21
EN ;
N BEG,DATE
I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G ENQ
I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
I '$D(^XUSEC("DG DEPDELETE",+DUZ)) W !!,"Access to this option requires a security key.",*7 H 2 G ENQ
S BEG=2 D SEL^DGDEPU G ENQ:$G(DGERR)
S DATE="" F S DATE=$O(DGDEP(DGW,DATE)) Q:'DATE I $P(DGDEP(DGW,DATE),U,3) W !!,"Dependent has been uploaded by IVM. Cannot delete." H 2 G ENQ
I '$$ASSOC(DFN,DGDEP(DGW)) D DEL(DFN,DGDEP(DGW),DGDEP(1),$G(DGMTI))
ENQ S VALMBCK="R"
D INIT^DGDEP
Q
;
DEL(DFN,DGDEP,DGVDEP,DGMTI) ;Delete Dependent
;
N DGPRI,DGINC,DGINP,DGINR,DGMTP,DGMTA,DGMTACT,DGMTINF
I $G(DGMTI) S DGMTACT="DDP",DGMTINF=1 D PRIOR^DGMTEVT
S DGPRI=$P(DGDEP,U,20)
S DGINP=+$P($G(^DGPR(408.12,+DGPRI,0)),U,3)
S DGINC=0 F S DGINC=$O(^DGMT(408.21,"C",DGPRI,DGINC)) Q:'DGINC D D DIK(DGINC,"^DGMT(408.21,")
.S DGINR=0 F S DGINR=$O(^DGMT(408.22,"AIND",DGINC,DGINR)) Q:'DGINR D DIK(DGINR,"^DGMT(408.22,")
D DIK(DGPRI,"^DGPR(408.12,")
D DIK(DGINP,"^DGPR(408.13,")
I $G(DGMTI) D
.S DGVIRI=$P(DGVDEP,U,22) D DEP^DGMTSC1,AFTER^DGMTEVT
.D SET^DGMTAUD
W !,"...deleting ANNUAL INCOME..."
W !,"...deleting INCOME RELATION..."
W !,"...deleting PERSON..."
W !,"...deleting INCOME PERSON..."
K DA,DIK
Q Q
;
DIK(DA,DIK) ;Delete file entries
;
D ^DIK
Q
;
ASSOC(DFN,DGDEP) ; Find out if dependent is associated with any MT
;
N DGPER,DGINCP,DGX,DGY,DGZ
S (DGX,DGZ)=0
F S DGX=$O(^DGMT(408.31,"ADFN"_DFN,DGX)) Q:'DGX!(DGZ) S MTIEN=$O(^DGMT(408.31,"ADFN"_DFN,DGX,"")) I MTIEN D
.S DGY=0
.F S DGY=$O(^DGMT(408.22,"AMT",MTIEN,DFN,DGY)) Q:'DGY!(DGZ) D
..S DGPER=$P($G(^DGMT(408.21,+DGY,0)),U,2)
..I DGPER=$P(DGDEP,U,20) D
...W !,"This dependent is associated with a means test. You must remove the"
...W !,"dependent from ALL means/co-pay tests prior to deleting. Use the 'RE' action." H 2 S DGZ=1 Q
ASSOCQ Q DGZ
DGDEP5 ;ALB/CAW - Delete Duplicate Dependents ;12/15/94
+1 ;;5.3;Registration;**45,1015**;Aug 13, 1993;Build 21
EN ;
+1 NEW BEG,DATE
+2 IF $GET(DGMTI)
IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a means test."
HANG 2
GOTO ENQ
+3 IF '$DATA(DGMTI)
IF $GET(DGRPV)=1
WRITE !,"Not while viewing"
HANG 2
GOTO ENQ
+4 IF '$DATA(^XUSEC("DG DEPDELETE",+DUZ))
WRITE !!,"Access to this option requires a security key.",*7
HANG 2
GOTO ENQ
+5 SET BEG=2
DO SEL^DGDEPU
IF $GET(DGERR)
GOTO ENQ
+6 SET DATE=""
FOR
SET DATE=$ORDER(DGDEP(DGW,DATE))
IF 'DATE
QUIT
IF $PIECE(DGDEP(DGW,DATE),U,3)
WRITE !!,"Dependent has been uploaded by IVM. Cannot delete."
HANG 2
GOTO ENQ
+7 IF '$$ASSOC(DFN,DGDEP(DGW))
DO DEL(DFN,DGDEP(DGW),DGDEP(1),$GET(DGMTI))
ENQ SET VALMBCK="R"
+1 DO INIT^DGDEP
+2 QUIT
+3 ;
DEL(DFN,DGDEP,DGVDEP,DGMTI) ;Delete Dependent
+1 ;
+2 NEW DGPRI,DGINC,DGINP,DGINR,DGMTP,DGMTA,DGMTACT,DGMTINF
+3 IF $GET(DGMTI)
SET DGMTACT="DDP"
SET DGMTINF=1
DO PRIOR^DGMTEVT
+4 SET DGPRI=$PIECE(DGDEP,U,20)
+5 SET DGINP=+$PIECE($GET(^DGPR(408.12,+DGPRI,0)),U,3)
+6 SET DGINC=0
FOR
SET DGINC=$ORDER(^DGMT(408.21,"C",DGPRI,DGINC))
IF 'DGINC
QUIT
Begin DoDot:1
+7 SET DGINR=0
FOR
SET DGINR=$ORDER(^DGMT(408.22,"AIND",DGINC,DGINR))
IF 'DGINR
QUIT
DO DIK(DGINR,"^DGMT(408.22,")
End DoDot:1
DO DIK(DGINC,"^DGMT(408.21,")
+8 DO DIK(DGPRI,"^DGPR(408.12,")
+9 DO DIK(DGINP,"^DGPR(408.13,")
+10 IF $GET(DGMTI)
Begin DoDot:1
+11 SET DGVIRI=$PIECE(DGVDEP,U,22)
DO DEP^DGMTSC1
DO AFTER^DGMTEVT
+12 DO SET^DGMTAUD
End DoDot:1
+13 WRITE !,"...deleting ANNUAL INCOME..."
+14 WRITE !,"...deleting INCOME RELATION..."
+15 WRITE !,"...deleting PERSON..."
+16 WRITE !,"...deleting INCOME PERSON..."
+17 KILL DA,DIK
Q QUIT
+1 ;
DIK(DA,DIK) ;Delete file entries
+1 ;
+2 DO ^DIK
+3 QUIT
+4 ;
ASSOC(DFN,DGDEP) ; Find out if dependent is associated with any MT
+1 ;
+2 NEW DGPER,DGINCP,DGX,DGY,DGZ
+3 SET (DGX,DGZ)=0
+4 FOR
SET DGX=$ORDER(^DGMT(408.31,"ADFN"_DFN,DGX))
IF 'DGX!(DGZ)
QUIT
SET MTIEN=$ORDER(^DGMT(408.31,"ADFN"_DFN,DGX,""))
IF MTIEN
Begin DoDot:1
+5 SET DGY=0
+6 FOR
SET DGY=$ORDER(^DGMT(408.22,"AMT",MTIEN,DFN,DGY))
IF 'DGY!(DGZ)
QUIT
Begin DoDot:2
+7 SET DGPER=$PIECE($GET(^DGMT(408.21,+DGY,0)),U,2)
+8 IF DGPER=$PIECE(DGDEP,U,20)
Begin DoDot:3
+9 WRITE !,"This dependent is associated with a means test. You must remove the"
+10 WRITE !,"dependent from ALL means/co-pay tests prior to deleting. Use the 'RE' action."
HANG 2
SET DGZ=1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
ASSOCQ QUIT DGZ
