| 1 | RGPRENV ;SLC/NCG-PRE-IMP ENV CHECK ;6-30-1998
|
|---|
| 2 | ;;0.5; CLINICAL INFO RESOURCE NETWORK ;;30 Sep 98
|
|---|
| 3 | ;Checks first for patch PSO*7*11 when CPRS and OUTPATIENT
|
|---|
| 4 | ;version 7 are both installed. If patch not found, set
|
|---|
| 5 | ;XPDQUIT to tell KIDS to abort the install.
|
|---|
| 6 | ;Checks next for existence of another entry in package file
|
|---|
| 7 | ;that contains RG as the prefix and will then remove it.
|
|---|
| 8 | ;CIRN's namespace is RG. Found an entry during testing
|
|---|
| 9 | ;called OKC REGISTRATION with a prefix of RG
|
|---|
| 10 | ;
|
|---|
| 11 | PSOCHK ; If CPRS and If OUTPATIENT v7, abort if no patch PSO*7*11.
|
|---|
| 12 | S Y=$$VERSION^XPDUTL("OR") I Y'<3 D
|
|---|
| 13 | .S Y=$$VERSION^XPDUTL("PSO") I Y'<7 D
|
|---|
| 14 | ..S Y=$$PATCH^XPDUTL("PSO*7.0*11") I Y<1 S XPDABORT=1
|
|---|
| 15 | ..I $D(XPDABORT) D BMES^XPDUTL(" PATCH PSO*7*11 is not installed.")
|
|---|
| 16 | K Y
|
|---|
| 17 | ;
|
|---|
| 18 | LOOK ;
|
|---|
| 19 | S RGFLAG=0,RG1="RG",RG2=0,U="^"
|
|---|
| 20 | F S RG2=$O(^DIC(9.4,"C",RG1,RG2)) Q:'RG2 D
|
|---|
| 21 | . S RG3=$P(^DIC(9.4,RG2,0),U)
|
|---|
| 22 | . I RG3'["CLINICAL INFO RESOURCE" D
|
|---|
| 23 | . . S DA=RG2,DIK="^DIC(9.4," D ^DIK
|
|---|
| 24 | . . D BMES^XPDUTL(RG3_" (ien="_RG2_") had an RG prefix")
|
|---|
| 25 | . . D BMES^XPDUTL("deleted from PACKAGE file")
|
|---|
| 26 | . . S RGFLAG=1
|
|---|
| 27 | QUIT ; kill variables and quit
|
|---|
| 28 | I RGFLAG=0 D BMES^XPDUTL("No RG prefixes found in PACKAGE file.")
|
|---|
| 29 | K DA,DIK,RG1,RG2,RG3,RGFLAG
|
|---|
| 30 | Q
|
|---|
