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 Dec 13, 2024@02:00:27 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
