Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: USREN24

USREN24.m

Go to the documentation of this file.
  1. USREN24 ; SLC/MAM - Environment Check Rtn for USR*1*24;6/19/03
  1. ;;1.0;AUTHORIZATION/SUBSCRIPTION;**24**;Jun 20, 1997
  1. MAIN ; Check environment
  1. ; -- Set data for User Class to export:
  1. D SETXTMP
  1. ; -- Check for potential duplicate User Class at site:
  1. N USRDUPS
  1. S USRDUPS=$$USRDUPS
  1. I +USRDUPS S XPDABORT=1 W !,"Aborting Install..." Q
  1. W !,"User Classes look OK."
  1. Q
  1. ;
  1. SETXTMP ; Set data for new User Class into ^XTMP:
  1. ; Use exterior data:
  1. S ^XTMP("USR24",0)=304301_U_DT
  1. ; -- Use only 30 chars for User Class Name because of B XREF:
  1. S ^XTMP("USR24","USRCLAS",.01)="DGPF PATIENT RECORD FLAGS MGR"
  1. S ^XTMP("USR24","USRCLAS",.02)="PRFM"
  1. S ^XTMP("USR24","USRCLAS",.03)="Active"
  1. S ^XTMP("USR24","USRCLAS",.04)="DGPF Patient Record Flags Mgr"
  1. Q
  1. ;
  1. USRDUPS(SILENT) ; Return IEN if site already has User Class
  1. ; If not, return 0
  1. N NAME,USRDUPS,USRY
  1. ; -- When looking for duplicates, ignore User Class if created
  1. ; by this patch:
  1. I $G(^XTMP("USR24","DONE")) Q 0
  1. ; -- If site already has User Class w/ same name as the one we
  1. ; export, set USRDUPS=1:
  1. S USRDUPS=0,NAME=^XTMP("USR24","USRCLAS",.01)
  1. S USRY=$O(^USR(8930,"B",NAME,0))
  1. I +USRY'>0 Q 0
  1. S USRDUPS=+USRY
  1. I '$G(SILENT) D
  1. . W !,"You already have the User Class exported by this patch. I don't want"
  1. . W !,"to overwrite it. Please change its name so it no longer matches the"
  1. . W !,"exported one, or if you are not using it, delete it. For help, contact"
  1. . W !,"National VistA Support."
  1. Q USRDUPS