- DGDEPINA ;ALB/CAW Inactivate veteran when date of death entered; 11/14/94
- ;;5.3;Registration;**45**;Aug 13, 1993
- ;
- SET N DGACT,DA,DGPR,DGPR0,DGPR1,DIK
- S DA=$O(^DGPR(408.12,"B",DFN,"")) I 'DA G SETQ
- S DGACT=X
- L +^DGPR(408.12,DA)
- S DGPR=^DGPR(408.12,+DA,"E",0),DGPR0=$P(DGPR,U,3)+1,DGPR1=$P(DGPR,U,4)+1
- S ^DGPR(408.12,+DA,"E",0)="^408.1275D^"_DGPR0_U_DGPR1
- S ^DGPR(408.12,+DA,"E",DGPR0,0)=DGACT_"^"_0
- S DIK="^DGPR(408.12,"
- D IX1^DIK
- L -^DGPR(408.12,+DA)
- SETQ Q
- ;
- KILL ;
- N DA,DGPR,DGPR0,DGPR1,DIK
- S DA=$O(^DGPR(408.12,"B",DFN,"")) I 'DA G KILLQ
- S DGACT=X
- S DA(1)=DA,DA=$O(^DGPR(408.12,DA,"E","AID",-DGACT,""))
- I 'DA G KILLQ
- S DIK="^DGPR(408.12,"_DA(1)_",""E"","
- D ^DIK
- KILLQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGDEPINA 717 printed Feb 19, 2025@00:08:04 Page 2
- DGDEPINA ;ALB/CAW Inactivate veteran when date of death entered; 11/14/94
- +1 ;;5.3;Registration;**45**;Aug 13, 1993
- +2 ;
- SET NEW DGACT,DA,DGPR,DGPR0,DGPR1,DIK
- +1 SET DA=$ORDER(^DGPR(408.12,"B",DFN,""))
- IF 'DA
- GOTO SETQ
- +2 SET DGACT=X
- +3 LOCK +^DGPR(408.12,DA)
- +4 SET DGPR=^DGPR(408.12,+DA,"E",0)
- SET DGPR0=$PIECE(DGPR,U,3)+1
- SET DGPR1=$PIECE(DGPR,U,4)+1
- +5 SET ^DGPR(408.12,+DA,"E",0)="^408.1275D^"_DGPR0_U_DGPR1
- +6 SET ^DGPR(408.12,+DA,"E",DGPR0,0)=DGACT_"^"_0
- +7 SET DIK="^DGPR(408.12,"
- +8 DO IX1^DIK
- +9 LOCK -^DGPR(408.12,+DA)
- SETQ QUIT
- +1 ;
- KILL ;
- +1 NEW DA,DGPR,DGPR0,DGPR1,DIK
- +2 SET DA=$ORDER(^DGPR(408.12,"B",DFN,""))
- IF 'DA
- GOTO KILLQ
- +3 SET DGACT=X
- +4 SET DA(1)=DA
- SET DA=$ORDER(^DGPR(408.12,DA,"E","AID",-DGACT,""))
- +5 IF 'DA
- GOTO KILLQ
- +6 SET DIK="^DGPR(408.12,"_DA(1)_",""E"","
- +7 DO ^DIK
- KILLQ QUIT
