RGPRENV.m

RGPRENV ;SLC/NCG-PRE-IMP ENV CHECK ;6-30-1998

 ;;0.5; CLINICAL INFO RESOURCE NETWORK ;;30 Sep 98

 ;Checks first for patch PSO*7*11 when CPRS and OUTPATIENT

 ;version 7 are both installed. If patch not found, set

 ;XPDQUIT to tell KIDS to abort the install.  

 ;Checks next for existence of another entry in package file

 ;that contains RG as the prefix and will then remove it.

 ;CIRN's namespace is RG.  Found an entry during testing

 ;called OKC REGISTRATION with a prefix of RG

 ;

PSOCHK ; If CPRS and If OUTPATIENT v7, abort if no patch PSO*7*11.

 S Y=$$VERSION^XPDUTL("OR") I Y'<3 D

 .S Y=$$VERSION^XPDUTL("PSO") I Y'<7 D

 ..S Y=$$PATCH^XPDUTL("PSO*7.0*11") I Y<1 S XPDABORT=1

 ..I $D(XPDABORT) D BMES^XPDUTL(" PATCH PSO*7*11 is not installed.")

 K Y

 ;

LOOK ;

 S RGFLAG=0,RG1="RG",RG2=0,U="^"

 F  S RG2=$O(^DIC(9.4,"C",RG1,RG2)) Q:'RG2  D

 . S RG3=$P(^DIC(9.4,RG2,0),U)

 . I RG3'["CLINICAL INFO RESOURCE" D

 . . S DA=RG2,DIK="^DIC(9.4," D ^DIK

 . . D BMES^XPDUTL(RG3_" (ien="_RG2_") had an RG prefix")

 . . D BMES^XPDUTL("deleted from PACKAGE file")

 . . S RGFLAG=1

QUIT ; kill variables and quit

 I RGFLAG=0 D BMES^XPDUTL("No RG prefixes found in PACKAGE file.")

 K DA,DIK,RG1,RG2,RG3,RGFLAG

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RGPRENV   1232     printed  Apr 09, 2024@20:46:56                                                                                                                                                                                                     Page 2

RGPRENV   ;SLC/NCG-PRE-IMP ENV CHECK ;6-30-1998

 +1       ;;0.5; CLINICAL INFO RESOURCE NETWORK ;;30 Sep 98

 +2       ;Checks first for patch PSO*7*11 when CPRS and OUTPATIENT

 +3       ;version 7 are both installed. If patch not found, set

 +4       ;XPDQUIT to tell KIDS to abort the install.  

 +5       ;Checks next for existence of another entry in package file

 +6       ;that contains RG as the prefix and will then remove it.

 +7       ;CIRN's namespace is RG.  Found an entry during testing

 +8       ;called OKC REGISTRATION with a prefix of RG

 +9       ;

PSOCHK    ; If CPRS and If OUTPATIENT v7, abort if no patch PSO*7*11.

 +1        SET Y=$$VERSION^XPDUTL("OR")

           IF Y'<3

               Begin DoDot:1

 +2                SET Y=$$VERSION^XPDUTL("PSO")

                   IF Y'<7

                       Begin DoDot:2

 +3                        SET Y=$$PATCH^XPDUTL("PSO*7.0*11")

                           IF Y<1

                               SET XPDABORT=1

 +4                        IF $DATA(XPDABORT)

                               DO BMES^XPDUTL(" PATCH PSO*7*11 is not installed.")

                       End DoDot:2

               End DoDot:1

 +5        KILL Y

 +6       ;

LOOK      ;

 +1        SET RGFLAG=0

           SET RG1="RG"

           SET RG2=0

           SET U="^"

 +2        FOR 

               SET RG2=$ORDER(^DIC(9.4,"C",RG1,RG2))

               if 'RG2

                   QUIT 

               Begin DoDot:1

 +3                SET RG3=$PIECE(^DIC(9.4,RG2,0),U)

 +4                IF RG3'["CLINICAL INFO RESOURCE"

                       Begin DoDot:2

 +5                        SET DA=RG2

                           SET DIK="^DIC(9.4,"

                           DO ^DIK

 +6                        DO BMES^XPDUTL(RG3_" (ien="_RG2_") had an RG prefix")

 +7                        DO BMES^XPDUTL("deleted from PACKAGE file")

 +8                        SET RGFLAG=1

                       End DoDot:2

               End DoDot:1

QUIT      ; kill variables and quit

 +1        IF RGFLAG=0

               DO BMES^XPDUTL("No RG prefixes found in PACKAGE file.")

 +2        KILL DA,DIK,RG1,RG2,RG3,RGFLAG

 +3        QUIT