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 ---[H[J[2J[HIBDEPRE 1174 printed Dec 13, 2024@02:50:34 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)
