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 Nov 22, 2024@17:52 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
