IBDEPRE.m

IBDEPRE ; ALB/ISC - PREINIT FOR USE BY IMP/EXP UTILITY ;AUG 13, 1993

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;

P D NOW^%DTC S IBDBDT("IBDE")=$H,DT=$$DT^XLFDT,Y=% W !!,"Initialization Started: " D DT^DIQ

 ;

 ;

PRE W !!

 ;

USER I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,'$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !!?3,"The variable DUZ must be set to an active user code and the variable",!?3,"DUZ(0) must equal '@' to initialize.",! K DIFQ G NO

 ;

 Q:'$D(DIFQ)

 ;

CHECK ;checks if there is anything in the workspace

 N COUNT,FILE,QUIT

 S (QUIT,COUNT)=0

 F  S FILE=$P($T(FILES+COUNT),";;",2) Q:QUIT!(FILE="")  D  Q:QUIT

 .S COUNT=COUNT+1

 .I $O(@FILE@(0)) D

 ..K DIR S DIR(0)="Y",DIR("B")="YES"

 ..W !,"Please check your work space from the import/export utility option.",!!,"These INITS require that your work space be clear, currently it is not.",!,"Would you like to clear the work space now?"

 ..D ^DIR

 ..I $D(DIRUT)!(Y=0) K DIFQ

 ..S QUIT=1

 ;

 I '$D(DIFQ) W !,"INITIALIZATION ABORTED" K IBDBDT

 K DIR,DIRUT,DUOUT

 Q

 ;

NO I '$D(DIFQ) W !,"INITIALIZATION ABORTED" K IBDBDT

 K DIR,DIRUT,DUOUT

 Q

 ;

FILES ;;^IBE(358)

 ;;^IBE(358.1)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBDEPRE   1174     printed  Apr 09, 2024@21:45:15                                                                                                                                                                                                     Page 2

IBDEPRE   ; ALB/ISC - PREINIT FOR USE BY IMP/EXP UTILITY ;AUG 13, 1993

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

P          DO NOW^%DTC

           SET IBDBDT("IBDE")=$HOROLOG

           SET DT=$$DT^XLFDT

           SET Y=%

           WRITE !!,"Initialization Started: "

           DO DT^DIQ

 +1       ;

 +2       ;

PRE        WRITE !!

 +1       ;

USER       IF $SELECT('($DATA(DUZ)#2):1,'$DATA(^VA(200,+DUZ,0)):1,'$DATA(DUZ(0)):1,DUZ(0)'="@":1,1:0)

               WRITE !!?3,"The variable DUZ must be set to an active user code and the variable",!?3,"DUZ(0) must equal '@' to initialize.",!

               KILL DIFQ

               GOTO NO

 +1       ;

 +2        if '$DATA(DIFQ)

               QUIT 

 +3       ;

CHECK     ;checks if there is anything in the workspace

 +1        NEW COUNT,FILE,QUIT

 +2        SET (QUIT,COUNT)=0

 +3        FOR 

               SET FILE=$PIECE($TEXT(FILES+COUNT),";;",2)

               if QUIT!(FILE="")

                   QUIT 

               Begin DoDot:1

 +4                SET COUNT=COUNT+1

 +5                IF $ORDER(@FILE@(0))

                       Begin DoDot:2

 +6                        KILL DIR

                           SET DIR(0)="Y"

                           SET DIR("B")="YES"

 +7                        WRITE !,"Please check your work space from the import/export utility option.",!!,"These INITS require that your work space be clear, currently it is not.",!,"Would you like to clear the work space now?"

 +8                        DO ^DIR

 +9                        IF $DATA(DIRUT)!(Y=0)

                               KILL DIFQ

 +10                       SET QUIT=1

                       End DoDot:2

               End DoDot:1

               if QUIT

                   QUIT 

 +11      ;

 +12       IF '$DATA(DIFQ)

               WRITE !,"INITIALIZATION ABORTED"

               KILL IBDBDT

 +13       KILL DIR,DIRUT,DUOUT

 +14       QUIT 

 +15      ;

NO         IF '$DATA(DIFQ)

               WRITE !,"INITIALIZATION ABORTED"

               KILL IBDBDT

 +1        KILL DIR,DIRUT,DUOUT

 +2        QUIT 

 +3       ;

FILES     ;;^IBE(358)

 +1       ;;^IBE(358.1)