source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USREN23.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1USREN23 ; SLC/MAM - Environment Check Rtn for USR*1*23;6/12/03
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**23**;Jun 20, 1997
3MAIN ; Check environment
4 ; -- Set data for User Class to export:
5 D SETXTMP
6 ; -- Check for potential duplicate User Class at site:
7 N USRDUPS
8 S USRDUPS=$$USRDUPS
9 I +USRDUPS S XPDABORT=1 W !,"Aborting Install..." Q
10 W !,"User Classes look OK."
11 Q
12 ;
13SETXTMP ; Set data for new User Class into ^XTMP:
14 ; Use exterior data:
15 S ^XTMP("USR23",0)=3031201_U_DT
16 S ^XTMP("USR23","USRCLAS",.01)="LR ANATOMIC PATH EMPTY CLASS"
17 S ^XTMP("USR23","USRCLAS",.02)="LRAPMT"
18 S ^XTMP("USR23","USRCLAS",.03)="Active"
19 S ^XTMP("USR23","USRCLAS",.04)="LR Anatomic Path Empty Class"
20 Q
21 ;
22USRDUPS(SILENT) ; Return IEN if site already has User Class
23 ; If not, return 0
24 N NAME,USRDUPS,USRY
25 ; -- When looking for duplicates, ignore User Class if created
26 ; by this patch:
27 I $G(^XTMP("USR23","DONE")) Q 0
28 ; -- If site already has User Class w/ same name as the one we
29 ; export, set USRDUPS=1:
30 S USRDUPS=0,NAME=^XTMP("USR23","USRCLAS",.01)
31 S USRY=$O(^USR(8930,"B",NAME,0))
32 I +USRY'>0 Q 0
33 S USRDUPS=+USRY
34 I '$G(SILENT) D
35 . W !,"You already have the User Class exported by this patch. I don't want"
36 . W !,"to overwrite it. Please change its name so it no longer matches the"
37 . W !,"exported one, or if you are not using it, delete it. For help, contact"
38 . W !,"National VistA Support."
39 Q USRDUPS
Note: See TracBrowser for help on using the repository browser.