VALMPRE.m

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

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