USREN23 ; SLC/MAM - Environment Check Rtn for USR*1*23;6/12/03
;;1.0;AUTHORIZATION/SUBSCRIPTION;**23**;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("USR23",0)=3031201_U_DT
S ^XTMP("USR23","USRCLAS",.01)="LR ANATOMIC PATH EMPTY CLASS"
S ^XTMP("USR23","USRCLAS",.02)="LRAPMT"
S ^XTMP("USR23","USRCLAS",.03)="Active"
S ^XTMP("USR23","USRCLAS",.04)="LR Anatomic Path Empty Class"
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("USR23","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("USR23","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[HUSREN23 1454 printed Nov 22, 2024@16:48:55 Page 2
USREN23 ; SLC/MAM - Environment Check Rtn for USR*1*23;6/12/03
+1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**23**;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("USR23",0)=3031201_U_DT
+3 SET ^XTMP("USR23","USRCLAS",.01)="LR ANATOMIC PATH EMPTY CLASS"
+4 SET ^XTMP("USR23","USRCLAS",.02)="LRAPMT"
+5 SET ^XTMP("USR23","USRCLAS",.03)="Active"
+6 SET ^XTMP("USR23","USRCLAS",.04)="LR Anatomic Path Empty Class"
+7 QUIT
+8 ;
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("USR23","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("USR23","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
