source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVIPST.m@ 1651

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

initial load of WorldVistAEHR

File size: 1023 bytes
Line 
1ABSVIPST ;VAMC ALTOONA/CTB PRE/POST INIT ;4/30/02 3:27 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7,18,22,29**;JULY 6, 1994
3 ;;LOOP BY NAME
4 S NAME="" F S NAME=$O(^ABS(503330,"B",NAME)) Q:NAME="" S DA=0 F S DA=$O(^ABS(503330,"B",NAME,DA)) Q:'DA D
5 . Q:'$D(^ABS(503330,DA,4))
6 . S STANUM=0 F S STANUM=$O(^ABS(503330,DA,4,STANUM)) Q:STANUM="" D
7 . . S X=$G(^ABS(503330,DA,4,STANUM,0)) Q:X=""
8 . . S TERMDATE=$P(X,"^",8) Q:TERMDATE=""
9 . . I TERMDATE<2971001,$P(X,"^",11)="" S $P(X,"^",11)=TERMDATE,$P(X,"^",10)="Y",^ABS(503330,DA,4,STANUM,0)=X W !,NAME," - "," ",STANUM," ",TERMDATE
10 . . QUIT
11 .
12 ;;GET TERMINATION DATE
13 ;;I TERMINATION DATE < 2971001 SET PURGED DATE = TERM DATE AND PURGED? = YES
14 Q
15PRE ;PRE INIT TO DELETE DATA IN NATIONAL OFFICIALS FILE
16 N X,DIU
17 S DIU=503340,DIU(0)="TE" D EN^DIU2
18 S X=$G(^ABS(503334.1,0)) Q:X=""
19 K ^ABS(503334.1)
20 S ^ABS(503334.1,0)=$P(X,"^",1,2)
21 QUIT
22POST ;POST INIT TO REINDEX THE .01 FIELD ON FILE 503340 FOR ALL ENTRIES
23 N DIK
24 S DIK="^ABS(503340,",DIK(1)=.01 D ENALL^DIK
25 QUIT
Note: See TracBrowser for help on using the repository browser.