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 ---[H[J[2J[HRGPRENV 1232 printed Nov 22, 2024@16:52:55 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
