source: WorldVistAEHR/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXPPED.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1AFJXPPED ;FJ/CWS;NETWORK HEALTH EXCHANGE ONE-TIME PSUEDO,ZZ's,EMPLOYEE PURGE;11/8/95 ;2/22/96 13:58
2 ;;5.1;Network Health Exchange;;Jan 23, 1996
3START S U="^"
4 S ZTSAVE("*")="",ZTIO="",ZTRTN="ONE^AFJXPPED",ZTDESC="ONE-TIME PURGE PSUEDO,ZZs,EMPLOYEE-537010" D ^%ZTLOAD
5 Q
6ONE ; Purge psuedos,employees,zz's
7 D THREE,FIVE ;CFB/SF/TUSC TO SPEED UP
8 Q
9TWO S SS="" F S SS=$O(^AFJ(537010,"B",SS)),INT="" Q:SS="" F S INT=$O(^AFJ(537010,"B",SS,INT)) Q:INT="" D PSU
10 Q
11PSU I SS["P"!(SS?5"0"4N) S DIK="^AFJ(537010,",DA=INT D ^DIK ;CFB/SF/TUSC INPLEMENT VHA DIR 96-0006
12 Q
13THREE S SS="" F S SS=$O(^AFJ(537010,"B",SS)),INT="" Q:SS="" F S INT=$O(^AFJ(537010,"B",SS,INT)) Q:INT="" S NAM=$P($G(^AFJ(537010,INT,0)),U,3) D EMP,PSU,ZZZ,CHAR ;CFB/SF/TUSC TO SPEED UP
14 Q
15EMP Q:$E(NAM,1,3)'="EEE"
16 S DIK="^AFJ(537010,",DA=INT D ^DIK
17 Q
18FOUR S SS="" F S SS=$O(^AFJ(537010,"B",SS)),INT="" Q:SS="" F S INT=$O(^AFJ(537010,"B",SS,INT)) Q:INT="" S NAM=$P($G(^AFJ(537010,INT,0)),U,3) D ZZZ
19 Q
20ZZZ Q:$E(NAM,1,2)'="ZZ"
21 S DIK="^AFJ(537010,",DA=INT D ^DIK
22 Q
23FIVE S SS="" F S SS=$O(^AFJ(537010,"B",SS)),INT="" Q:SS="" S INT=$O(^AFJ(537010,"B",SS,INT)) Q:INT="" S INT1=INT F J=1:1 S INT1=$O(^AFJ(537010,"B",SS,INT1)) Q:INT1="" Q:J<1 D DUP
24 Q
25DUP S DIK="^AFJ(537010,",DA=INT1 D ^DIK
26 Q
27SIX S SS="" F S SS=$O(^AFJ(537010,"B",SS)),INT="" Q:SS="" F S INT=$O(^AFJ(537010,"B",SS,INT)) Q:INT="" D CHAR
28 Q
29CHAR Q:SS?9N
30 S DIK="^AFJ(537010,",DA=INT D ^DIK
31 Q
Note: See TracBrowser for help on using the repository browser.