- USREN24 ; SLC/MAM - Environment Check Rtn for USR*1*24;6/19/03
- ;;1.0;AUTHORIZATION/SUBSCRIPTION;**24**;Jun 20, 1997
- MAIN ; Check environment
- ; -- Set data for User Class to export:
- D SETXTMP
- ; -- Check for potential duplicate User Class at site:
- N USRDUPS
- S USRDUPS=$$USRDUPS
- I +USRDUPS S XPDABORT=1 W !,"Aborting Install..." Q
- W !,"User Classes look OK."
- Q
- ;
- SETXTMP ; Set data for new User Class into ^XTMP:
- ; Use exterior data:
- S ^XTMP("USR24",0)=304301_U_DT
- ; -- Use only 30 chars for User Class Name because of B XREF:
- S ^XTMP("USR24","USRCLAS",.01)="DGPF PATIENT RECORD FLAGS MGR"
- S ^XTMP("USR24","USRCLAS",.02)="PRFM"
- S ^XTMP("USR24","USRCLAS",.03)="Active"
- S ^XTMP("USR24","USRCLAS",.04)="DGPF Patient Record Flags Mgr"
- Q
- ;
- USRDUPS(SILENT) ; Return IEN if site already has User Class
- ; If not, return 0
- N NAME,USRDUPS,USRY
- ; -- When looking for duplicates, ignore User Class if created
- ; by this patch:
- I $G(^XTMP("USR24","DONE")) Q 0
- ; -- If site already has User Class w/ same name as the one we
- ; export, set USRDUPS=1:
- S USRDUPS=0,NAME=^XTMP("USR24","USRCLAS",.01)
- S USRY=$O(^USR(8930,"B",NAME,0))
- I +USRY'>0 Q 0
- S USRDUPS=+USRY
- I '$G(SILENT) D
- . W !,"You already have the User Class exported by this patch. I don't want"
- . W !,"to overwrite it. Please change its name so it no longer matches the"
- . W !,"exported one, or if you are not using it, delete it. For help, contact"
- . W !,"National VistA Support."
- Q USRDUPS
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSREN24 1517 printed Feb 18, 2025@23:05:07 Page 2
- USREN24 ; SLC/MAM - Environment Check Rtn for USR*1*24;6/19/03
- +1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**24**;Jun 20, 1997
- MAIN ; Check environment
- +1 ; -- Set data for User Class to export:
- +2 DO SETXTMP
- +3 ; -- Check for potential duplicate User Class at site:
- +4 NEW USRDUPS
- +5 SET USRDUPS=$$USRDUPS
- +6 IF +USRDUPS
- SET XPDABORT=1
- WRITE !,"Aborting Install..."
- QUIT
- +7 WRITE !,"User Classes look OK."
- +8 QUIT
- +9 ;
- SETXTMP ; Set data for new User Class into ^XTMP:
- +1 ; Use exterior data:
- +2 SET ^XTMP("USR24",0)=304301_U_DT
- +3 ; -- Use only 30 chars for User Class Name because of B XREF:
- +4 SET ^XTMP("USR24","USRCLAS",.01)="DGPF PATIENT RECORD FLAGS MGR"
- +5 SET ^XTMP("USR24","USRCLAS",.02)="PRFM"
- +6 SET ^XTMP("USR24","USRCLAS",.03)="Active"
- +7 SET ^XTMP("USR24","USRCLAS",.04)="DGPF Patient Record Flags Mgr"
- +8 QUIT
- +9 ;
- USRDUPS(SILENT) ; Return IEN if site already has User Class
- +1 ; If not, return 0
- +2 NEW NAME,USRDUPS,USRY
- +3 ; -- When looking for duplicates, ignore User Class if created
- +4 ; by this patch:
- +5 IF $GET(^XTMP("USR24","DONE"))
- QUIT 0
- +6 ; -- If site already has User Class w/ same name as the one we
- +7 ; export, set USRDUPS=1:
- +8 SET USRDUPS=0
- SET NAME=^XTMP("USR24","USRCLAS",.01)
- +9 SET USRY=$ORDER(^USR(8930,"B",NAME,0))
- +10 IF +USRY'>0
- QUIT 0
- +11 SET USRDUPS=+USRY
- +12 IF '$GET(SILENT)
- Begin DoDot:1
- +13 WRITE !,"You already have the User Class exported by this patch. I don't want"
- +14 WRITE !,"to overwrite it. Please change its name so it no longer matches the"
- +15 WRITE !,"exported one, or if you are not using it, delete it. For help, contact"
- +16 WRITE !,"National VistA Support."
- End DoDot:1
- +17 QUIT USRDUPS