source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSUIX.m@ 1093

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1GMTSUIX ; SLC/KER - Health Summary Set/Kill Indexes ; 08/27/2002
2 ;;2.7;Health Summary;**30,32,29,56**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10060 ^VA(200,
6 ; DBIA 2056 $$GET1^DIQ (file #200)
7 ; DBIA 10040 ^SC( file #44
8 ; DBIA 10013 IX1^DIK
9 ;
10 Q
11STNT ; Set word indexes for NAME and TITLE
12 N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD S GMTSTR=$G(X) Q:'$L(GMTSTR) S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
13 S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
14 . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
15 . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
16 . . . S @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")=""
17 Q
18KTNT ; Kill word indexes for NAME and TITLE
19 N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD S GMTSTR=$G(X) Q:'$L(GMTSTR) S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
20 S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
21 . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
22 . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
23 . . . K @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")
24 Q
25 ;
26STO ; Set word indexes for OWNER
27 N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
28 S GMTSTR=+($G(X)) Q:GMTSTR'>0 Q:GMTSTR>0&(GMTSTR<1)
29 S GMTSTR=$$GET1^DIQ(200,(+GMTSTR_","),.01) Q:'$L(GMTSTR)
30 S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
31 S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
32 . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
33 . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
34 . . . S @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")=""
35 Q
36KTO ; Kill word indexes for OWNER
37 N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
38 S GMTSTR=+($G(X)) Q:GMTSTR'>0 Q:GMTSTR>0&(GMTSTR<1)
39 S GMTSTR=$$GET1^DIQ(200,(+GMTSTR_","),.01) Q:'$L(GMTSTR)
40 S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
41 S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
42 . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
43 . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
44 . . . K @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")
45 Q
46 ;
47STL ; Set word indexes for LOCATION
48 N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD,GMTSIEN1,GMTSIEN2
49 S GMTSTR=$P($G(^SC(+($G(X)),0)),U,1) Q:'$L(GMTSTR) S GMTSIEN1=+($G(DA(1))) Q:+GMTSIEN1=0 S GMTSIEN2=+($G(DA)) Q:+GMTSIEN2=0
50 S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
51 . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
52 . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
53 . . .S @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN1_","_GMTSIEN2_")")=""
54 Q
55KTL ; Kill word indexes for LOCATION
56 N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD,GMTSIEN1,GMTSIEN2
57 S GMTSTR=$P($G(^SC(+($G(X)),0)),U,1) Q:'$L(GMTSTR) S GMTSIEN1=+($G(DA(1))) Q:+GMTSIEN1=0 S GMTSIEN2=+($G(DA)) Q:+GMTSIEN2=0
58 S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
59 . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
60 . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
61 . . . K @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN1_","_GMTSIEN2_")")
62 Q
63 ;
64RXT ; Re-index Health Summary Type file #142
65 W:'$D(GMTSQ) !,"Re-indexing Health Summary Type file #142"
66 N DIK,DA,IX S DA=0 F S DA=$O(^GMT(142,DA)) Q:+DA=0 D
67 . S IX="~" F S IX=$O(^GMT(142,DA,1,IX),-1) Q:+IX>0!(IX="") I IX="0" K:$E(IX,1)?1U!($E(IX,1)?1L) ^GMT(142,DA,1,IX)
68 . S IX="~" F S IX=$O(^GMT(142,DA,20,IX),-1) Q:+IX>0!(IX="") I IX="0" K:$E(IX,1)?1U!($E(IX,1)?1L) ^GMT(142,DA,20,IX)
69 S IX="~" F S IX=$O(^GMT(142,IX),-1) Q:+IX>0!(IX="") I IX'="0" K:$E(IX,1)?1U!($E(IX,1)?1L) ^GMT(142,IX)
70 W:'$D(GMTSQ) ! S DA=0 F S DA=$O(^GMT(142,DA)) Q:+DA=0 S DIK="^GMT(142," D IX1^DIK W:'$D(GMTSQ) "."
71 Q
72 ;
73UP(X) ; Uppercase
74 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
75TRIM(X) ; Trim Spaces
76 S X=$G(X) Q:X="" X F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
77 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
78 F Q:X'[" " S X=$P(X," ",1)_" "_$P(X," ",2,229)
79 Q X
Note: See TracBrowser for help on using the repository browser.