- GMTSUIX ; SLC/KER - Health Summary Set/Kill Indexes ; 08/27/2002
- ;;2.7;Health Summary;**30,32,29,56**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10060 ^VA(200,
- ; DBIA 2056 $$GET1^DIQ (file #200)
- ; DBIA 10040 ^SC( file #44
- ; DBIA 10013 IX1^DIK
- ;
- Q
- STNT ; Set word indexes for NAME and TITLE
- N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD S GMTSTR=$G(X) Q:'$L(GMTSTR) S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
- S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
- . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
- . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
- . . . S @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")=""
- Q
- KTNT ; Kill word indexes for NAME and TITLE
- N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD S GMTSTR=$G(X) Q:'$L(GMTSTR) S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
- S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
- . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
- . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
- . . . K @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")
- Q
- ;
- STO ; Set word indexes for OWNER
- N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
- S GMTSTR=+($G(X)) Q:GMTSTR'>0 Q:GMTSTR>0&(GMTSTR<1)
- S GMTSTR=$$GET1^DIQ(200,(+GMTSTR_","),.01) Q:'$L(GMTSTR)
- S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
- S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
- . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
- . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
- . . . S @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")=""
- Q
- KTO ; Kill word indexes for OWNER
- N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
- S GMTSTR=+($G(X)) Q:GMTSTR'>0 Q:GMTSTR>0&(GMTSTR<1)
- S GMTSTR=$$GET1^DIQ(200,(+GMTSTR_","),.01) Q:'$L(GMTSTR)
- S GMTSIEN=+($G(DA)) Q:+GMTSIEN=0
- S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
- . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
- . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
- . . . K @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")
- Q
- ;
- STL ; Set word indexes for LOCATION
- N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD,GMTSIEN1,GMTSIEN2
- 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
- S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
- . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
- . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
- . . .S @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN1_","_GMTSIEN2_")")=""
- Q
- KTL ; Kill word indexes for LOCATION
- N GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD,GMTSIEN1,GMTSIEN2
- 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
- S GMTSCNT=1 F GMTSPSN=1:1:$L(GMTSTR)+1 D
- . S GMTSWORD=$E(GMTSTR,GMTSPSN) I "(,.?! '-/&:;)"[GMTSWORD D
- . . S GMTSWORD=$TR($E($E(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""",""),GMTSCNT=GMTSPSN+1 I $L(GMTSWORD)>0 D
- . . . K @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN1_","_GMTSIEN2_")")
- Q
- ;
- RXT ; Re-index Health Summary Type file #142
- W:'$D(GMTSQ) !,"Re-indexing Health Summary Type file #142"
- N DIK,DA,IX S DA=0 F S DA=$O(^GMT(142,DA)) Q:+DA=0 D
- . 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)
- . 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)
- 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)
- 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) "."
- Q
- ;
- UP(X) ; Uppercase
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- TRIM(X) ; Trim Spaces
- S X=$G(X) Q:X="" X F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
- F Q:X'[" " S X=$P(X," ",1)_" "_$P(X," ",2,229)
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSUIX 4240 printed Feb 18, 2025@23:26:49 Page 2
- GMTSUIX ; SLC/KER - Health Summary Set/Kill Indexes ; 08/27/2002
- +1 ;;2.7;Health Summary;**30,32,29,56**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10060 ^VA(200,
- +5 ; DBIA 2056 $$GET1^DIQ (file #200)
- +6 ; DBIA 10040 ^SC( file #44
- +7 ; DBIA 10013 IX1^DIK
- +8 ;
- +9 QUIT
- STNT ; Set word indexes for NAME and TITLE
- +1 NEW GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
- SET GMTSTR=$GET(X)
- if '$LENGTH(GMTSTR)
- QUIT
- SET GMTSIEN=+($GET(DA))
- if +GMTSIEN=0
- QUIT
- +2 SET GMTSCNT=1
- FOR GMTSPSN=1:1:$LENGTH(GMTSTR)+1
- Begin DoDot:1
- +3 SET GMTSWORD=$EXTRACT(GMTSTR,GMTSPSN)
- IF "(,.?! '-/&:;)"[GMTSWORD
- Begin DoDot:2
- +4 SET GMTSWORD=$TRANSLATE($EXTRACT($EXTRACT(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""","")
- SET GMTSCNT=GMTSPSN+1
- IF $LENGTH(GMTSWORD)>0
- Begin DoDot:3
- +5 SET @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 QUIT
- KTNT ; Kill word indexes for NAME and TITLE
- +1 NEW GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
- SET GMTSTR=$GET(X)
- if '$LENGTH(GMTSTR)
- QUIT
- SET GMTSIEN=+($GET(DA))
- if +GMTSIEN=0
- QUIT
- +2 SET GMTSCNT=1
- FOR GMTSPSN=1:1:$LENGTH(GMTSTR)+1
- Begin DoDot:1
- +3 SET GMTSWORD=$EXTRACT(GMTSTR,GMTSPSN)
- IF "(,.?! '-/&:;)"[GMTSWORD
- Begin DoDot:2
- +4 SET GMTSWORD=$TRANSLATE($EXTRACT($EXTRACT(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""","")
- SET GMTSCNT=GMTSPSN+1
- IF $LENGTH(GMTSWORD)>0
- Begin DoDot:3
- +5 KILL @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 QUIT
- +7 ;
- STO ; Set word indexes for OWNER
- +1 NEW GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
- +2 SET GMTSTR=+($GET(X))
- if GMTSTR'>0
- QUIT
- if GMTSTR>0&(GMTSTR<1)
- QUIT
- +3 SET GMTSTR=$$GET1^DIQ(200,(+GMTSTR_","),.01)
- if '$LENGTH(GMTSTR)
- QUIT
- +4 SET GMTSIEN=+($GET(DA))
- if +GMTSIEN=0
- QUIT
- +5 SET GMTSCNT=1
- FOR GMTSPSN=1:1:$LENGTH(GMTSTR)+1
- Begin DoDot:1
- +6 SET GMTSWORD=$EXTRACT(GMTSTR,GMTSPSN)
- IF "(,.?! '-/&:;)"[GMTSWORD
- Begin DoDot:2
- +7 SET GMTSWORD=$TRANSLATE($EXTRACT($EXTRACT(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""","")
- SET GMTSCNT=GMTSPSN+1
- IF $LENGTH(GMTSWORD)>0
- Begin DoDot:3
- +8 SET @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT
- KTO ; Kill word indexes for OWNER
- +1 NEW GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD
- +2 SET GMTSTR=+($GET(X))
- if GMTSTR'>0
- QUIT
- if GMTSTR>0&(GMTSTR<1)
- QUIT
- +3 SET GMTSTR=$$GET1^DIQ(200,(+GMTSTR_","),.01)
- if '$LENGTH(GMTSTR)
- QUIT
- +4 SET GMTSIEN=+($GET(DA))
- if +GMTSIEN=0
- QUIT
- +5 SET GMTSCNT=1
- FOR GMTSPSN=1:1:$LENGTH(GMTSTR)+1
- Begin DoDot:1
- +6 SET GMTSWORD=$EXTRACT(GMTSTR,GMTSPSN)
- IF "(,.?! '-/&:;)"[GMTSWORD
- Begin DoDot:2
- +7 SET GMTSWORD=$TRANSLATE($EXTRACT($EXTRACT(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""","")
- SET GMTSCNT=GMTSPSN+1
- IF $LENGTH(GMTSWORD)>0
- Begin DoDot:3
- +8 KILL @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN_")")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- STL ; Set word indexes for LOCATION
- +1 NEW GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD,GMTSIEN1,GMTSIEN2
- +2 SET GMTSTR=$PIECE($GET(^SC(+($GET(X)),0)),U,1)
- if '$LENGTH(GMTSTR)
- QUIT
- SET GMTSIEN1=+($GET(DA(1)))
- if +GMTSIEN1=0
- QUIT
- SET GMTSIEN2=+($GET(DA))
- if +GMTSIEN2=0
- QUIT
- +3 SET GMTSCNT=1
- FOR GMTSPSN=1:1:$LENGTH(GMTSTR)+1
- Begin DoDot:1
- +4 SET GMTSWORD=$EXTRACT(GMTSTR,GMTSPSN)
- IF "(,.?! '-/&:;)"[GMTSWORD
- Begin DoDot:2
- +5 SET GMTSWORD=$TRANSLATE($EXTRACT($EXTRACT(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""","")
- SET GMTSCNT=GMTSPSN+1
- IF $LENGTH(GMTSWORD)>0
- Begin DoDot:3
- +6 SET @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN1_","_GMTSIEN2_")")=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 QUIT
- KTL ; Kill word indexes for LOCATION
- +1 NEW GMTSTR,GMTSIEN,GMTSPSN,GMTSCNT,GMTSWORD,GMTSIEN1,GMTSIEN2
- +2 SET GMTSTR=$PIECE($GET(^SC(+($GET(X)),0)),U,1)
- if '$LENGTH(GMTSTR)
- QUIT
- SET GMTSIEN1=+($GET(DA(1)))
- if +GMTSIEN1=0
- QUIT
- SET GMTSIEN2=+($GET(DA))
- if +GMTSIEN2=0
- QUIT
- +3 SET GMTSCNT=1
- FOR GMTSPSN=1:1:$LENGTH(GMTSTR)+1
- Begin DoDot:1
- +4 SET GMTSWORD=$EXTRACT(GMTSTR,GMTSPSN)
- IF "(,.?! '-/&:;)"[GMTSWORD
- Begin DoDot:2
- +5 SET GMTSWORD=$TRANSLATE($EXTRACT($EXTRACT(GMTSTR,GMTSCNT,GMTSPSN-1),1,30),"""","")
- SET GMTSCNT=GMTSPSN+1
- IF $LENGTH(GMTSWORD)>0
- Begin DoDot:3
- +6 KILL @("^GMT(142,""AW"","""_$$UP(GMTSWORD)_""","_GMTSIEN1_","_GMTSIEN2_")")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 QUIT
- +8 ;
- RXT ; Re-index Health Summary Type file #142
- +1 if '$DATA(GMTSQ)
- WRITE !,"Re-indexing Health Summary Type file #142"
- +2 NEW DIK,DA,IX
- SET DA=0
- FOR
- SET DA=$ORDER(^GMT(142,DA))
- if +DA=0
- QUIT
- Begin DoDot:1
- +3 SET IX="~"
- FOR
- SET IX=$ORDER(^GMT(142,DA,1,IX),-1)
- if +IX>0!(IX="")
- QUIT
- IF IX="0"
- if $EXTRACT(IX,1)?1U!($EXTRACT(IX,1)?1L)
- KILL ^GMT(142,DA,1,IX)
- +4 SET IX="~"
- FOR
- SET IX=$ORDER(^GMT(142,DA,20,IX),-1)
- if +IX>0!(IX="")
- QUIT
- IF IX="0"
- if $EXTRACT(IX,1)?1U!($EXTRACT(IX,1)?1L)
- KILL ^GMT(142,DA,20,IX)
- End DoDot:1
- +5 SET IX="~"
- FOR
- SET IX=$ORDER(^GMT(142,IX),-1)
- if +IX>0!(IX="")
- QUIT
- IF IX'="0"
- if $EXTRACT(IX,1)?1U!($EXTRACT(IX,1)?1L)
- KILL ^GMT(142,IX)
- +6 if '$DATA(GMTSQ)
- WRITE !
- SET DA=0
- FOR
- SET DA=$ORDER(^GMT(142,DA))
- if +DA=0
- QUIT
- SET DIK="^GMT(142,"
- DO IX1^DIK
- if '$DATA(GMTSQ)
- WRITE "."
- +7 QUIT
- +8 ;
- UP(X) ; Uppercase
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- TRIM(X) ; Trim Spaces
- +1 SET X=$GET(X)
- if X=""
- QUIT X
- FOR
- if $EXTRACT(X,1)'=" "
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 FOR
- if $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +3 FOR
- if X'[" "
- QUIT
- SET X=$PIECE(X," ",1)_" "_$PIECE(X," ",2,229)
- +4 QUIT X