GMTSP36.m

GMTSP36 ; SLC/KER - Oncology HS Comp Post-Install        ; 11/19/1999

 ;;2.7;Health Summary;**36**;Oct 20, 1995

 ;

 Q

POST ; Post Install

 ;                   

 ;  GMTSPKR  Minimum Version required for "Active" Component

 ;  GMTSPKV  Package Version in UCI

 ;  GMTSDAF  Disable Flag  ""=Active/"T"=Temporary/"P"=Permanent

 ;  GMTSOOM  Out of Order Message

 ;                                      

 I +$$VERSION^XPDUTL("GMTS")<2.7 D HSVNF Q

 N GMTSPKR,GMTSPKV,GMTSIOK,GMTSDAF,GMTSOOM,GMTSV1,GMTSV2,GMI,GMTJ,GMTNM,GMTSEG,GMTSI,GMTSIFN

 S GMTSIOK=1,GMTSV1=$$VERSION^XPDUTL("ONC"),GMTSV2=$$VERSION^XPDUTL("ONCO")

 S GMTSPKV=$S(GMTSV1>GMTSV2:GMTSV1,GMTSV2>GMTSV1:GMTSV2,1:GMTSV1)

 S GMTSPKR="2.11",GMTSOOM="",GMTSDAF=""

 S:+GMTSPKV<GMTSPKR GMTSDAF="T",GMTSOOM="Oncology Component requires v "_GMTSPKR

 D ADD(236,"ONCOLOGY","ONC","EXTRACT","GMTSONE",,,,"Oncology",,,GMTSDAF,GMTSOOM,1)

 D:GMTSIOK PDX("ONCOLOGY")

 Q

ADD(GMTSIEN,GMTSNAME,GMTSABBR,GMTSTAG,GMTSRTN,GMTSTIML,GMTSOCCL,GMTSSKEY,GMTSDHDN,GMTSICDT,GMTSPROV,GMTSDAF,GMTSDOOM,GMTSINCL) ; Add Component

 ;                 

 ;  ADD( )

 ;          GMTSIEN   Internal Entry Number File 142.1

 ;          GMTSNAME  Component Name

 ;          GMTSABBR  Abbreviation

 ;          GMTSTAG   Display Routine Tag

 ;          GMTSRTN   Display Routine

 ;          GMTSTIML  Time Limits Applicable

 ;          GMTSOCCL  Occurrence Limits Applicable

 ;          GMTSSKEY  Security Key (Component Locking)

 ;          GMTSDHDN  Default Header Name

 ;          GMTSICDT  ICD Text Applicable

 ;          GMTSPROV  Provider Narrative Text Applicable

 ;          GMTSDAF   Disable Flag (null, T or P)

 ;          GMTSOOM   Out of Order Message

 ;          GMTSINCL  Include Disabled in Ad Hoc (1/0)

 ;                          

 S GMTSNAME=$G(GMTSNAME),GMTSIEN=+($G(GMTSIEN)),GMTSRTN=$G(GMTSRTN)

 D:'$L($G(GMTSNAME))!(+($G(GMTSIEN))'>0)!('$L($G(GMTSRTN))) NOTOK

 Q:'$L($G(GMTSNAME))  Q:+($G(GMTSIEN))'>0  Q:'$L($G(GMTSRTN))

 N DIE,DIK,DA,DR,DIC,DLAYGO,DINUM,X,Y,INCLUDE,GMTS,GMTSROUT,GMTSTAT

 S GMTSROUT="",GMTSTAT=$D(^GMT(142.1,+GMTSIEN,0))

 S GMTS=+$O(^GMT(142.1,"B",GMTSNAME,0)) D:GMTS=GMTSIEN ALRDY,NOTOK Q:GMTS=GMTSIEN

 D INST S GMTSNAME=$$NAME($G(GMTSNAME)) D:'$L($G(GMTSNAME)) NNAME,NOTOK Q:'$L(GMTSNAME)

 S GMTSTAG=$G(GMTSTAG),GMTSRTN=$G(GMTSRTN) S GMTSROUT=$$ROUT((GMTSTAG_";"_GMTSRTN))

 D:'$L($G(GMTSROUT)) NRTN,NOTOK Q:'$L(GMTSROUT)  S GMTSTIML=$$TIML($G(GMTSTIML))

 S GMTSOCCL=$$OCCL($G(GMTSOCCL)) S GMTSABBR=$$ABBR($G(GMTSABBR)) S GMTSSKEY=$$LOCK($G(GMTSSKEY))

 S GMTSDHDN=$$DHDN($G(GMTSDHDN)) S GMTSICDT=$$ICDT($G(GMTSICDT))

 S GMTSPROV=$$PROV($G(GMTSPROV)) S GMTSDAF=$$DAF($G(GMTSDAF)) S GMTSOOM=$$OOM($G(GMTSOOM))

 S:$L(GMTSDAF)&('$L(GMTSOOM)) GMTSOOM="Component "_GMTSNAME_$S(GMTSDAF="T":" Temporarily",GMTSDAF="P":" Permanently",1:"")_" Disabled"

 S DINUM=0,(DIC,DLAYGO)=142.1,DIC(0)="NXL",X=GMTSNAME S:'$D(^GMT(142.1,+($G(GMTSIEN)),0)) DINUM=+($G(GMTSIEN)) I +DINUM'>1 D EXIST,NOTOK Q

 D ^DIC D:+($G(Y))'>0 FAILED,NOTOK Q:+($G(Y))'>0  S GMTSNAME=$$NAME($G(GMTSNAME)) D:'$L($G(GMTSNAME)) NNAME,NOTOK Q:'$L(GMTSNAME)

 S DIE=DIC,DA=+($G(Y)),DR="1///^S X="""_$G(GMTSTAG)_"""_$C(59)_"""_$G(GMTSRTN)_""""

 S:$L($G(GMTSTIML)) DR=DR_";2///"_GMTSTIML S:$L($G(GMTSABBR)) DR=DR_";3///"_GMTSABBR S:$L($G(GMTSOCCL)) DR=DR_";4///"_GMTSOCCL

 S:$L($G(GMTSDAF)) DR=DR_";5///"_GMTSDAF S:$L($G(GMTSSKEY)) DR=DR_";6///"_GMTSSKEY S:$L($G(GMTSOOM)) DR=DR_";8///"_GMTSOOM

 S:$L($G(GMTSDHDN)) DR=DR_";9///"_GMTSDHDN S:$L($G(GMTSICDT)) DR=DR_";11///"_GMTSICDT S:$L($G(GMTSPROV)) DR=DR_";12///"_GMTSPROV

 D ^DIE,DES S DIK=DIE D IX^DIK D:GMTSTAT&($D(^GMT(142.1,+($G(DA)),0))) SCESE D:'GMTSTAT&($D(^GMT(142.1,+($G(DA)),0))) SCESS

 I +($G(GMTSINCL)) S INCLUDE=0 D ENPOST^GMTSLOAD

 Q

PDX(GMTSCOMP,GMTSTIM,GMTSOCC) ; Install PDX Data Segment

 ;                    

 ;  PDX( )

 ;          GMTSCOMP   Component Name (.01 of 142.1)

 ;          GMTSTIM    Time Limits Applicable

 ;          GMTSOCC    Occurrence Limits Applicable

 ;               

 N GMTSNAME,GMTSERR,GMTS Q:'$L(GMTSCOMP)

 S (GMTS,GMTSERR)="",GMTSTIM=$G(GMTSTIM),GMTSOCC=$G(GMTSOCC),GMTSNAME=$$FIRSTUP^VAQUTL50(GMTSCOMP)

 D INSP S GMTS=+$O(^GMT(142.1,"B",GMTSCOMP,0)) I ('GMTS) D NOPDX Q

 S GMTSERR=$$ADDSEG^VAQUTL50(GMTS,GMTSTIM,GMTSOCC) I (GMTSERR<0) D PDXER Q

 D PDXOK

 Q

 ; Check Input

NAME(X) ;   Check Name (required)

 S X=$G(X) K:X[""""!($A(X)=45) X Q:'$D(X) ""

 I $D(X) K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X

 I $L($G(X)),'$D(^GMT(142.1,+($G(Y)),0)) D

 . K:$D(^GMT(142.1,"B",X)) X Q:'$D(X)  Q:+($G(Y))'>0  I $P($G(^GMT(142.1,+($G(Y)),0)),"^",1)'=$G(X) K X

 S X=$G(X) Q X

ROUT(X) ;   Check Routine (required)

 S X=$G(X) K:X[""""!($A(X)=45) X Q:'$D(X) ""

 K:$L(X)>17!($L(X)<3)!'(X?1U1.7UN1";"1U1.7UN) X Q:'$D(X) ""

 I @("$L($T("_$P(X,";")_"^"_$P(X,";",2)_"))'>0") K X

 S X=$G(X) Q X

TIML(X) ;   Check Time Limits

 S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""

ABBR(X) ;   Check Abbreviation

 S X=$G(X) S:X[""""!($A(X)=45) X="" S:$L(X)>4!($L(X)<2)!'(X?2.4UN) X="" Q X

OCCL(X) ;   Check Occurrence Limits

 S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""

LOCK(X) ;   Check Lock

 S X=$G(X) S:X[""""!($A(X)=45) X="" S:$L(X)>30!($L(X)<1) X="" Q:'$L(X) "" S:'$D(^DIC(19.1,"B",X)) X="" Q X

DHDN(X) ;   Check Default Header Name

 S X=$G(X) S:X[""""!($A(X)=45) X="" S:$L(X)>20!($L(X)<2) X="" Q X

ICDT(X) ;   Check ICD Text Flag

 S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""

PROV(X) ;   Check Provider Narrative Flag

 S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""

DAF(X) ;   Check Disable Flag

 S X=$G(X) Q:X="T" "T" Q:X="T" "P" Q ""

OOM(X) ;   Check Out of Order Message

 S X=$G(X) Q:$L(X)<3 "" Q:$L(X)>78 "" Q X

 Q

 ;              

 ; Messages

 ;   Health Summary Type messages

HSVNF ;     Health Summary Version not found

 N GMTST S GMTST="   Health Summary Version 2.7 not found" D BM(GMTST) Q

NNAME ;     No Name

 N GMTST S GMTST="   No or invalid Health Summary Component name" D BM(GMTST) D NOTI Q

NRTN ;     No Routine

 N GMTST S GMTST="   No or invalid Health Summary display routine" D BM(GMTST) D NOTI Q

INST ;     Installing Component

 N GMTST S GMTST=" Filing "_GMTSNAME_" component in HEALTH SUMMARY COMPONENT FILE (#142.1)" D BM(GMTST) Q

NOTI ;     Not Installed

 N GMTST S GMTST="   Could not install new component" D M(GMTST) Q

EXIST ;     DINUMed entry Exist

 N GMTST S GMTST="   Can not add component, DINUM'ed entry already exist" D BM(GMTST) Q

ALRDY ;     Component Already Installed

 N GMTST S GMTST="   "_GMTSNAME_" component has already been installed" D BM(GMTST) S GMTST="   in the HEALTH SUMMARY COMPONENT FILE (#142.1)" D M(GMTST) Q

FAILED ;     Failed Installation

 N GMTST S GMTST="   Failed to install "_GMTSNAME_" component" D BM(GMTST) Q

SCESS ;     Successfully Installed

 N GMTSD S GMTSD=0 D DISAB Q:+($G(GMTSD))

 N GMTST S GMTST="   Successfully installed the "_GMTSNAME_" component" D BM(GMTST) Q

SCESE ;     Successfully Edited

 N GMTSD S GMTSD=0 D DISAB Q:+($G(GMTSD))

 N GMTST S GMTST="   Successfully edited/updated the "_GMTSNAME_" component" D BM(GMTST) Q

DISAB ;

 Q:+($G(GMTSIEN))=0  Q:$P($G(^GMT(142.1,+($G(GMTSIEN)),0)),"^",6)=""

 N GMTSF,GMTSM,GMTST S GMTSF=$P($G(^GMT(142.1,+($G(GMTSIEN)),0)),"^",6)

 S GMTSF=$S(GMTSF="T":"Temporarily",GMTSF="P":"Permanently",1:"") Q:'$L(GMTSF)

 S GMTSD=1,GMTST="",GMTSM=$P($G(^GMT(142.1,+($G(GMTSIEN)),0)),"^",8)

 S GMTST="   Componet "_GMTSNAME_" is installed, but "_GMTSF_" disabled" D BM(GMTST)

 S GMTST="" S:$L(GMTSM) GMTST="   Out of order message:  """_GMTSM_"""" D:$L(GMTST) M(GMTST)

 Q

 ;   PDX Messages

INSP ;     Installing PDX Segment

 N GMTST S GMTST=" Filing "_GMTSCOMP_" component in PDX Data Segments" D BM(GMTST) Q

NOPDX ;     No PDX Segment Installed

 N GMTST S GMTST="   "_GMTSCOMP_" not found in HEALTH SUMMARY COMPONENT file." D BM(GMTST) S GMTST="   "_GMTSNAME_" not added to VAQ - DATA SEGMENT file." D M(GMTST),M("") Q

PDXER ;     Error filing PDX Segment

 N GMTST S GMTST=$P($G(GMTSERR),"^",2) Q:'$L(GMTST)  S GMTST="   "_GMTST D BM(GMTST),M("") Q

PDXOK ;     PDX Segment filled ok

 N GMTST S GMTST="   "_GMTSNAME_" added to VAQ - DATA SEGMENT file (#394.71)." D BM(GMTST),M("") Q

 ;   Message Lines

NOTOK ;     Install is not OK

 S:+($G(GMTSIOK))>0 GMTSIOK=0 Q

BM(X) ;     Blank Line with Message

 D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q

M(X) ;     Message

 D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q

 ;                    

DES ; Description

 Q:+($G(GMTSIEN))=0  Q:+($G(DT))=0  Q:'$D(^GMT(142.1,+GMTSIEN,0))

SDES ;   Save Description

 N GMTSX,GMTSI,GMTST,GMTSC,GMTSHN,GMTSNN,GMTSHD,GMTSH

 S GMTSH="^GMT(142.1,"_GMTSIEN_",3.5)",GMTST="",GMTSC=0

 F GMTSI=1:1 D  Q:'$L(GMTST)

 . S GMTST="" S GMTSX="S GMTST=$T(DEST+"_GMTSI_"^GMTSP36)" X GMTSX S GMTST=$P(GMTST,";",2) Q:'$L(GMTST)

 . S GMTSC=GMTSC+1 K:GMTSC=1 @GMTSH S GMTSHN="^GMT(142.1,"_GMTSIEN_",3.5,0)",GMTSHD="^^"_GMTSC_"^"_GMTSC_"^"_DT_"^",GMTSNN="^GMT(142.1,"_GMTSIEN_",3.5,"_GMTSC_",0)"

 . S @GMTSHN=GMTSHD,@GMTSNN=GMTST

 Q

DEST ;   Description Text

 ;This component will extract selected data items from the

 ;ONCOLOGY PRIMARY file.  

 ;;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMTSP36   9124     printed  Mar 13, 2025@21:03:42                                                                                                                                                                                                     Page 2

GMTSP36   ; SLC/KER - Oncology HS Comp Post-Install        ; 11/19/1999

 +1       ;;2.7;Health Summary;**36**;Oct 20, 1995

 +2       ;

 +3        QUIT 

POST      ; Post Install

 +1       ;                   

 +2       ;  GMTSPKR  Minimum Version required for "Active" Component

 +3       ;  GMTSPKV  Package Version in UCI

 +4       ;  GMTSDAF  Disable Flag  ""=Active/"T"=Temporary/"P"=Permanent

 +5       ;  GMTSOOM  Out of Order Message

 +6       ;                                      

 +7        IF +$$VERSION^XPDUTL("GMTS")<2.7

               DO HSVNF

               QUIT 

 +8        NEW GMTSPKR,GMTSPKV,GMTSIOK,GMTSDAF,GMTSOOM,GMTSV1,GMTSV2,GMI,GMTJ,GMTNM,GMTSEG,GMTSI,GMTSIFN

 +9        SET GMTSIOK=1

           SET GMTSV1=$$VERSION^XPDUTL("ONC")

           SET GMTSV2=$$VERSION^XPDUTL("ONCO")

 +10       SET GMTSPKV=$SELECT(GMTSV1>GMTSV2:GMTSV1,GMTSV2>GMTSV1:GMTSV2,1:GMTSV1)

 +11       SET GMTSPKR="2.11"

           SET GMTSOOM=""

           SET GMTSDAF=""

 +12       if +GMTSPKV<GMTSPKR

               SET GMTSDAF="T"

               SET GMTSOOM="Oncology Component requires v "_GMTSPKR

 +13       DO ADD(236,"ONCOLOGY","ONC","EXTRACT","GMTSONE",,,,"Oncology",,,GMTSDAF,GMTSOOM,1)

 +14       if GMTSIOK

               DO PDX("ONCOLOGY")

 +15       QUIT 

ADD(GMTSIEN,GMTSNAME,GMTSABBR,GMTSTAG,GMTSRTN,GMTSTIML,GMTSOCCL,GMTSSKEY,GMTSDHDN,GMTSICDT,GMTSPROV,GMTSDAF,GMTSDOOM,GMTSINCL) ; Add Component

 +1       ;                 

 +2       ;  ADD( )

 +3       ;          GMTSIEN   Internal Entry Number File 142.1

 +4       ;          GMTSNAME  Component Name

 +5       ;          GMTSABBR  Abbreviation

 +6       ;          GMTSTAG   Display Routine Tag

 +7       ;          GMTSRTN   Display Routine

 +8       ;          GMTSTIML  Time Limits Applicable

 +9       ;          GMTSOCCL  Occurrence Limits Applicable

 +10      ;          GMTSSKEY  Security Key (Component Locking)

 +11      ;          GMTSDHDN  Default Header Name

 +12      ;          GMTSICDT  ICD Text Applicable

 +13      ;          GMTSPROV  Provider Narrative Text Applicable

 +14      ;          GMTSDAF   Disable Flag (null, T or P)

 +15      ;          GMTSOOM   Out of Order Message

 +16      ;          GMTSINCL  Include Disabled in Ad Hoc (1/0)

 +17      ;                          

 +18       SET GMTSNAME=$GET(GMTSNAME)

           SET GMTSIEN=+($GET(GMTSIEN))

           SET GMTSRTN=$GET(GMTSRTN)

 +19       if '$LENGTH($GET(GMTSNAME))!(+($GET(GMTSIEN))'>0)!('$LENGTH($GET(GMTSRTN)))

               DO NOTOK

 +20       if '$LENGTH($GET(GMTSNAME))

               QUIT 

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

               QUIT 

           if '$LENGTH($GET(GMTSRTN))

               QUIT 

 +21       NEW DIE,DIK,DA,DR,DIC,DLAYGO,DINUM,X,Y,INCLUDE,GMTS,GMTSROUT,GMTSTAT

 +22       SET GMTSROUT=""

           SET GMTSTAT=$DATA(^GMT(142.1,+GMTSIEN,0))

 +23       SET GMTS=+$ORDER(^GMT(142.1,"B",GMTSNAME,0))

           if GMTS=GMTSIEN

               DO ALRDY

               DO NOTOK

           if GMTS=GMTSIEN

               QUIT 

 +24       DO INST

           SET GMTSNAME=$$NAME($GET(GMTSNAME))

           if '$LENGTH($GET(GMTSNAME))

               DO NNAME

               DO NOTOK

           if '$LENGTH(GMTSNAME)

               QUIT 

 +25       SET GMTSTAG=$GET(GMTSTAG)

           SET GMTSRTN=$GET(GMTSRTN)

           SET GMTSROUT=$$ROUT((GMTSTAG_";"_GMTSRTN))

 +26       if '$LENGTH($GET(GMTSROUT))

               DO NRTN

               DO NOTOK

           if '$LENGTH(GMTSROUT)

               QUIT 

           SET GMTSTIML=$$TIML($GET(GMTSTIML))

 +27       SET GMTSOCCL=$$OCCL($GET(GMTSOCCL))

           SET GMTSABBR=$$ABBR($GET(GMTSABBR))

           SET GMTSSKEY=$$LOCK($GET(GMTSSKEY))

 +28       SET GMTSDHDN=$$DHDN($GET(GMTSDHDN))

           SET GMTSICDT=$$ICDT($GET(GMTSICDT))

 +29       SET GMTSPROV=$$PROV($GET(GMTSPROV))

           SET GMTSDAF=$$DAF($GET(GMTSDAF))

           SET GMTSOOM=$$OOM($GET(GMTSOOM))

 +30       if $LENGTH(GMTSDAF)&('$LENGTH(GMTSOOM))

               SET GMTSOOM="Component "_GMTSNAME_$SELECT(GMTSDAF="T":" Temporarily",GMTSDAF="P":" Permanently",1:"")_" Disabled"

 +31       SET DINUM=0

           SET (DIC,DLAYGO)=142.1

           SET DIC(0)="NXL"

           SET X=GMTSNAME

           if '$DATA(^GMT(142.1,+($GET(GMTSIEN)),0))

               SET DINUM=+($GET(GMTSIEN))

           IF +DINUM'>1

               DO EXIST

               DO NOTOK

               QUIT 

 +32       DO ^DIC

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

               DO FAILED

               DO NOTOK

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

               QUIT 

           SET GMTSNAME=$$NAME($GET(GMTSNAME))

           if '$LENGTH($GET(GMTSNAME))

               DO NNAME

               DO NOTOK

           if '$LENGTH(GMTSNAME)

               QUIT 

 +33       SET DIE=DIC

           SET DA=+($GET(Y))

           SET DR="1///^S X="""_$GET(GMTSTAG)_"""_$C(59)_"""_$GET(GMTSRTN)_""""

 +34       if $LENGTH($GET(GMTSTIML))

               SET DR=DR_";2///"_GMTSTIML

           if $LENGTH($GET(GMTSABBR))

               SET DR=DR_";3///"_GMTSABBR

           if $LENGTH($GET(GMTSOCCL))

               SET DR=DR_";4///"_GMTSOCCL

 +35       if $LENGTH($GET(GMTSDAF))

               SET DR=DR_";5///"_GMTSDAF

           if $LENGTH($GET(GMTSSKEY))

               SET DR=DR_";6///"_GMTSSKEY

           if $LENGTH($GET(GMTSOOM))

               SET DR=DR_";8///"_GMTSOOM

 +36       if $LENGTH($GET(GMTSDHDN))

               SET DR=DR_";9///"_GMTSDHDN

           if $LENGTH($GET(GMTSICDT))

               SET DR=DR_";11///"_GMTSICDT

           if $LENGTH($GET(GMTSPROV))

               SET DR=DR_";12///"_GMTSPROV

 +37       DO ^DIE

           DO DES

           SET DIK=DIE

           DO IX^DIK

           if GMTSTAT&($DATA(^GMT(142.1,+($GET(DA)),0)))

               DO SCESE

           if 'GMTSTAT&($DATA(^GMT(142.1,+($GET(DA)),0)))

               DO SCESS

 +38       IF +($GET(GMTSINCL))

               SET INCLUDE=0

               DO ENPOST^GMTSLOAD

 +39       QUIT 

PDX(GMTSCOMP,GMTSTIM,GMTSOCC) ; Install PDX Data Segment

 +1       ;                    

 +2       ;  PDX( )

 +3       ;          GMTSCOMP   Component Name (.01 of 142.1)

 +4       ;          GMTSTIM    Time Limits Applicable

 +5       ;          GMTSOCC    Occurrence Limits Applicable

 +6       ;               

 +7        NEW GMTSNAME,GMTSERR,GMTS

           if '$LENGTH(GMTSCOMP)

               QUIT 

 +8        SET (GMTS,GMTSERR)=""

           SET GMTSTIM=$GET(GMTSTIM)

           SET GMTSOCC=$GET(GMTSOCC)

           SET GMTSNAME=$$FIRSTUP^VAQUTL50(GMTSCOMP)

 +9        DO INSP

           SET GMTS=+$ORDER(^GMT(142.1,"B",GMTSCOMP,0))

           IF ('GMTS)

               DO NOPDX

               QUIT 

 +10       SET GMTSERR=$$ADDSEG^VAQUTL50(GMTS,GMTSTIM,GMTSOCC)

           IF (GMTSERR<0)

               DO PDXER

               QUIT 

 +11       DO PDXOK

 +12       QUIT 

 +13      ; Check Input

NAME(X)   ;   Check Name (required)

 +1        SET X=$GET(X)

           if X[""""!($ASCII(X)=45)

               KILL X

           if '$DATA(X)

               QUIT ""

 +2        IF $DATA(X)

               if $LENGTH(X)>30!($LENGTH(X)<3)!'(X'?1P.E)

                   KILL X

 +3        IF $LENGTH($GET(X))

               IF '$DATA(^GMT(142.1,+($GET(Y)),0))

                   Begin DoDot:1

 +4                    if $DATA(^GMT(142.1,"B",X))

                           KILL X

                       if '$DATA(X)

                           QUIT 

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

                           QUIT 

                       IF $PIECE($GET(^GMT(142.1,+($GET(Y)),0)),"^",1)'=$GET(X)

                           KILL X

                   End DoDot:1

 +5        SET X=$GET(X)

           QUIT X

ROUT(X)   ;   Check Routine (required)

 +1        SET X=$GET(X)

           if X[""""!($ASCII(X)=45)

               KILL X

           if '$DATA(X)

               QUIT ""

 +2        if $LENGTH(X)>17!($LENGTH(X)<3)!'(X?1U1.7UN1";"1U1.7UN)

               KILL X

           if '$DATA(X)

               QUIT ""

 +3        IF @("$L($T("_$PIECE(X,";")_"^"_$PIECE(X,";",2)_"))'>0")

               KILL X

 +4        SET X=$GET(X)

           QUIT X

TIML(X)   ;   Check Time Limits

 +1        SET X=$GET(X)

           if X="1"!(X="Y")

               QUIT "Y"

           QUIT ""

ABBR(X)   ;   Check Abbreviation

 +1        SET X=$GET(X)

           if X[""""!($ASCII(X)=45)

               SET X=""

           if $LENGTH(X)>4!($LENGTH(X)<2)!'(X?2.4UN)

               SET X=""

           QUIT X

OCCL(X)   ;   Check Occurrence Limits

 +1        SET X=$GET(X)

           if X="1"!(X="Y")

               QUIT "Y"

           QUIT ""

LOCK(X)   ;   Check Lock

 +1        SET X=$GET(X)

           if X[""""!($ASCII(X)=45)

               SET X=""

           if $LENGTH(X)>30!($LENGTH(X)<1)

               SET X=""

           if '$LENGTH(X)

               QUIT ""

           if '$DATA(^DIC(19.1,"B",X))

               SET X=""

           QUIT X

DHDN(X)   ;   Check Default Header Name

 +1        SET X=$GET(X)

           if X[""""!($ASCII(X)=45)

               SET X=""

           if $LENGTH(X)>20!($LENGTH(X)<2)

               SET X=""

           QUIT X

ICDT(X)   ;   Check ICD Text Flag

 +1        SET X=$GET(X)

           if X="1"!(X="Y")

               QUIT "Y"

           QUIT ""

PROV(X)   ;   Check Provider Narrative Flag

 +1        SET X=$GET(X)

           if X="1"!(X="Y")

               QUIT "Y"

           QUIT ""

DAF(X)    ;   Check Disable Flag

 +1        SET X=$GET(X)

           if X="T"

               QUIT "T"

           if X="T"

               QUIT "P"

           QUIT ""

OOM(X)    ;   Check Out of Order Message

 +1        SET X=$GET(X)

           if $LENGTH(X)<3

               QUIT ""

           if $LENGTH(X)>78

               QUIT ""

           QUIT X

 +2        QUIT 

 +3       ;              

 +4       ; Messages

 +5       ;   Health Summary Type messages

HSVNF     ;     Health Summary Version not found

 +1        NEW GMTST

           SET GMTST="   Health Summary Version 2.7 not found"

           DO BM(GMTST)

           QUIT 

NNAME     ;     No Name

 +1        NEW GMTST

           SET GMTST="   No or invalid Health Summary Component name"

           DO BM(GMTST)

           DO NOTI

           QUIT 

NRTN      ;     No Routine

 +1        NEW GMTST

           SET GMTST="   No or invalid Health Summary display routine"

           DO BM(GMTST)

           DO NOTI

           QUIT 

INST      ;     Installing Component

 +1        NEW GMTST

           SET GMTST=" Filing "_GMTSNAME_" component in HEALTH SUMMARY COMPONENT FILE (#142.1)"

           DO BM(GMTST)

           QUIT 

NOTI      ;     Not Installed

 +1        NEW GMTST

           SET GMTST="   Could not install new component"

           DO M(GMTST)

           QUIT 

EXIST     ;     DINUMed entry Exist

 +1        NEW GMTST

           SET GMTST="   Can not add component, DINUM'ed entry already exist"

           DO BM(GMTST)

           QUIT 

ALRDY     ;     Component Already Installed

 +1        NEW GMTST

           SET GMTST="   "_GMTSNAME_" component has already been installed"

           DO BM(GMTST)

           SET GMTST="   in the HEALTH SUMMARY COMPONENT FILE (#142.1)"

           DO M(GMTST)

           QUIT 

FAILED    ;     Failed Installation

 +1        NEW GMTST

           SET GMTST="   Failed to install "_GMTSNAME_" component"

           DO BM(GMTST)

           QUIT 

SCESS     ;     Successfully Installed

 +1        NEW GMTSD

           SET GMTSD=0

           DO DISAB

           if +($GET(GMTSD))

               QUIT 

 +2        NEW GMTST

           SET GMTST="   Successfully installed the "_GMTSNAME_" component"

           DO BM(GMTST)

           QUIT 

SCESE     ;     Successfully Edited

 +1        NEW GMTSD

           SET GMTSD=0

           DO DISAB

           if +($GET(GMTSD))

               QUIT 

 +2        NEW GMTST

           SET GMTST="   Successfully edited/updated the "_GMTSNAME_" component"

           DO BM(GMTST)

           QUIT 

DISAB     ;

 +1        if +($GET(GMTSIEN))=0

               QUIT 

           if $PIECE($GET(^GMT(142.1,+($GET(GMTSIEN)),0)),"^",6)=""

               QUIT 

 +2        NEW GMTSF,GMTSM,GMTST

           SET GMTSF=$PIECE($GET(^GMT(142.1,+($GET(GMTSIEN)),0)),"^",6)

 +3        SET GMTSF=$SELECT(GMTSF="T":"Temporarily",GMTSF="P":"Permanently",1:"")

           if '$LENGTH(GMTSF)

               QUIT 

 +4        SET GMTSD=1

           SET GMTST=""

           SET GMTSM=$PIECE($GET(^GMT(142.1,+($GET(GMTSIEN)),0)),"^",8)

 +5        SET GMTST="   Componet "_GMTSNAME_" is installed, but "_GMTSF_" disabled"

           DO BM(GMTST)

 +6        SET GMTST=""

           if $LENGTH(GMTSM)

               SET GMTST="   Out of order message:  """_GMTSM_""""

           if $LENGTH(GMTST)

               DO M(GMTST)

 +7        QUIT 

 +8       ;   PDX Messages

INSP      ;     Installing PDX Segment

 +1        NEW GMTST

           SET GMTST=" Filing "_GMTSCOMP_" component in PDX Data Segments"

           DO BM(GMTST)

           QUIT 

NOPDX     ;     No PDX Segment Installed

 +1        NEW GMTST

           SET GMTST="   "_GMTSCOMP_" not found in HEALTH SUMMARY COMPONENT file."

           DO BM(GMTST)

           SET GMTST="   "_GMTSNAME_" not added to VAQ - DATA SEGMENT file."

           DO M(GMTST)

           DO M("")

           QUIT 

PDXER     ;     Error filing PDX Segment

 +1        NEW GMTST

           SET GMTST=$PIECE($GET(GMTSERR),"^",2)

           if '$LENGTH(GMTST)

               QUIT 

           SET GMTST="   "_GMTST

           DO BM(GMTST)

           DO M("")

           QUIT 

PDXOK     ;     PDX Segment filled ok

 +1        NEW GMTST

           SET GMTST="   "_GMTSNAME_" added to VAQ - DATA SEGMENT file (#394.71)."

           DO BM(GMTST)

           DO M("")

           QUIT 

 +2       ;   Message Lines

NOTOK     ;     Install is not OK

 +1        if +($GET(GMTSIOK))>0

               SET GMTSIOK=0

           QUIT 

BM(X)     ;     Blank Line with Message

 +1        if $DATA(XPDNM)

               DO BMES^XPDUTL($GET(X))

           if '$DATA(XPDNM)

               WRITE !!,$GET(X)

           QUIT 

M(X)      ;     Message

 +1        if $DATA(XPDNM)

               DO MES^XPDUTL($GET(X))

           if '$DATA(XPDNM)

               WRITE !,$GET(X)

           QUIT 

 +2       ;                    

DES       ; Description

 +1        if +($GET(GMTSIEN))=0

               QUIT 

           if +($GET(DT))=0

               QUIT 

           if '$DATA(^GMT(142.1,+GMTSIEN,0))

               QUIT 

SDES      ;   Save Description

 +1        NEW GMTSX,GMTSI,GMTST,GMTSC,GMTSHN,GMTSNN,GMTSHD,GMTSH

 +2        SET GMTSH="^GMT(142.1,"_GMTSIEN_",3.5)"

           SET GMTST=""

           SET GMTSC=0

 +3        FOR GMTSI=1:1

               Begin DoDot:1

 +4                SET GMTST=""

                   SET GMTSX="S GMTST=$T(DEST+"_GMTSI_"^GMTSP36)"

                   XECUTE GMTSX

                   SET GMTST=$PIECE(GMTST,";",2)

                   if '$LENGTH(GMTST)

                       QUIT 

 +5                SET GMTSC=GMTSC+1

                   if GMTSC=1

                       KILL @GMTSH

                   SET GMTSHN="^GMT(142.1,"_GMTSIEN_",3.5,0)"

                   SET GMTSHD="^^"_GMTSC_"^"_GMTSC_"^"_DT_"^"

                   SET GMTSNN="^GMT(142.1,"_GMTSIEN_",3.5,"_GMTSC_",0)"

 +6                SET @GMTSHN=GMTSHD

                   SET @GMTSNN=GMTST

               End DoDot:1

               if '$LENGTH(GMTST)

                   QUIT 

 +7        QUIT 

DEST      ;   Description Text

 +1       ;This component will extract selected data items from the

 +2       ;ONCOLOGY PRIMARY file.  

 +3       ;;