ORLPURG ; slc/dcm - Purge Patient Lists ;8/13/90 12:27
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
EN ;Purge lists for terminated users
S ORPERS=0 F I=0:0 S ORPERS=$O(^OR(100.21,"C",ORPERS)) Q:ORPERS="" D 3
K ORPERS,ORLST,DA,DIK
Q
3 Q:'$D(^VA(200,ORPERS)) Q:'$P(^(ORPERS,0),"^",11) Q:$P($P(^(0),"^",11),".")'<DT
S ORLST=0 F I=0:0 S ORLST=$O(^OR(100.21,"C",ORPERS,ORLST)) Q:ORLST="" D 4
Q
4 S DA(1)=ORLST,DA=ORPERS,DIE="^OR(100.21,"_DA(1)_",1,",DR=".01///@;1///@" D ^DIE
I '$O(^OR(100.21,ORLST,1,0)) K DA S DA=ORLST,DIK="^OR(100.21," D ^DIK
K DA S DIE="^VA(200,",DA=ORPERS,DR="100.14///@;100.15///@;100.16///@;100.17///@;100.18///@;100.19///@;100.21///@;100.22///@" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLPURG 707 printed Dec 13, 2024@02:31:40 Page 2
ORLPURG ; slc/dcm - Purge Patient Lists ;8/13/90 12:27
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
EN ;Purge lists for terminated users
+1 SET ORPERS=0
FOR I=0:0
SET ORPERS=$ORDER(^OR(100.21,"C",ORPERS))
if ORPERS=""
QUIT
DO 3
+2 KILL ORPERS,ORLST,DA,DIK
+3 QUIT
3 if '$DATA(^VA(200,ORPERS))
QUIT
if '$PIECE(^(ORPERS,0),"^",11)
QUIT
if $PIECE($PIECE(^(0),"^",11),".")'<DT
QUIT
+1 SET ORLST=0
FOR I=0:0
SET ORLST=$ORDER(^OR(100.21,"C",ORPERS,ORLST))
if ORLST=""
QUIT
DO 4
+2 QUIT
4 SET DA(1)=ORLST
SET DA=ORPERS
SET DIE="^OR(100.21,"_DA(1)_",1,"
SET DR=".01///@;1///@"
DO ^DIE
+1 IF '$ORDER(^OR(100.21,ORLST,1,0))
KILL DA
SET DA=ORLST
SET DIK="^OR(100.21,"
DO ^DIK
+2 KILL DA
SET DIE="^VA(200,"
SET DA=ORPERS
SET DR="100.14///@;100.15///@;100.16///@;100.17///@;100.18///@;100.19///@;100.21///@;100.22///@"
DO ^DIE
+3 QUIT
