MCARENV ;WISC/MLH-MEDICINE PACKAGE INSTALLATION-ENVIRONMENT CHECK ROUTINE #1 ;10/19/92 09:31
;;2.3;Medicine;;09/13/1996
;
N AA,DDR,BB,FOUND
W:$D(IOF) @IOF ; clear screen
W !,"ENVIRONMENT CHECK:"
;
; Look at every file in Medicine (690-701 inclusive) for pointers
; to files 3-6-16. If any exist, stop here and instruct the user
; to repoint these entries to File 200 (NEW PERSON).
W !,"Before initialization, this routine will verify whether the"
W !,"package file entries have been converted to the NEW PERSON file."
W !!,"Checking..."
S (FOUND,END)=0
S AA=690
FOR D Q:FOUND!END
. W "." ; let user know we're making progress
. S BB=0
. FOR S BB=$O(^DD(AA,BB)) Q:'BB D Q:FOUND
.. S DDR=^DD(AA,BB,0) ; main data dictionary record
.. F II=1:1:4 S DDR(II)=$P(DDR,"^",II)
.. ;
.. S FIL=$P($P(DDR(3),"DIC(",2),",",1)
.. I (FIL=3)!(FIL=6)!(FIL=16) S FOUND=1
.. Q
. ;END FOR
. IF 'FOUND D
.. S AA=$O(^DD(AA))
.. I 'AA!(AA'<705) S END=1
.. Q
. ;END IF
. Q
I FOUND D ; Abort the init with an explanation.
. S OKTOGO=0
E D
. S OKTOGO=1
. W !!,"OK, there aren't any unconverted pointers."
. S DIR(0)="E",DIR("A")="Hit <RETURN> to continue" D ^DIR ; pause before the next round
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARENV 1316 printed Nov 22, 2024@17:22:53 Page 2
MCARENV ;WISC/MLH-MEDICINE PACKAGE INSTALLATION-ENVIRONMENT CHECK ROUTINE #1 ;10/19/92 09:31
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 NEW AA,DDR,BB,FOUND
+4 ; clear screen
if $DATA(IOF)
WRITE @IOF
+5 WRITE !,"ENVIRONMENT CHECK:"
+6 ;
+7 ; Look at every file in Medicine (690-701 inclusive) for pointers
+8 ; to files 3-6-16. If any exist, stop here and instruct the user
+9 ; to repoint these entries to File 200 (NEW PERSON).
+10 WRITE !,"Before initialization, this routine will verify whether the"
+11 WRITE !,"package file entries have been converted to the NEW PERSON file."
+12 WRITE !!,"Checking..."
+13 SET (FOUND,END)=0
+14 SET AA=690
+15 FOR
Begin DoDot:1
+16 ; let user know we're making progress
WRITE "."
+17 SET BB=0
+18 FOR
SET BB=$ORDER(^DD(AA,BB))
if 'BB
QUIT
Begin DoDot:2
+19 ; main data dictionary record
SET DDR=^DD(AA,BB,0)
+20 FOR II=1:1:4
SET DDR(II)=$PIECE(DDR,"^",II)
+21 ;
+22 SET FIL=$PIECE($PIECE(DDR(3),"DIC(",2),",",1)
+23 IF (FIL=3)!(FIL=6)!(FIL=16)
SET FOUND=1
+24 QUIT
End DoDot:2
if FOUND
QUIT
+25 ;END FOR
+26 IF 'FOUND
Begin DoDot:2
+27 SET AA=$ORDER(^DD(AA))
+28 IF 'AA!(AA'<705)
SET END=1
+29 QUIT
End DoDot:2
+30 ;END IF
+31 QUIT
End DoDot:1
if FOUND!END
QUIT
+32 ; Abort the init with an explanation.
IF FOUND
Begin DoDot:1
+33 SET OKTOGO=0
End DoDot:1
+34 IF '$TEST
Begin DoDot:1
+35 SET OKTOGO=1
+36 WRITE !!,"OK, there aren't any unconverted pointers."
+37 ; pause before the next round
SET DIR(0)="E"
SET DIR("A")="Hit <RETURN> to continue"
DO ^DIR
End DoDot:1
+38 QUIT
