- 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
- ;
- 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 ;