MCARENV.m

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

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