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 Nov 22, 2024@17:50:09 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
