source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGDEPINA.m@ 1799

Last change on this file since 1799 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 693 bytes
RevLine 
[613]1DGDEPINA ;ALB/CAW Inactivate veteran when date of death entered; 11/14/94
2 ;;5.3;Registration;**45**;Aug 13, 1993
3 ;
4SET N DGACT,DA,DGPR,DGPR0,DGPR1,DIK
5 S DA=$O(^DGPR(408.12,"B",DFN,"")) I 'DA G SETQ
6 S DGACT=X
7 L +^DGPR(408.12,DA)
8 S DGPR=^DGPR(408.12,+DA,"E",0),DGPR0=$P(DGPR,U,3)+1,DGPR1=$P(DGPR,U,4)+1
9 S ^DGPR(408.12,+DA,"E",0)="^408.1275D^"_DGPR0_U_DGPR1
10 S ^DGPR(408.12,+DA,"E",DGPR0,0)=DGACT_"^"_0
11 S DIK="^DGPR(408.12,"
12 D IX1^DIK
13 L -^DGPR(408.12,+DA)
14SETQ Q
15 ;
16KILL ;
17 N DA,DGPR,DGPR0,DGPR1,DIK
18 S DA=$O(^DGPR(408.12,"B",DFN,"")) I 'DA G KILLQ
19 S DGACT=X
20 S DA(1)=DA,DA=$O(^DGPR(408.12,DA,"E","AID",-DGACT,""))
21 I 'DA G KILLQ
22 S DIK="^DGPR(408.12,"_DA(1)_",""E"","
23 D ^DIK
24KILLQ Q
Note: See TracBrowser for help on using the repository browser.