- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEN113 1280 printed Mar 13, 2025@21:45:05 Page 2
- 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