USREN23.m

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 ---USREN23   1454     printed  Apr 09, 2024@20:43:53                                                                                                                                                                                                     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