| [613] | 1 | AFJXPPED ;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
|
|---|
| 3 | START S U="^"
|
|---|
| 4 | S ZTSAVE("*")="",ZTIO="",ZTRTN="ONE^AFJXPPED",ZTDESC="ONE-TIME PURGE PSUEDO,ZZs,EMPLOYEE-537010" D ^%ZTLOAD
|
|---|
| 5 | Q
|
|---|
| 6 | ONE ; Purge psuedos,employees,zz's
|
|---|
| 7 | D THREE,FIVE ;CFB/SF/TUSC TO SPEED UP
|
|---|
| 8 | Q
|
|---|
| 9 | TWO 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
|
|---|
| 11 | PSU 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
|
|---|
| 13 | THREE 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
|
|---|
| 15 | EMP Q:$E(NAM,1,3)'="EEE"
|
|---|
| 16 | S DIK="^AFJ(537010,",DA=INT D ^DIK
|
|---|
| 17 | Q
|
|---|
| 18 | FOUR 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
|
|---|
| 20 | ZZZ Q:$E(NAM,1,2)'="ZZ"
|
|---|
| 21 | S DIK="^AFJ(537010,",DA=INT D ^DIK
|
|---|
| 22 | Q
|
|---|
| 23 | FIVE 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
|
|---|
| 25 | DUP S DIK="^AFJ(537010,",DA=INT1 D ^DIK
|
|---|
| 26 | Q
|
|---|
| 27 | SIX 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
|
|---|
| 29 | CHAR Q:SS?9N
|
|---|
| 30 | S DIK="^AFJ(537010,",DA=INT D ^DIK
|
|---|
| 31 | Q
|
|---|
