Routine: GMTSOBU

GMTSOBU ; SLC/KER - HS Object - Utility           ; 01/06/2003

 ;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61

 ; External References

 ;   DBIA 10096  ^%ZOSF("DEL"

 ;   DBIA 10112  $$SITE^VASITE

 ;   DBIA 10104  $$UP^XLFSTR

 ;   DBIA 10026  ^DIR

 ; Errors

ER1 ;   Health Summary Object Exist

 N GMTSTXT,GMTSLN S GMTSTXT="Can not install Health Summary Object '"_GMTSOBJ_"'.  A Health Summary Object with the same name already exist." D WER S GMTSQIT=1 Q

ER2 ;   Health Summary Type Exist

 N GMTSTXT,GMTSLN S GMTSTXT="Can not install Health Summary Type '"_GMTSTYP_"' for use by the Health Summary Object '"_GMTSOBJ_"'.  A Health Summary Type with the same name already exist." D WER S GMTSQIT=1 Q

ER3 ;   Health Summary Title Exist

 N GMTSTXT,GMTSLN S GMTSTXT="Can not install Health Summary Type '"_GMTSTYP_"' for use by the Health Summary Object '"_GMTSOBJ_"'.  A Health Summary Type with the same TITLE ("_GMTSTTL_") already exist." D WER S GMTSQIT=1 Q

WER ;   Write Error

 W !," Error:"

WER2 ;   Write Error Text

 S GMTSLN=$$TRIM($E(GMTSTXT,1,65)),GMTSLN=$$TRIM($P(GMTSLN," ",1,($L(GMTSLN," ")-1))) S:$L(GMTSTXT)<65 GMTSLN=$$TRIM(GMTSTXT) W:$L(GMTSLN) !,"    ",GMTSLN

 S GMTSTXT=$$TRIM($P(GMTSTXT,GMTSLN,2,299)),GMTSLN=$$TRIM($E(GMTSTXT,1,65)),GMTSLN=$$TRIM($P(GMTSLN," ",1,($L(GMTSLN," ")-1))) S:$L(GMTSTXT)<65 GMTSLN=$$TRIM(GMTSTXT) W:$L(GMTSLN) !,"    ",GMTSLN

 S GMTSTXT=$$TRIM($P(GMTSTXT,GMTSLN,2,299)),GMTSLN=$$TRIM($E(GMTSTXT,1,65)),GMTSLN=$$TRIM($P(GMTSLN," ",1,($L(GMTSLN," ")-1))) S:$L(GMTSTXT)<65 GMTSLN=$$TRIM(GMTSTXT) W:$L(GMTSLN) !,"    ",GMTSLN

EHST(X) ; Existing Health Summary Type

 N GMTSRTN,GMTSEDAT,GMTSOBJ,GMTSTYP,GMTSTXT,GMTSLN,GMTS

 N Y,DIR,DIROUT,DTOUT,DUOUT

 S GMTSRTN="GMTSOBX",GMTSOBJ=$P($$TX(GMTSRTN,"OBJ",1),";",2),GMTSTYP=$P($$TX(GMTSRTN,"TYPE",1),";",2)

 Q:'$L(GMTSOBJ)!('$L(GMTSTYP)) 0

 W ! S GMTSTXT="Can not install Health Summary Type '"_GMTSTYP_"' to be used"

 S GMTSTXT=GMTSTXT_" by the object.  A Health Summary Type with the same name already exist." D WER2

 S GMTSEDAT=$$NWX(GMTSTYP) Q:+($G(GMTSEDAT))'>0 0

 S GMTSTXT="Do you want to use the pre-existing Health Summary Type '"_GMTSTYP_"' for this Object?  (Y/N)"

 S GMTSLN=$$TRIM($E(GMTSTXT,1,65))

 S GMTSLN=$$TRIM($P(GMTSLN," ",1,($L(GMTSLN," ")-1)))

 S:$L(GMTSTXT)<65 GMTSLN=$$TRIM(GMTSTXT) S:$L(GMTSLN) DIR("A",1)="    "_GMTSLN_"  "

 S GMTSTXT=$$TRIM($P(GMTSTXT,GMTSLN,2,299))

 S GMTSLN=$$TRIM($E(GMTSTXT,1,65))

 S GMTSLN=$$TRIM($P(GMTSLN," ",1,($L(GMTSLN," ")-1)))

 S:$L(GMTSTXT)<65 GMTSLN=$$TRIM(GMTSTXT) S:$L(GMTSLN) DIR("A")="    "_GMTSLN_"  "

 S DIR("B")="N",DIR(0)="YAO",(DIR("?"),DIR("??"))="^D YNH^GMTSOBU" W ! D ^DIR

 S GMTS=+($G(Y)) S X=0,GMTSQIT=1

 ;   Don't use the pre-existing HS

 I +GMTS'>0 S GMTSQIT=1,GMTSEDAT=0 D  Q X

 . ;   Rename HS

 . D REN I $L($G(GMTSETYP)),$L($G(GMTSETTL)) S GMTSTYP=GMTSETYP,GMTSTTL=GMTSETTL,(GMTSEDAT,GMTSDAT)=$$TIEN

 . S X=+GMTSEDAT S:+X>0 GMTSQIT=0

 ;   Use the pre-existing HS

 ;AGP CHANGE TO TEST POSSIBLE FIX

 ;I +GMTS>0,$L(GMTSTYP) BREAK S GMTSTE=1,(X,GMTSEDAT)=+($G(GMTSDAT)),GMTSQIT=0

 I +GMTS>0,$L(GMTSTYP) S GMTSTE=1,(X,GMTSEDAT)=+($G(GMTSEDAT)),GMTSQIT=0

Q X

REN ; Rename Health Summary Type

 N DIR,DIROUT,DUOUT,DTOUT,X,Y,GMTSNN,GMTSNT,GMTSNA S (GMTSETYP,GMTSETTL)=""

 S DIR("A")="    Do you want to rename the imported Health Summary Type? (Y/N) "

 S DIR("B")="Y",DIR(0)="YAO"

 S (DIR("?"),DIR("??"))="^D YNH^GMTSOBU"

 W ! D ^DIR Q:+Y=0

 S GMTSETYP=$$EDN($G(GMTSTYP)) Q:'$L($G(GMTSETYP))

 S GMTSETTL=$$EDT($G(GMTSTTL),$G(GMTSETYP)) S:'$L($G(GMTSETTL)) GMTSETYP=""

EDN(X) ; Edit Health Summary Type Name

 N DIR,DIROUT,DUOUT,DTOUT,Y,GMTSNN,GMTSON,GMTSNA,GMTSETYP

 S GMTSON=$G(X),GMTSETYP="" Q:'$L(GMTSON) ""

 S DIR("A")="      Re-Name '"_GMTSON_"' to:  "

 S GMTSNN=GMTSON F  S GMTSNN=$$TRIM($$NN(GMTSNN)) Q:+($$NWX(GMTSNN))=0

 S:$L(GMTSNN) DIR("B")=GMTSNN

 S DIR(0)="FAO^3:30^N GMTS S GMTS=$$CKN^GMTSOBU($G(X)) W:+GMTS=0&($L(X)) !!,""          '""_$G(X)_""' already exist."" K:+GMTS=0&($L(X)) X"

 S (DIR("?"),DIR("??"))="^D LNH^GMTSOBU"

 D ^DIR S X="" S:$L(Y)>2&($L(Y)<31) X=Y

Q X

EDT(X,Y) ;  Edit Health Summary Type Title

 N DIR,DIROUT,DUOUT,DTOUT,GMTSNT,GMTSOT,GMTSTT,GMTSTY,GMTSNA,GMTSETYP

 S GMTSOT=$G(X),GMTSTT=$$EN2^GMTSUMX($G(Y)),GMTSTY=$G(Y)

 S GMTSNT=GMTSOT S:'$L(GMTSNT) GMTSNT=GMTSTT S GMTSNT=$$EN2^GMTSUMX(GMTSNT)

 F  S GMTSNT=$$TRIM($$NN(GMTSNT)) Q:+($$TWX(GMTSNT))=0

 S DIR("A")="      Title:  " S:$L(GMTSNT)>2&($L(GMTSNT)<31) DIR("B")=GMTSNT

 S DIR(0)="FAO^3:30^N GMTS S GMTS=$$CKT^GMTSOBU($G(X)) W:+GMTS=0&($L(X)) !!,""          '""_$G(X)_""' already exist."" K:+GMTS=0&($L(X)) X"

 S (DIR("?"),DIR("??"))="^D LNH^GMTSOBU"

 D ^DIR S X="" S:$L(Y)>2&($L(Y)<31) X=Y

Q X

YNH ; Yes No Help

 W !,"        Enter either 'Y' or 'N'." Q

LNH ; Length Help

 W !,"          This response must have at least 3 characters and no more than 30"

 W !,"          characters and must not contain embedded uparrow." Q

CKN(X) ; Check New Name is Unique

 S X=$$NWX($G(X)) S X=$S(+X>0:0,1:1) Q X

CKT(X) ; Check New Title is Unique

 S X=$$TWX($G(X)) S X=$S(+X>0:0,1:1) Q X

 ; Miscellaneous

TIEN(X) ;   Type IEN

 N GMTSI,GMTSIEN S GMTSIEN=0 F GMTSI=5:1  D  Q:+GMTSIEN>0

 . Q:$G(^GMT(142,GMTSI,0))["GMTS HS ADHOC OPTION"  I GMTSI>4999999 S GMTSI=5999999 Q

 . S:'$D(^GMT(142,GMTSI)) GMTSIEN=GMTSI

 S X=GMTSIEN Q X

OIEN(X) ;   Object IEN

 N GMTSIEN,GMTSIT S GMTSIT=+($P($$SITE^VASITE,"^",3)) Q:+GMTSIT=0 -1

 S GMTSIEN=+($O(^GMT(142.5,(GMTSIT_"9999")),-1))+1 Q:$D(^GMT(142.5,+GMTSIEN,0)) -1

 S X=GMTSIEN

Q X

BOX(X) ;   Get HS Object IEN from B Index

 N GMTSI,GMTSX,GMTSO,GMTSN S GMTSN=$G(X) Q:'$L(GMTSN) 0

 S (GMTSI,GMTSO)=0 F  S GMTSI=$O(^GMT(142.5,"B",$E(GMTSN,1,30),GMTSI)) Q:+GMTSI=0  D  Q:GMTSO>0

 . S GMTSX=$P($G(^GMT(142.5,+GMTSI,0)),"^",1) S:$$UP^XLFSTR(GMTSN)=$$UP^XLFSTR(GMTSX) GMTSO=GMTSI

 S X=+($G(GMTSO))

Q X

NWX(X) ;   Get HS Name IEN from Word Index

 N GMTSI,GMTSX,GMTST,GMTSN,GMTSW S GMTSN=$$UP^XLFSTR($G(X)) Q:'$L(GMTSN) 0

 S GMTSW=$P(GMTSN," ",1),(GMTSI,GMTST)=0 F  S GMTSI=$O(^GMT(142,"AW",GMTSW,GMTSI)) Q:+GMTSI=0  D  Q:GMTST>0

 . S GMTSX=$P($G(^GMT(142,+GMTSI,0)),"^",1) S:$$UP^XLFSTR(GMTSN)=$$UP^XLFSTR(GMTSX) GMTST=GMTSI

 S X=+($G(GMTST))

Q X

TWX(X) ;   Get HS Title IEN from Word Index

 N GMTSI,GMTSX,GMTST,GMTSN,GMTSW S GMTSN=$$UP^XLFSTR($G(X)) Q:'$L(GMTSN) 0

 S GMTSW=$P(GMTSN," ",1),(GMTSI,GMTST)=0 F  S GMTSI=$O(^GMT(142,"AW",GMTSW,GMTSI)) Q:+GMTSI=0  D  Q:GMTST>0

 . S GMTSX=$P($G(^GMT(142,+GMTSI,"T")),"^",1) S:$$UP^XLFSTR(GMTSN)=$$UP^XLFSTR(GMTSX) GMTST=GMTSI

 S X=+($G(GMTST))

Q X

NN(X) ;   New Name

 N GMTSNN,GMTSNI,GMTSNS

 S GMTSNN=$G(X),GMTSNI=$P(GMTSNN," ",$L(GMTSNN," "))

 S GMTSNS=$P(GMTSNN," ",1,($L(GMTSNN," ")-1))

 S:+GMTSNI=0 GMTSNS=GMTSNN S:+GMTSNI=0 GMTSNI=1 S GMTSNI=+GMTSNI+1

 S GMTSNS=$$TRIM(GMTSNS)

 S:($L(GMTSNS)+$L(GMTSNI))>29 GMTSNS=$E(GMTSNS,1,30-($L(GMTSNI)+2))

 S X=$$TRIM(GMTSNS)_" "_GMTSNI

Q X

DEL(X) ;   Delete Routine X

 S X=$G(X) Q:'$L(X)  Q:$L(X)>8  Q:$$ROK(X)=0  X ^%ZOSF("DEL") Q

ROK(X) ;   Routine Ok

 S X=$G(X) Q:'$L(X) 0

 N GMTSEX,GMTSTXT S GMTSEX="S GMTSTXT=$T(+1^"_X_")" X GMTSEX Q:'$L(GMTSTXT) 0 Q 1

TX(R,T,L) ;   Get Text (Routine/Tag/Line)

 N GMTSEX,GMTSTXT S GMTSEX="S GMTSTXT=$T("_T_"+"_L_"^"_R_")" X GMTSEX S X=GMTSTXT

Q X

TRIM(X) ;   Trim Spaces

 S X=$G(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))

 S X=$$UP^XLFSTR($E(X,1))_$E(X,2,$L(X))

Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBU   7543     printed  Mar 13, 2025@21:03:16                                                                                                                                                                                                     Page 2

GMTSOBU   ; SLC/KER - HS Object - Utility           ; 01/06/2003

 +1       ;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10096  ^%ZOSF("DEL"

 +5       ;   DBIA 10112  $$SITE^VASITE

 +6       ;   DBIA 10104  $$UP^XLFSTR

 +7       ;   DBIA 10026  ^DIR

 +8       ;

 +9       ; Errors

ER1       ;   Health Summary Object Exist

 +1        NEW GMTSTXT,GMTSLN

           SET GMTSTXT="Can not install Health Summary Object '"_GMTSOBJ_"'.  A Health Summary Object with the same name already exist."

           DO WER

           SET GMTSQIT=1

           QUIT

ER2       ;   Health Summary Type Exist

 +1        NEW GMTSTXT,GMTSLN

           SET GMTSTXT="Can not install Health Summary Type '"_GMTSTYP_"' for use by the Health Summary Object '"_GMTSOBJ_"'.  A Health Summary Type with the same name already exist."

           DO WER

           SET GMTSQIT=1

           QUIT

ER3       ;   Health Summary Title Exist

 +1        NEW GMTSTXT,GMTSLN

           SET GMTSTXT="Can not install Health Summary Type '"_GMTSTYP_"' for use by the Health Summary Object '"_GMTSOBJ_"'.  A Health Summary Type with the same TITLE ("_GMTSTTL_") already exist."

           DO WER

           SET GMTSQIT=1

           QUIT

WER       ;   Write Error

 +1        WRITE !," Error:"

WER2      ;   Write Error Text

 +1        SET GMTSLN=$$TRIM($EXTRACT(GMTSTXT,1,65))

           SET GMTSLN=$$TRIM($PIECE(GMTSLN," ",1,($LENGTH(GMTSLN," ")-1)))

           if $LENGTH(GMTSTXT)<65

               SET GMTSLN=$$TRIM(GMTSTXT)

           if $LENGTH(GMTSLN)

               WRITE !,"    ",GMTSLN

 +2        SET GMTSTXT=$$TRIM($PIECE(GMTSTXT,GMTSLN,2,299))

           SET GMTSLN=$$TRIM($EXTRACT(GMTSTXT,1,65))

           SET GMTSLN=$$TRIM($PIECE(GMTSLN," ",1,($LENGTH(GMTSLN," ")-1)))

           if $LENGTH(GMTSTXT)<65

               SET GMTSLN=$$TRIM(GMTSTXT)

           if $LENGTH(GMTSLN)

               WRITE !,"    ",GMTSLN

 +3        SET GMTSTXT=$$TRIM($PIECE(GMTSTXT,GMTSLN,2,299))

           SET GMTSLN=$$TRIM($EXTRACT(GMTSTXT,1,65))

           SET GMTSLN=$$TRIM($PIECE(GMTSLN," ",1,($LENGTH(GMTSLN," ")-1)))

           if $LENGTH(GMTSTXT)<65

               SET GMTSLN=$$TRIM(GMTSTXT)

           if $LENGTH(GMTSLN)

               WRITE !,"    ",GMTSLN

 +4        QUIT

 +5       ;

EHST(X)   ; Existing Health Summary Type

 +1        NEW GMTSRTN,GMTSEDAT,GMTSOBJ,GMTSTYP,GMTSTXT,GMTSLN,GMTS

 +2        NEW Y,DIR,DIROUT,DTOUT,DUOUT

 +3        SET GMTSRTN="GMTSOBX"

           SET GMTSOBJ=$PIECE($$TX(GMTSRTN,"OBJ",1),";",2)

           SET GMTSTYP=$PIECE($$TX(GMTSRTN,"TYPE",1),";",2)

 +4        if '$LENGTH(GMTSOBJ)!('$LENGTH(GMTSTYP))

               QUIT 0

 +5        WRITE !

           SET GMTSTXT="Can not install Health Summary Type '"_GMTSTYP_"' to be used"

 +6        SET GMTSTXT=GMTSTXT_" by the object.  A Health Summary Type with the same name already exist."

           DO WER2

 +7        SET GMTSEDAT=$$NWX(GMTSTYP)

           if +($GET(GMTSEDAT))'>0

               QUIT 0

 +8        SET GMTSTXT="Do you want to use the pre-existing Health Summary Type '"_GMTSTYP_"' for this Object?  (Y/N)"

 +9        SET GMTSLN=$$TRIM($EXTRACT(GMTSTXT,1,65))

 +10       SET GMTSLN=$$TRIM($PIECE(GMTSLN," ",1,($LENGTH(GMTSLN," ")-1)))

 +11       if $LENGTH(GMTSTXT)<65

               SET GMTSLN=$$TRIM(GMTSTXT)

           if $LENGTH(GMTSLN)

               SET DIR("A",1)="    "_GMTSLN_"  "

 +12       SET GMTSTXT=$$TRIM($PIECE(GMTSTXT,GMTSLN,2,299))

 +13       SET GMTSLN=$$TRIM($EXTRACT(GMTSTXT,1,65))

 +14       SET GMTSLN=$$TRIM($PIECE(GMTSLN," ",1,($LENGTH(GMTSLN," ")-1)))

 +15       if $LENGTH(GMTSTXT)<65

               SET GMTSLN=$$TRIM(GMTSTXT)

           if $LENGTH(GMTSLN)

               SET DIR("A")="    "_GMTSLN_"  "

 +16       SET DIR("B")="N"

           SET DIR(0)="YAO"

           SET (DIR("?"),DIR("??"))="^D YNH^GMTSOBU"

           WRITE !

           DO ^DIR

 +17       SET GMTS=+($GET(Y))

           SET X=0

           SET GMTSQIT=1

 +18      ;   Don't use the pre-existing HS

 +19       IF +GMTS'>0

               SET GMTSQIT=1

               SET GMTSEDAT=0

               Begin DoDot:1

 +20      ;   Rename HS

 +21               DO REN

                   IF $LENGTH($GET(GMTSETYP))

                       IF $LENGTH($GET(GMTSETTL))

                           SET GMTSTYP=GMTSETYP

                           SET GMTSTTL=GMTSETTL

                           SET (GMTSEDAT,GMTSDAT)=$$TIEN

 +22               SET X=+GMTSEDAT

                   if +X>0

                       SET GMTSQIT=0

               End DoDot:1

               QUIT X

 +23      ;   Use the pre-existing HS

 +24      ;AGP CHANGE TO TEST POSSIBLE FIX

 +25      ;I +GMTS>0,$L(GMTSTYP) BREAK S GMTSTE=1,(X,GMTSEDAT)=+($G(GMTSDAT)),GMTSQIT=0

 +26       IF +GMTS>0

               IF $LENGTH(GMTSTYP)

                   SET GMTSTE=1

                   SET (X,GMTSEDAT)=+($GET(GMTSEDAT))

                   SET GMTSQIT=0

 +27       QUIT X

REN       ; Rename Health Summary Type

 +1        NEW DIR,DIROUT,DUOUT,DTOUT,X,Y,GMTSNN,GMTSNT,GMTSNA

           SET (GMTSETYP,GMTSETTL)=""

 +2        SET DIR("A")="    Do you want to rename the imported Health Summary Type? (Y/N) "

 +3        SET DIR("B")="Y"

           SET DIR(0)="YAO"

 +4        SET (DIR("?"),DIR("??"))="^D YNH^GMTSOBU"

 +5        WRITE !

           DO ^DIR

           if +Y=0

               QUIT

 +6        SET GMTSETYP=$$EDN($GET(GMTSTYP))

           if '$LENGTH($GET(GMTSETYP))

               QUIT

 +7        SET GMTSETTL=$$EDT($GET(GMTSTTL),$GET(GMTSETYP))

           if '$LENGTH($GET(GMTSETTL))

               SET GMTSETYP=""

 +8        QUIT

EDN(X)    ; Edit Health Summary Type Name

 +1        NEW DIR,DIROUT,DUOUT,DTOUT,Y,GMTSNN,GMTSON,GMTSNA,GMTSETYP

 +2        SET GMTSON=$GET(X)

           SET GMTSETYP=""

           if '$LENGTH(GMTSON)

               QUIT ""

 +3        SET DIR("A")="      Re-Name '"_GMTSON_"' to:  "

 +4        SET GMTSNN=GMTSON

FOR

               SET GMTSNN=$$TRIM($$NN(GMTSNN))

               if +($$NWX(GMTSNN))=0

                   QUIT

 +5        if $LENGTH(GMTSNN)

               SET DIR("B")=GMTSNN

 +6        SET DIR(0)="FAO^3:30^N GMTS S GMTS=$$CKN^GMTSOBU($G(X)) W:+GMTS=0&($L(X)) !!,""          '""_$G(X)_""' already exist."" K:+GMTS=0&($L(X)) X"

 +7        SET (DIR("?"),DIR("??"))="^D LNH^GMTSOBU"

 +8        DO ^DIR

           SET X=""

           if $LENGTH(Y)>2&($LENGTH(Y)<31)

               SET X=Y

 +9        QUIT X

EDT(X,Y)  ;  Edit Health Summary Type Title

 +1        NEW DIR,DIROUT,DUOUT,DTOUT,GMTSNT,GMTSOT,GMTSTT,GMTSTY,GMTSNA,GMTSETYP

 +2        SET GMTSOT=$GET(X)

           SET GMTSTT=$$EN2^GMTSUMX($GET(Y))

           SET GMTSTY=$GET(Y)

 +3        SET GMTSNT=GMTSOT

           if '$LENGTH(GMTSNT)

               SET GMTSNT=GMTSTT

           SET GMTSNT=$$EN2^GMTSUMX(GMTSNT)

 +4        FOR

               SET GMTSNT=$$TRIM($$NN(GMTSNT))

               if +($$TWX(GMTSNT))=0

                   QUIT

 +5        SET DIR("A")="      Title:  "

           if $LENGTH(GMTSNT)>2&($LENGTH(GMTSNT)<31)

               SET DIR("B")=GMTSNT

 +6        SET DIR(0)="FAO^3:30^N GMTS S GMTS=$$CKT^GMTSOBU($G(X)) W:+GMTS=0&($L(X)) !!,""          '""_$G(X)_""' already exist."" K:+GMTS=0&($L(X)) X"

 +7        SET (DIR("?"),DIR("??"))="^D LNH^GMTSOBU"

 +8        DO ^DIR

           SET X=""

           if $LENGTH(Y)>2&($LENGTH(Y)<31)

               SET X=Y

 +9        QUIT X

YNH       ; Yes No Help

 +1        WRITE !,"        Enter either 'Y' or 'N'."

           QUIT

LNH       ; Length Help

 +1        WRITE !,"          This response must have at least 3 characters and no more than 30"

 +2        WRITE !,"          characters and must not contain embedded uparrow."

           QUIT

CKN(X)    ; Check New Name is Unique

 +1        SET X=$$NWX($GET(X))

           SET X=$SELECT(+X>0:0,1:1)

           QUIT X

CKT(X)    ; Check New Title is Unique

 +1        SET X=$$TWX($GET(X))

           SET X=$SELECT(+X>0:0,1:1)

           QUIT X

 +2       ;

 +3       ; Miscellaneous

TIEN(X)   ;   Type IEN

 +1        NEW GMTSI,GMTSIEN

           SET GMTSIEN=0

           FOR GMTSI=5:1

               Begin DoDot:1

 +2                if $GET(^GMT(142,GMTSI,0))["GMTS HS ADHOC OPTION"

                       QUIT

                   IF GMTSI>4999999

                       SET GMTSI=5999999

                       QUIT

 +3                if '$DATA(^GMT(142,GMTSI))

                       SET GMTSIEN=GMTSI

               End DoDot:1

               if +GMTSIEN>0

                   QUIT

 +4        SET X=GMTSIEN

           QUIT X

OIEN(X)   ;   Object IEN

 +1        NEW GMTSIEN,GMTSIT

           SET GMTSIT=+($PIECE($$SITE^VASITE,"^",3))

           if +GMTSIT=0

               QUIT -1

 +2        SET GMTSIEN=+($ORDER(^GMT(142.5,(GMTSIT_"9999")),-1))+1

           if $DATA(^GMT(142.5,+GMTSIEN,0))

               QUIT -1

 +3        SET X=GMTSIEN

 +4        QUIT X

BOX(X)    ;   Get HS Object IEN from B Index

 +1        NEW GMTSI,GMTSX,GMTSO,GMTSN

           SET GMTSN=$GET(X)

           if '$LENGTH(GMTSN)

               QUIT 0

 +2        SET (GMTSI,GMTSO)=0

FOR

               SET GMTSI=$ORDER(^GMT(142.5,"B",$EXTRACT(GMTSN,1,30),GMTSI))

               if +GMTSI=0

                   QUIT

               Begin DoDot:1

 +3                SET GMTSX=$PIECE($GET(^GMT(142.5,+GMTSI,0)),"^",1)

                   if $$UP^XLFSTR(GMTSN)=$$UP^XLFSTR(GMTSX)

                       SET GMTSO=GMTSI

               End DoDot:1

               if GMTSO>0

                   QUIT

 +4        SET X=+($GET(GMTSO))

 +5        QUIT X

NWX(X)    ;   Get HS Name IEN from Word Index

 +1        NEW GMTSI,GMTSX,GMTST,GMTSN,GMTSW

           SET GMTSN=$$UP^XLFSTR($GET(X))

           if '$LENGTH(GMTSN)

               QUIT 0

 +2        SET GMTSW=$PIECE(GMTSN," ",1)

           SET (GMTSI,GMTST)=0

FOR

               SET GMTSI=$ORDER(^GMT(142,"AW",GMTSW,GMTSI))

               if +GMTSI=0

                   QUIT

               Begin DoDot:1

 +3                SET GMTSX=$PIECE($GET(^GMT(142,+GMTSI,0)),"^",1)

                   if $$UP^XLFSTR(GMTSN)=$$UP^XLFSTR(GMTSX)

                       SET GMTST=GMTSI

               End DoDot:1

               if GMTST>0

                   QUIT

 +4        SET X=+($GET(GMTST))

 +5        QUIT X

TWX(X)    ;   Get HS Title IEN from Word Index

 +1        NEW GMTSI,GMTSX,GMTST,GMTSN,GMTSW

           SET GMTSN=$$UP^XLFSTR($GET(X))

           if '$LENGTH(GMTSN)

               QUIT 0

 +2        SET GMTSW=$PIECE(GMTSN," ",1)

           SET (GMTSI,GMTST)=0

FOR

               SET GMTSI=$ORDER(^GMT(142,"AW",GMTSW,GMTSI))

               if +GMTSI=0

                   QUIT

               Begin DoDot:1

 +3                SET GMTSX=$PIECE($GET(^GMT(142,+GMTSI,"T")),"^",1)

                   if $$UP^XLFSTR(GMTSN)=$$UP^XLFSTR(GMTSX)

                       SET GMTST=GMTSI

               End DoDot:1

               if GMTST>0

                   QUIT

 +4        SET X=+($GET(GMTST))

 +5        QUIT X

NN(X)     ;   New Name

 +1        NEW GMTSNN,GMTSNI,GMTSNS

 +2        SET GMTSNN=$GET(X)

           SET GMTSNI=$PIECE(GMTSNN," ",$LENGTH(GMTSNN," "))

 +3        SET GMTSNS=$PIECE(GMTSNN," ",1,($LENGTH(GMTSNN," ")-1))

 +4        if +GMTSNI=0

               SET GMTSNS=GMTSNN

           if +GMTSNI=0

               SET GMTSNI=1

           SET GMTSNI=+GMTSNI+1

 +5        SET GMTSNS=$$TRIM(GMTSNS)

 +6        if ($LENGTH(GMTSNS)+$LENGTH(GMTSNI))>29

               SET GMTSNS=$EXTRACT(GMTSNS,1,30-($LENGTH(GMTSNI)+2))

 +7        SET X=$$TRIM(GMTSNS)_" "_GMTSNI

 +8        QUIT X

DEL(X)    ;   Delete Routine X

 +1        SET X=$GET(X)

           if '$LENGTH(X)

               QUIT

           if $LENGTH(X)>8

               QUIT

           if $$ROK(X)=0

               QUIT

           XECUTE ^%ZOSF("DEL")

           QUIT

ROK(X)    ;   Routine Ok

 +1        SET X=$GET(X)

           if '$LENGTH(X)

               QUIT 0

 +2        NEW GMTSEX,GMTSTXT

           SET GMTSEX="S GMTSTXT=$T(+1^"_X_")"

           XECUTE GMTSEX

           if '$LENGTH(GMTSTXT)

               QUIT 0

           QUIT 1

TX(R,T,L) ;   Get Text (Routine/Tag/Line)

 +1        NEW GMTSEX,GMTSTXT

           SET GMTSEX="S GMTSTXT=$T("_T_"+"_L_"^"_R_")"

           XECUTE GMTSEX

           SET X=GMTSTXT

 +2        QUIT X

TRIM(X)   ;   Trim Spaces

 +1        SET X=$GET(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        SET X=$$UP^XLFSTR($EXTRACT(X,1))_$EXTRACT(X,2,$LENGTH(X))

 +4        QUIT X

GMTSOBU.m