DGDEPINA.m

DGDEPINA ;ALB/CAW Inactivate veteran when date of death entered; 11/14/94

 ;;5.3;Registration;**45,1015**;Aug 13, 1993;Build 21

 ;

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

DGDEPINA  ;ALB/CAW Inactivate veteran when date of death entered; 11/14/94

 +1       ;;5.3;Registration;**45,1015**;Aug 13, 1993;Build 21

 +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