- LAPRE ; IHS/DIR/FJE - AUTO INSTRUMENTS PRE INIT 11:15 ; [ 5/10/90 ]
- ;;5.2;LA;;NOV 01, 1997
- ;;5.1;LAB;;04/11/91 11:06
- EN ;
- S U="^" I $S('$D(DUZ):1,'$D(^DIC(3,+DUZ)):1,'$D(IO):1,1:0) G DUZ
- I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) G DUZ0
- I DUZ(0)'="@" G DUZ0
- BEGIN D ASK
- END K DA,I,% G SET
- Q
- ASK F I=0:0 W !,"Do you wish to clear out and replace inactive auto instrument entries" S %=1 D YN^DICN Q:% D INFO
- Q:%'=1
- K S DIK="^LAB(62.4," F DA=99:0 S DA=$O(^LAB(62.4,DA)) Q:DA'>99 D ^DIK
- Q
- INFO W !!,"Answering YES will remove all auto instrument entries >99.",!,"This will not effect entries 1-99 (entries for on-line instruments).",!
- Q
- SET S:'$D(DTIME) DTIME=300 S U="^",%DT="T",X="NOW" D ^%DT S DT=$P(Y,".") D HOME^%ZIS
- W !,"THIS PRE INIT WILL REMOVE THE AUTOINSTRUMENT DD NODES AND REBUILD THEM.",!,"WE WILL ALSO BE REMOVING THE MICRO AUTOINSTRUMENT ORGANISM CROSS REFERENCES.",!
- W !!,"DO YOU WANT TO CONTINUE " S %=2 D YN^DICN I %'=1 K DIFQ Q
- 1 ;
- W !!!,"I WILL NOW REMOVE THE FILE 62.4 (AUTOINSTRUMENT) DD ENTRIES. THEY WILL BE",!,"REBUILT WHEN THE INIT RUNS.",!!
- S DIU=62.4,DIU(0)="" D EN^DIU2
- 2 W !!!,"WE WILL NOW REMOVE THE MICRO INSTRUMENT ORGANISM CROSS REFERENCES. THEY",!,"WILL BE REBUILT IN THE POST INIT.",!!
- S II=0 F JJ=0:0 S II=$O(^LAB(62.4,II)) Q:II<1 I $D(^LAB(62.4,II,7)) S KK=0 F JJ=0:0 S KK=$O(^LAB(62.4,II,7,KK)) Q:KK<1 K ^LAB(62.4,II,7,KK,1,"B"),^("C"),^("D")
- K ^LAB(69.91) S ^LAB(69.91,0)="LR ROUTINE INTEGRITY CHECKER^69.91I^0^0"
- W !,"PRE INIT CONCLUDED. MOVING TO INITS.",!!
- Q
- DUZ W !!?10,"Please log in using access and verify codes",!!,*7 K DIFQ Q
- DUZ0 W !!?10,"You do not have programmer access in your fileman access code",!!,*7 K DIFQ Q
- Q
- LAPRE ; IHS/DIR/FJE - AUTO INSTRUMENTS PRE INIT 11:15 ; [ 5/10/90 ]
- +1 ;;5.2;LA;;NOV 01, 1997
- +2 ;;5.1;LAB;;04/11/91 11:06
- EN ;
- +1 SET U="^"
- IF $SELECT('$DATA(DUZ):1,'$DATA(^DIC(3,+DUZ)):1,'$DATA(IO):1,1:0)
- GOTO DUZ
- +2 IF $SELECT('$DATA(DUZ(0)):1,DUZ(0)'="@":1,1:0)
- GOTO DUZ0
- +3 IF DUZ(0)'="@"
- GOTO DUZ0
- BEGIN DO ASK
- END KILL DA,I,%
- GOTO SET
- +1 QUIT
- ASK FOR I=0:0
- WRITE !,"Do you wish to clear out and replace inactive auto instrument entries"
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- DO INFO
- +1 IF %'=1
- QUIT
- K SET DIK="^LAB(62.4,"
- FOR DA=99:0
- SET DA=$ORDER(^LAB(62.4,DA))
- IF DA'>99
- QUIT
- DO ^DIK
- +1 QUIT
- INFO WRITE !!,"Answering YES will remove all auto instrument entries >99.",!,"This will not effect entries 1-99 (entries for on-line instruments).",!
- +1 QUIT
- SET IF '$DATA(DTIME)
- SET DTIME=300
- SET U="^"
- SET %DT="T"
- SET X="NOW"
- DO ^%DT
- SET DT=$PIECE(Y,".")
- DO HOME^%ZIS
- +1 WRITE !,"THIS PRE INIT WILL REMOVE THE AUTOINSTRUMENT DD NODES AND REBUILD THEM.",!,"WE WILL ALSO BE REMOVING THE MICRO AUTOINSTRUMENT ORGANISM CROSS REFERENCES.",!
- +2 WRITE !!,"DO YOU WANT TO CONTINUE "
- SET %=2
- DO YN^DICN
- IF %'=1
- KILL DIFQ
- QUIT
- 1 ;
- +1 WRITE !!!,"I WILL NOW REMOVE THE FILE 62.4 (AUTOINSTRUMENT) DD ENTRIES. THEY WILL BE",!,"REBUILT WHEN THE INIT RUNS.",!!
- +2 SET DIU=62.4
- SET DIU(0)=""
- DO EN^DIU2
- 2 WRITE !!!,"WE WILL NOW REMOVE THE MICRO INSTRUMENT ORGANISM CROSS REFERENCES. THEY",!,"WILL BE REBUILT IN THE POST INIT.",!!
- +1 SET II=0
- FOR JJ=0:0
- SET II=$ORDER(^LAB(62.4,II))
- IF II<1
- QUIT
- IF $DATA(^LAB(62.4,II,7))
- SET KK=0
- FOR JJ=0:0
- SET KK=$ORDER(^LAB(62.4,II,7,KK))
- IF KK<1
- QUIT
- KILL ^LAB(62.4,II,7,KK,1,"B"),^("C"),^("D")
- +2 KILL ^LAB(69.91)
- SET ^LAB(69.91,0)="LR ROUTINE INTEGRITY CHECKER^69.91I^0^0"
- +3 WRITE !,"PRE INIT CONCLUDED. MOVING TO INITS.",!!
- +4 QUIT
- DUZ WRITE !!?10,"Please log in using access and verify codes",!!,*7
- KILL DIFQ
- QUIT
- DUZ0 WRITE !!?10,"You do not have programmer access in your fileman access code",!!,*7
- KILL DIFQ
- QUIT
- +1 QUIT
