- 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
- 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