TIUEN234 ; SLC/MAM - Environment Check Rtn for TIU*1*234 ; 12/11/07
;;1.0;Text Integration Utilities;**234**;Jun 20, 1997;Build 6
; External References
; ICR 3409 ^USR(8930,"B"
; ICR 1544 WHOIS2^USRLM
MAIN ; Check environment. If AMEND classes not found, abort install.
N TIUOK S TIUOK=0
N TIUCLS,TIULST S TIUCLS=+$O(^USR(8930,"B","CHIEF, MIS",""))
I TIUCLS>0 D I +TIUOK G MAINX
. D WHOIS2^USRLM("TIULST",TIUCLS)
. I $P(TIULST(0),U,3)>0 S TIUOK=1
N TIUCLS,TIULST S TIUCLS=+$O(^USR(8930,"B","CHIEF, HIM",""))
I TIUCLS>0 D I +TIUOK G MAINX
. D WHOIS2^USRLM("TIULST",TIUCLS)
. I $P(TIULST(0),U,3)>0 S TIUOK=1
N TIUCLS,TIULST S TIUCLS=+$O(^USR(8930,"B","PRIVACY ACT OFFICER",""))
I TIUCLS>0 D I TIUOK G MAINX
. D WHOIS2^USRLM("TIULST",TIUCLS)
. I $P(TIULST(0),U,3)>0 S TIUOK=1
S XPDABORT=1
W !," Documents cannot be amended except by members of class CHIEF, MIS,"
W !,"CHIEF, HIM, or PRIVACY ACT OFFICER. (Classes must be named exactly as listed.)"
W !," I can't find any users in these classes. Please check with the person who"
W !,"maintains User Classes at your site."
W !," Aborting install."
MAINX ;
I TIUOK W !," User Classes look ok."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEN234 1211 printed Nov 22, 2024@17:50:13 Page 2
TIUEN234 ; SLC/MAM - Environment Check Rtn for TIU*1*234 ; 12/11/07
+1 ;;1.0;Text Integration Utilities;**234**;Jun 20, 1997;Build 6
+2 ; External References
+3 ; ICR 3409 ^USR(8930,"B"
+4 ; ICR 1544 WHOIS2^USRLM
MAIN ; Check environment. If AMEND classes not found, abort install.
+1 NEW TIUOK
SET TIUOK=0
+2 NEW TIUCLS,TIULST
SET TIUCLS=+$ORDER(^USR(8930,"B","CHIEF, MIS",""))
+3 IF TIUCLS>0
Begin DoDot:1
+4 DO WHOIS2^USRLM("TIULST",TIUCLS)
+5 IF $PIECE(TIULST(0),U,3)>0
SET TIUOK=1
End DoDot:1
IF +TIUOK
GOTO MAINX
+6 NEW TIUCLS,TIULST
SET TIUCLS=+$ORDER(^USR(8930,"B","CHIEF, HIM",""))
+7 IF TIUCLS>0
Begin DoDot:1
+8 DO WHOIS2^USRLM("TIULST",TIUCLS)
+9 IF $PIECE(TIULST(0),U,3)>0
SET TIUOK=1
End DoDot:1
IF +TIUOK
GOTO MAINX
+10 NEW TIUCLS,TIULST
SET TIUCLS=+$ORDER(^USR(8930,"B","PRIVACY ACT OFFICER",""))
+11 IF TIUCLS>0
Begin DoDot:1
+12 DO WHOIS2^USRLM("TIULST",TIUCLS)
+13 IF $PIECE(TIULST(0),U,3)>0
SET TIUOK=1
End DoDot:1
IF TIUOK
GOTO MAINX
+14 SET XPDABORT=1
+15 WRITE !," Documents cannot be amended except by members of class CHIEF, MIS,"
+16 WRITE !,"CHIEF, HIM, or PRIVACY ACT OFFICER. (Classes must be named exactly as listed.)"
+17 WRITE !," I can't find any users in these classes. Please check with the person who"
+18 WRITE !,"maintains User Classes at your site."
+19 WRITE !," Aborting install."
MAINX ;
+1 IF TIUOK
WRITE !," User Classes look ok."
+2 QUIT
+3 ;
