source: WorldVistAEHR/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVDEL.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1ANRVDEL ;BHAM/LDT - DELETE ENTRY FROM VIST ROSTER FILE ; 04 May 98 / 8:21 AM
2 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
3EN ;Look up entry
4 K DIC S DIC=2040,DIC(0)="QEAM" D ^DIC I Y<0 G QUIT
5DELETE ;Deletes entry in 2040,2041.7,2042.5, and 2043.5
6 S ENTRY=+Y
7 N DIR,DIRUT,DUOUT
8 S DIR(0)="Y",DIR("A")="Do you want to delete the veteran from the VIST ROSTER file",DIR("B")="No"
9 S DIR("?")="Enter ""Yes"" to delete the veteran from the VIST ROSTER file, ""No"" to exit."
10 D ^DIR
11 I $D(DUOUT)!$D(DIRUT) G QUIT
12 I Y'=1 W ! G QUIT
13 W !!,"Deleting veteran from the VIST ROSTER file!" S DIK="^ANRV(2040,",DA=ENTRY D ^DIK
14 I $D(^ANRV(2041.7,"B",ENTRY)) S DIK="^ANRV(2041.7,",DA=$O(^ANRV(2041.7,"B",ENTRY,0)) D ^DIK
15 I $D(^ANRV(2042.5,"B",ENTRY)) S DIK="^ANRV(2042.5,",DA=$O(^ANRV(2042.5,"B",ENTRY,0)) D ^DIK
16 I $D(^ANRV(2043.5,"B",ENTRY)) S DIK="^ANRV(2043.5,",DA=$O(^ANRV(2043.5,"B",ENTRY,0)) D ^DIK
17 G QUIT
18 ;
19EN2 ;Delete entry in 2042.5 only
20 K DIC S DIC=2042.5,DIC(0)="QEAM" D ^DIC I Y<0 G QUIT
21 S ENTRY=+Y
22 N DIR,DIRUT,DUOUT
23 S DIR(0)="Y",DIR("A")="Do you want to delete the veteran from the VIST REFERRAL ROSTER file",DIR("B")="No"
24 S DIR("?")="Enter ""Yes"" to delete the veteran from the VIST REFERRAL ROSTER file, ""No"" to exit."
25 D ^DIR
26 I $D(DUOUT)!$D(DIRUT) G QUIT
27 I Y'=1 W ! G QUIT
28 W !!,"Deleting veteran from the VIST REFFERAL ROSTER file!" S DIK="^ANRV(2042.5,",DA=ENTRY D ^DIK
29 ;
30QUIT K DIK,DIC,DA,ENTRY,X,Y
31 Q
Note: See TracBrowser for help on using the repository browser.