VALMPRE ;ALB/MJK - LM Pre-Init ;05:33 PM 15 Dec 1992;
;;1;List Manager;;Aug 13, 1993
;
EN ; -- pre-init
D PROT
Q
;
PROT ; -- delete old demo protocols
N VALMX,VALMI,DA,DIK,VALMPRE
S VALMPRE="VALM DEMO "
G PROTQ:$E($O(^ORD(101,"B",VALMPRE)),1,$L(VALMPRE))'=VALMPRE
W !!,">>> Will now delete demo protocols..."
S VALMX=VALMPRE
F S VALMX=$O(^ORD(101,"B",VALMX)) Q:VALMX=""!($E(VALMX,1,$L(VALMPRE))'=VALMPRE) D
.S VALMI=0 F S VALMI=$O(^ORD(101,"B",VALMX,VALMI)) Q:'VALMI D
..S DA=VALMI,DIK="^ORD(101," D ^DIK
..W !?10,"o ",VALMX,?45,"...deleted"
W !!,">>> A new set of demo protocols will be added during the install."
S DA=$O(^SD(409.61,"B","VALM OPTION DEMO",0)),DIK="^SD(409.61," D ^DIK:DA
PROTQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVALMPRE 738 printed Nov 22, 2024@17:20:13 Page 2
VALMPRE ;ALB/MJK - LM Pre-Init ;05:33 PM 15 Dec 1992;
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
EN ; -- pre-init
+1 DO PROT
+2 QUIT
+3 ;
PROT ; -- delete old demo protocols
+1 NEW VALMX,VALMI,DA,DIK,VALMPRE
+2 SET VALMPRE="VALM DEMO "
+3 if $EXTRACT($ORDER(^ORD(101,"B",VALMPRE)),1,$LENGTH(VALMPRE))'=VALMPRE
GOTO PROTQ
+4 WRITE !!,">>> Will now delete demo protocols..."
+5 SET VALMX=VALMPRE
+6 FOR
SET VALMX=$ORDER(^ORD(101,"B",VALMX))
if VALMX=""!($EXTRACT(VALMX,1,$LENGTH(VALMPRE))'=VALMPRE)
QUIT
Begin DoDot:1
+7 SET VALMI=0
FOR
SET VALMI=$ORDER(^ORD(101,"B",VALMX,VALMI))
if 'VALMI
QUIT
Begin DoDot:2
+8 SET DA=VALMI
SET DIK="^ORD(101,"
DO ^DIK
+9 WRITE !?10,"o ",VALMX,?45,"...deleted"
End DoDot:2
End DoDot:1
+10 WRITE !!,">>> A new set of demo protocols will be added during the install."
+11 SET DA=$ORDER(^SD(409.61,"B","VALM OPTION DEMO",0))
SET DIK="^SD(409.61,"
if DA
DO ^DIK
PROTQ QUIT
