LEXILGX ; ISL Delete GMP from XTLK                 ; 09-23-96
 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
 Q
EN ; Remove Clinical Lexicon Utility v 1.0 from the XT
 N LEXP,LEXIN S LEXP="GMP",U="^"
 S LEXIN=$$INST(LEXP) Q:'LEXIN  S:LEXP="GMP"&('$D(^GMP(757.01,0))) ^GMP(757.01,0)="EXPRESSIONS^757.01^^"
 S:LEXP="LEX"&('$D(^LEX(757.01,0))) ^LEX(757.01,0)="EXPRESSIONS^757.01^^"
 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)
 K:LEXP="LEX"&($D(^LEX(757.01,0)))&('$D(^LEX(757.01,1,0))) ^LEX(757.01,0)
 K ^DD(757.01,0,"PT",8984.1),^DD(757.01,0,"PT",8984.2),^DD(757.01,0,"PT",8984.4)
 Q
REMOVE ; Remove
 D CHECK K %,%I,D0,DG,DICR,DIG,DIH,DIU,DIV,DIW,X,Y Q
CHECK ; Check Files
 Q:'$D(^XT(8984.4,757.01))  N LEXFI,LEXFN,LEXFL,LEXEN,LEXRT,LEXVP,DIC,DIK,DA
 F LEXFI=8984.2,8984.3 D ENT
 F LEXFI=8984.1,8984.2 D PTR
 S LEXFN=$O(^DD(8984.4,0,"NM","")),(DIC,DIK)="^XT(8984.4,",DA=757.01 D ^DIK Q
ENT ; Delete Entries
 S LEXFN=$O(^DD(LEXFI,0,"NM","")) N LEXVP S LEXVP=LEXP_"(757.01,"
 S (DIC,DIK,LEXRT)="^XT("_LEXFI_",",LEXFL=LEXVP,LEXEN=""
 F  S LEXEN=$O(@(LEXRT_"""AC"","""_LEXFL_""","""_LEXEN_""")")) Q:LEXEN=""  D
 . 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_")")
 Q
PTR ; Delete Pointers
 N LEXNS S LEXNS="",LEXFN=$O(^DD(LEXFI,0,"NM","")) N LEXVP S LEXVP=LEXP_"(757.01,"
 S DA=0 F  S DA=$O(^DD(LEXFI,.02,"V","B",757.01,DA)) Q:+DA=0  D
 . S LEXNS=$P($G(^DD(LEXFI,.02,"V",DA,0)),"^",4) Q:LEXNS'=LEXP
 . 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)
 Q
INST(LEXP) ; Is GMP installed?  1 = Yes  0 = No
 N LEXNS,LEXINST S LEXINST=0,LEXNS="" Q:'$D(^DD(8984.4)) 0 Q:'$D(^DD(8984.2))&('$D(^DD(8984.3))) 0
 F  S LEXNS=$O(^DD(8984.2,.02,"V","P",LEXNS)) Q:LEXNS=""  I LEXNS=LEXP S LEXINST=1
 F  S LEXNS=$O(^DD(8984.3,.02,"V","P",LEXNS)) Q:LEXNS=""  I LEXNS=LEXP S LEXINST=1
 S LEXP=LEXINST Q LEXP