1 | LEXILGX ; ISL Delete GMP from XTLK ; 09-23-96
|
---|
2 | ;;2.0;LEXICON UTILITY;;Sep 23, 1996
|
---|
3 | Q
|
---|
4 | EN ; Remove Clinical Lexicon Utility v 1.0 from the XT
|
---|
5 | N LEXP,LEXIN S LEXP="GMP",U="^"
|
---|
6 | S LEXIN=$$INST(LEXP) Q:'LEXIN S:LEXP="GMP"&('$D(^GMP(757.01,0))) ^GMP(757.01,0)="EXPRESSIONS^757.01^^"
|
---|
7 | S:LEXP="LEX"&('$D(^LEX(757.01,0))) ^LEX(757.01,0)="EXPRESSIONS^757.01^^"
|
---|
8 | D:$D(^XT(8984.4,757.01)) REMOVE K:LEXP="GMP"&($D(^GMP(757.01,0)))&('$D(^GMP(757.01,1,0))) ^GMP(757.01,0)
|
---|
9 | K:LEXP="LEX"&($D(^LEX(757.01,0)))&('$D(^LEX(757.01,1,0))) ^LEX(757.01,0)
|
---|
10 | K ^DD(757.01,0,"PT",8984.1),^DD(757.01,0,"PT",8984.2),^DD(757.01,0,"PT",8984.4)
|
---|
11 | Q
|
---|
12 | REMOVE ; Remove
|
---|
13 | D CHECK K %,%I,D0,DG,DICR,DIG,DIH,DIU,DIV,DIW,X,Y Q
|
---|
14 | CHECK ; Check Files
|
---|
15 | Q:'$D(^XT(8984.4,757.01)) N LEXFI,LEXFN,LEXFL,LEXEN,LEXRT,LEXVP,DIC,DIK,DA
|
---|
16 | F LEXFI=8984.2,8984.3 D ENT
|
---|
17 | F LEXFI=8984.1,8984.2 D PTR
|
---|
18 | S LEXFN=$O(^DD(8984.4,0,"NM","")),(DIC,DIK)="^XT(8984.4,",DA=757.01 D ^DIK Q
|
---|
19 | ENT ; Delete Entries
|
---|
20 | S LEXFN=$O(^DD(LEXFI,0,"NM","")) N LEXVP S LEXVP=LEXP_"(757.01,"
|
---|
21 | S (DIC,DIK,LEXRT)="^XT("_LEXFI_",",LEXFL=LEXVP,LEXEN=""
|
---|
22 | F S LEXEN=$O(@(LEXRT_"""AC"","""_LEXFL_""","""_LEXEN_""")")) Q:LEXEN="" D
|
---|
23 | . S DA=0 F S DA=$O(@(LEXRT_"""AC"","""_LEXFL_""","""_LEXEN_""","_DA_")")) Q:+DA=0 D ^DIK K:'$D(@(LEXRT_DA_",0)")) @(LEXRT_"""AC"","""_LEXFL_""","""_LEXEN_""","_DA_")")
|
---|
24 | Q
|
---|
25 | PTR ; Delete Pointers
|
---|
26 | N LEXNS S LEXNS="",LEXFN=$O(^DD(LEXFI,0,"NM","")) N LEXVP S LEXVP=LEXP_"(757.01,"
|
---|
27 | S DA=0 F S DA=$O(^DD(LEXFI,.02,"V","B",757.01,DA)) Q:+DA=0 D
|
---|
28 | . S LEXNS=$P($G(^DD(LEXFI,.02,"V",DA,0)),"^",4) Q:LEXNS'=LEXP
|
---|
29 | . K ^DD(LEXFI,.02,"V",DA),^DD(LEXFI,.02,"V","B",757.01,DA),^DD(LEXFI,.02,"V","M","EXPRESSIONS",DA),^DD(LEXFI,.02,"V","O",DA) K:LEXNS'="" ^DD(LEXFI,.02,"V","P",LEXNS,DA)
|
---|
30 | Q
|
---|
31 | INST(LEXP) ; Is GMP installed? 1 = Yes 0 = No
|
---|
32 | N LEXNS,LEXINST S LEXINST=0,LEXNS="" Q:'$D(^DD(8984.4)) 0 Q:'$D(^DD(8984.2))&('$D(^DD(8984.3))) 0
|
---|
33 | F S LEXNS=$O(^DD(8984.2,.02,"V","P",LEXNS)) Q:LEXNS="" I LEXNS=LEXP S LEXINST=1
|
---|
34 | F S LEXNS=$O(^DD(8984.3,.02,"V","P",LEXNS)) Q:LEXNS="" I LEXNS=LEXP S LEXINST=1
|
---|
35 | S LEXP=LEXINST Q LEXP
|
---|