source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXILGX.m@ 814

Last change on this file since 814 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1LEXILGX ; ISL Delete GMP from XTLK ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 Q
4EN ; 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
12REMOVE ; Remove
13 D CHECK K %,%I,D0,DG,DICR,DIG,DIH,DIU,DIV,DIW,X,Y Q
14CHECK ; 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
19ENT ; 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
25PTR ; 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
31INST(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
Note: See TracBrowser for help on using the repository browser.