TIUEN113.m

TIUEN113 ; SLC/JAK - Environment Check for TIU*1*113 ;28-AUG-2001 08:43

 ;;1.0;TEXT INTEGRATION UTILITIES;**113**;Jun 20, 1997

MAIN ; -- Control Unit

 ; Check all Hospital Location entries for division and all

 ; Medical Center Division entries for institution file pointer;

 ; if not all data present, quit

 ;

 N CHKOK,TIULOC S CHKOK=1,TIULOC=0

 W !!,"Checking DIVISION for all Hospital Location file (#44)"

 W !,"entries <AND> INSTITUTION FILE POINTER for all Medical"

 W !,"Center Division file (#40.8) entries..."

 W !!

 ;

 F  S TIULOC=$O(^SC(TIULOC)) Q:'TIULOC!('CHKOK)  D

 . N TIUDVHL

 . S TIUDVHL=+$P($G(^SC(TIULOC,0)),U,15) I 'TIUDVHL S CHKOK=0 Q

 I CHKOK=1 D

 . N TIUDIV,TIUIFP S TIUDIV=0

 . F  S TIUDIV=$O(^DG(40.8,TIUDIV)) Q:'TIUDIV!('CHKOK)  D

 . . S TIUIFP=+$G(^DG(40.8,"ADV",TIUDIV)) I 'TIUIFP S CHKOK=0 Q

 ;

 I 'CHKOK D

 . S XPDQUIT=1 ; kill transport global from ^XTMP

 . W !,"Sorry...DIVISION cannot be determined for all Hospital"

 . W !,"Location file (#44) entries <AND/OR> INSTITUTION FILE"

 . W !,"POINTER cannot be determined for all Medical Center"

 . W !,"Division file (#40.8) entries. Please review and correct"

 . W !,"both files as necessary."

 . W !!,"** ABORTING INSTALLATION **"

 E  D

 . W !,"** Files are OK **"

 Q

TIUEN113  ; SLC/JAK - Environment Check for TIU*1*113 ;28-AUG-2001 08:43

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**113**;Jun 20, 1997

MAIN      ; -- Control Unit

 +1       ; Check all Hospital Location entries for division and all

 +2       ; Medical Center Division entries for institution file pointer;

 +3       ; if not all data present, quit

 +4       ;

 +5        NEW CHKOK,TIULOC

           SET CHKOK=1

           SET TIULOC=0

 +6        WRITE !!,"Checking DIVISION for all Hospital Location file (#44)"

 +7        WRITE !,"entries <AND> INSTITUTION FILE POINTER for all Medical"

 +8        WRITE !,"Center Division file (#40.8) entries..."

 +9        WRITE !!

 +10      ;

 +11       FOR 

               SET TIULOC=$ORDER(^SC(TIULOC))

               IF 'TIULOC!('CHKOK)

                   QUIT 

               Begin DoDot:1

 +12               NEW TIUDVHL

 +13               SET TIUDVHL=+$PIECE($GET(^SC(TIULOC,0)),U,15)

                   IF 'TIUDVHL

                       SET CHKOK=0

                       QUIT 

               End DoDot:1

 +14       IF CHKOK=1

               Begin DoDot:1

 +15               NEW TIUDIV,TIUIFP

                   SET TIUDIV=0

 +16               FOR 

                       SET TIUDIV=$ORDER(^DG(40.8,TIUDIV))

                       IF 'TIUDIV!('CHKOK)

                           QUIT 

                       Begin DoDot:2

 +17                       SET TIUIFP=+$GET(^DG(40.8,"ADV",TIUDIV))

                           IF 'TIUIFP

                               SET CHKOK=0

                               QUIT 

                       End DoDot:2

               End DoDot:1

 +18      ;

 +19       IF 'CHKOK

               Begin DoDot:1

 +20      ; kill transport global from ^XTMP

                   SET XPDQUIT=1

 +21               WRITE !,"Sorry...DIVISION cannot be determined for all Hospital"

 +22               WRITE !,"Location file (#44) entries <AND/OR> INSTITUTION FILE"

 +23               WRITE !,"POINTER cannot be determined for all Medical Center"

 +24               WRITE !,"Division file (#40.8) entries. Please review and correct"

 +25               WRITE !,"both files as necessary."

 +26               WRITE !!,"** ABORTING INSTALLATION **"

               End DoDot:1

 +27      IF '$TEST

               Begin DoDot:1

 +28               WRITE !,"** Files are OK **"

               End DoDot:1

 +29       QUIT