32 lines
1.4 KiB
Mathematica
32 lines
1.4 KiB
Mathematica
AFJXPPED ;FJ/CWS;NETWORK HEALTH EXCHANGE ONE-TIME PSUEDO,ZZ's,EMPLOYEE PURGE;11/8/95 ;2/22/96 13:58
|
|
;;5.1;Network Health Exchange;;Jan 23, 1996
|
|
START S U="^"
|
|
S ZTSAVE("*")="",ZTIO="",ZTRTN="ONE^AFJXPPED",ZTDESC="ONE-TIME PURGE PSUEDO,ZZs,EMPLOYEE-537010" D ^%ZTLOAD
|
|
Q
|
|
ONE ; Purge psuedos,employees,zz's
|
|
D THREE,FIVE ;CFB/SF/TUSC TO SPEED UP
|
|
Q
|
|
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
|
|
Q
|
|
PSU I SS["P"!(SS?5"0"4N) S DIK="^AFJ(537010,",DA=INT D ^DIK ;CFB/SF/TUSC INPLEMENT VHA DIR 96-0006
|
|
Q
|
|
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
|
|
Q
|
|
EMP Q:$E(NAM,1,3)'="EEE"
|
|
S DIK="^AFJ(537010,",DA=INT D ^DIK
|
|
Q
|
|
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
|
|
Q
|
|
ZZZ Q:$E(NAM,1,2)'="ZZ"
|
|
S DIK="^AFJ(537010,",DA=INT D ^DIK
|
|
Q
|
|
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
|
|
Q
|
|
DUP S DIK="^AFJ(537010,",DA=INT1 D ^DIK
|
|
Q
|
|
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
|
|
Q
|
|
CHAR Q:SS?9N
|
|
S DIK="^AFJ(537010,",DA=INT D ^DIK
|
|
Q
|