TIUEN234.m

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       ;