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