- DGDEP5 ;ALB/CAW - Delete Duplicate Dependents ;12/15/94
- ;;5.3;Registration;**45**;Aug 13, 1993
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGDEP5 2046 printed Jan 18, 2025@03:42:40 Page 2
- DGDEP5 ;ALB/CAW - Delete Duplicate Dependents ;12/15/94
- +1 ;;5.3;Registration;**45**;Aug 13, 1993
- 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