source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USREN24.m

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1USREN24 ; SLC/MAM - Environment Check Rtn for USR*1*24;6/19/03
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**24**;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("USR24",0)=304301_U_DT
16 ; -- Use only 30 chars for User Class Name because of B XREF:
17 S ^XTMP("USR24","USRCLAS",.01)="DGPF PATIENT RECORD FLAGS MGR"
18 S ^XTMP("USR24","USRCLAS",.02)="PRFM"
19 S ^XTMP("USR24","USRCLAS",.03)="Active"
20 S ^XTMP("USR24","USRCLAS",.04)="DGPF Patient Record Flags Mgr"
21 Q
22 ;
23USRDUPS(SILENT) ; Return IEN if site already has User Class
24 ; If not, return 0
25 N NAME,USRDUPS,USRY
26 ; -- When looking for duplicates, ignore User Class if created
27 ; by this patch:
28 I $G(^XTMP("USR24","DONE")) Q 0
29 ; -- If site already has User Class w/ same name as the one we
30 ; export, set USRDUPS=1:
31 S USRDUPS=0,NAME=^XTMP("USR24","USRCLAS",.01)
32 S USRY=$O(^USR(8930,"B",NAME,0))
33 I +USRY'>0 Q 0
34 S USRDUPS=+USRY
35 I '$G(SILENT) D
36 . W !,"You already have the User Class exported by this patch. I don't want"
37 . W !,"to overwrite it. Please change its name so it no longer matches the"
38 . W !,"exported one, or if you are not using it, delete it. For help, contact"
39 . W !,"National VistA Support."
40 Q USRDUPS
Note: See TracBrowser for help on using the repository browser.