GMTSXPD1 ;SLC/KER - Health Summary Dist (Component) ;Jul 24, 2023@17:26
;;2.7;Health Summary;**35,56,144**;Oct 20, 1995;Build 17
;
; External References
; DBIA 1023 $$FIRSTUP^VAQUTL50
; DBIA 10006 ^DIC
; DBIA 10018 ^DIE (file #142.1)
; DBIA 10013 IX^DIK
; DBIA 10103 $$NOW^XLFDT
; DBIA 10030 ^DD(
; DBIA 10086 HOME^%ZIS
; DBIA 10060 ^VA(200,
; DBIA 2056 $$GET1^DIQ (file 200)
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
Q
ADD(GMTSINI) ; Add Health Summary Component
;
; ADD(<array>)
; GMTSIEN GMTSINI(0) Internal Entry Number File 142.1
; GMTSNAME GMTSINI(.01) Component Name
; GMTSRTN GMTSINI(1) Display Routine
; GMTSEXTR GMTSINI(1.1) Extract Routine (m)
; GMTSTIML GMTSINI(2) Time Limits Applicable
; GMTSABBR GMTSINI(3) Abbreviation
; GMTSDESC GMTSINI(3.5) Description (m)
; GMTSOCCL GMTSINI(4) Occurrence Limits Applicable
; GMTSDAF GMTSINI(5) Disable Flag (null, T or P)
; GMTSSKEY GMTSINI(6) Security Key (Component Locking)
; GMTSSELF GMTSINI(7) Selection File (m)
; GMTSOOM GMTSINI(8) Out of Order Message
; GMTSDHDN GMTSINI(9) Default Header Name
; GMTSHOSL GMTSINI(10) Hospital Location Applicable
; GMTSICDT GMTSINI(11) ICD Text Applicable
; GMTSPROV GMTSINI(12) Provider Narrative Text Applicable
; GMTSPREF GMTSINI(13) Prefix
; GMTSCPTM GMTSINI(14) CPT Modifiers Applicable
;
N GMTSENV S GMTSENV=$$ENV Q:'GMTSENV 0
N GMTSIEN,GMTSNAME,GMTSMNM,GMTSABBR,GMTSTAG,GMTSRTN,GMTSTIML,GMTSOCCL,GMTSSELF
N GMTSSKEY,GMTSDHDN,GMTSHOSL,GMTSICDT,GMTSPROV,GMTSDAF,GMTSOOM,GMTSINCL,GMTSPREF,GMTSCPTM
N DIE,DIK,DA,DR,DIC,DLAYGO,DINUM,X,Y,INCLUDE,GMTS,GMTSROUT,GMTSTAT
S GMTSNAME=$G(GMTSINI(.01)),GMTSMNM=$$FIRSTUP^VAQUTL50(GMTSNAME),GMTSIEN=+($G(GMTSINI(0))),GMTSRTN=$G(GMTSINI(1))
S GMTSTAG=$P(GMTSRTN,";",1),GMTSRTN=$P(GMTSRTN,";",2) S:$L(GMTSTAG)&('$L(GMTSRTN)) GMTSRTN=GMTSTAG,GMTSTAG=""
S GMTSROUT="",GMTSTAT=$D(^GMT(142.1,+GMTSIEN,0))
I '$L($G(GMTSNAME))!(+($G(GMTSIEN))'>0)!('$L($G(GMTSRTN))) Q 0
D INST S GMTS=+$O(^GMT(142.1,"B",GMTSNAME,0)) D:GMTS=GMTSIEN ALRDY I GMTS=GMTSIEN Q 0
S GMTSNAME=$$NAME^GMTSXPD2($G(GMTSNAME)) D:'$L($G(GMTSNAME)) NNAME Q:'$L(GMTSNAME) 0
S GMTSROUT=$$ROUT^GMTSXPD2((GMTSTAG_";"_GMTSRTN)) D:'$L($G(GMTSROUT)) NRTN Q:'$L(GMTSROUT) 0
S GMTSTIML=$$TIML^GMTSXPD2($G(GMTSINI(2))),GMTSABBR=$$ABBR^GMTSXPD2($G(GMTSINI(3)))
S GMTSOCCL=$$OCCL^GMTSXPD2($G(GMTSINI(4))),GMTSDAF=$$DAF^GMTSXPD2($G(GMTSINI(5)))
S GMTSSKEY=$$LOCK^GMTSXPD2($G(GMTSINI(6))),GMTSOOM=$$OOM^GMTSXPD2($G(GMTSINI(8)))
S GMTSDHDN=$$DHDN^GMTSXPD2($G(GMTSINI(9))),GMTSHOSL=$$HOSL^GMTSXPD2($G(GMTSINI(10)))
S GMTSICDT=$$ICDT^GMTSXPD2($G(GMTSINI(11))),GMTSPROV=$$PROV^GMTSXPD2($G(GMTSINI(12)))
S GMTSPREF=$$PREF^GMTSXPD2($G(GMTSINI(13))),GMTSCPTM=$$CPTM^GMTSXPD2($G(GMTSINI(14)))
S:$L(GMTSDAF)&('$L(GMTSOOM)) GMTSOOM="Component "_GMTSNAME_$S(GMTSDAF="T":" Temporarily",GMTSDAF="P":" Permanently",1:"")_" Disabled"
S DINUM=0,DIE="^GMT(142.1,",(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 Q 0
D ^DIC S DA=+($G(Y)) D:+($G(Y))'>0 FAILED Q:+($G(Y))'>0 0
S 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(GMTSHOSL)) DR=DR_";10///"_GMTSHOSL S:$L($G(GMTSICDT)) DR=DR_";11///"_GMTSICDT
S:$L($G(GMTSPROV)) DR=DR_";12///"_GMTSPROV S:$L($G(GMTSPREF)) DR=DR_";13///"_GMTSPREF
S:$L($G(GMTSCPTM)) DR=DR_";14///"_GMTSCPTM
S DIE="^GMT(142.1," D ^DIE D:$D(GMTSINI) DES(.GMTSINI),SEL(.GMTSINI),EXT(.GMTSINI)
S DIK="^GMT(142.1," D IX^DIK D:GMTSTAT&($D(^GMT(142.1,+($G(DA)),0))) SCESE D:'GMTSTAT&($D(^GMT(142.1,+($G(DA)),0))) SCESS
I $D(GMTSINI("PDX")) S GMTSNAME=$G(GMTSNAME),GMTSTIML=$G(GMTSTIML),GMTSOCCL=$G(GMTSOCCL) D PDX^GMTSXPD5(GMTSNAME,GMTSTIML,GMTSOCCL)
Q 1
;
DES(GMTSINI) ; Description
N GMTSD0,GMTSD1,GMTSN,GMTSD,GMTSDT,GMTSIEN S GMTSIEN=+($G(GMTSINI(0))),(GMTSD0,GMTSD1)=0,GMTSDT=$P($$NOW^XLFDT,".",1)
F S GMTSD1=$O(GMTSINI(3.5,GMTSD1)) Q:+GMTSD1=0 S GMTSD0=GMTSD0+1
Q:+($G(GMTSD0))=0 S GMTSINI(3.5)=GMTSD0,GMTSD1=+($G(GMTSINI(3.5))),GMTSD0="^^"_GMTSD1_"^"_GMTSD1_"^"_GMTSDT_"^"
S GMTSN="^GMT(142.1,"_GMTSIEN_",3.5,0)",GMTSD=GMTSD0,@GMTSN=GMTSD,GMTSD1=0
F S GMTSD1=$O(GMTSINI(3.5,GMTSD1)) Q:+GMTSD1=0 S GMTSN="^GMT(142.1,"_GMTSIEN_",3.5,"_GMTSD1_",0)",GMTSD=$G(GMTSINI(3.5,GMTSD1)),@GMTSN=GMTSD
Q
SEL(GMTSINI) ; Selection Items
N GMTSD0,GMTSD1,GMTSN,GMTSF,GMTST,GMTSD,GMTSIEN S GMTSIEN=+($G(GMTSINI(0))),(GMTSD0,GMTSD1)=0
F S GMTSD1=$O(GMTSINI(7,GMTSD1)) Q:+GMTSD1=0 D
. S GMTSD=$G(GMTSINI(7,GMTSD1)),GMTSF=+($P(GMTSD,"^",1)) Q:+GMTSF=0 Q:'$D(^DD(+GMTSF)) S GMTSD0=GMTSD0+1
Q:+($G(GMTSD0))=0 S GMTSINI(7)=GMTSD0,GMTSD1=+($G(GMTSINI(7)))
S GMTSD0="^142.17P^"_GMTSD1_"^"_GMTSD1,GMTSN="^GMT(142.1,"_GMTSIEN_",1,0)",GMTSD=GMTSD0,@GMTSN=GMTSD
S GMTSD1=0 F S GMTSD1=$O(GMTSINI(7,GMTSD1)) Q:+GMTSD1=0 D
. S GMTSN="^GMT(142.1,"_GMTSIEN_",1,"_GMTSD1_",0)"
. S GMTSD=$G(GMTSINI(7,GMTSD1)),GMTSF=+($P(GMTSD,"^",1)) Q:+GMTSF=0 Q:'$D(^DD(GMTSF))
. S GMTST=+($P(GMTSD,"^",2)) S:GMTST=0 GMTST=""
. S GMTSD=GMTSF S:GMTST>0 $P(GMTSD,"^",2)=GMTST S @GMTSN=GMTSD
. S GMTSN="^GMT(142.1,"_GMTSIEN_",1,""B"","_GMTSF_","_GMTSD1_")",GMTSD="",@GMTSN=GMTSD
Q
EXT(GMTSINI) ; Extract Routines
N GMTSD0,GMTSD1,GMTSN,GMTSF,GMTST,GMTSD,GMTSIEN S GMTSIEN=+($G(GMTSINI(0))),(GMTSD0,GMTSD1)=0
F S GMTSD1=$O(GMTSINI(1.1,GMTSD1)) Q:+GMTSD1=0 D
. S GMTSD=$G(GMTSINI(1.1,GMTSD1)) Q:'$L(GMTSD) S GMTSTAG=$P(GMTSD,";",1),GMTSRTN=$P(GMTSD,";",2)
. S:$L(GMTSTAG)&('$L(GMTSRTN)) GMTSRTN=GMTSTAG,GMTSTAG="" Q:'$L(GMTSRTN) S GMTSD0=GMTSD0+1
Q:+($G(GMTSD0))=0 S GMTSINI(1.1)=GMTSD0,GMTSD1=+($G(GMTSINI(1.1)))
S GMTSD0="^142.11^"_GMTSD1_"^"_GMTSD1,GMTSN="^GMT(142.1,"_GMTSIEN_",.1,0)",GMTSD=GMTSD0,@GMTSN=GMTSD
S (GMTSD0,GMTSD1)=0 F S GMTSD1=$O(GMTSINI(1.1,GMTSD1)) Q:+GMTSD1=0 D
. S GMTSD=$G(GMTSINI(1.1,GMTSD1)) Q:'$L(GMTSD) S GMTSTAG=$P(GMTSD,";",1),GMTSRTN=$P(GMTSD,";",2) S:$L(GMTSTAG)&('$L(GMTSRTN)) GMTSRTN=GMTSTAG,GMTSTAG="" Q:'$L(GMTSRTN)
. S GMTSD0=GMTSD0+1,GMTSN="^GMT(142.1,"_GMTSIEN_",.1,"_GMTSD0_",0)",GMTSD=$G(GMTSINI(1.1,GMTSD1)),@GMTSN=GMTSD
. S GMTSN="^GMT(142.1,"_GMTSIEN_",.1,""B"","""_GMTSD_""","_GMTSD0_")",GMTSD="",@GMTSN=GMTSD
Q
RENAME(GMTSOLD,GMTSNEW) ; Rename Health Summary Component
N GMTSNAME,GMTSABBR,GMTSFDA,GMTSERROR,GMTSMESSAGE,GMTSLINE,Y
S GMTSOLD("IEN")=+$G(GMTSOLD("IEN"),0),GMTSOLD("NAME")=$G(GMTSOLD("NAME"))
S GMTSOLD("ABBR")=$G(GMTSOLD("ABBR")),GMTSNEW("NAME")=$G(GMTSNEW("NAME"))
S GMTSNEW("ABBR")=$G(GMTSNEW("ABBR"))
I $P($G(^GMT(142.1,GMTSOLD("IEN"),0)),U,1)=GMTSNEW("NAME") Q 1
D INSTE(GMTSOLD("NAME"))
I '$D(^GMT(142.1,GMTSOLD("IEN"),0)) D NOTEXIST Q 0
I GMTSOLD("NAME")'=$P($G(^GMT(142.1,GMTSOLD("IEN"),0)),U,1) D BNAME Q 0
I GMTSOLD("ABBR")'=$P($G(^GMT(142.1,GMTSOLD("IEN"),0)),U,4) D BABBR Q 0
S GMTSNAME=$$NAME^GMTSXPD2(GMTSNEW("NAME")) I '$L($G(GMTSNAME)) D NNAME Q 0
S GMTSABBR=$$ABBR^GMTSXPD2(GMTSNEW("ABBR")) I '$L($G(GMTSABBR)) D NABBR Q 0
S GMTSFDA(142.1,GMTSOLD("IEN")_",",.01)=GMTSNAME
S GMTSFDA(142.1,GMTSOLD("IEN")_",",3)=GMTSABBR
D FILE^DIE("","GMTSFDA","GMTSERROR")
I $D(GMTSERROR) D Q 0
.D MSG^DIALOG("AET",.GMTSMESSAGE,,,"GMTSERROR")
.F GMTSLINE=1:1:GMTSMESSAGE D M(GMTSMESSAGE(GMTSLINE))
.D NOTE
S GMTSTIML=$$TIML^GMTSXPD2($P($G(^GMT(142.1,GMTSOLD("IEN"),0)),U,3))
S GMTSOCCL=$$OCCL^GMTSXPD2($P($G(^GMT(142.1,GMTSOLD("IEN"),0)),U,5))
D SCESE,PDX^GMTSXPD5(GMTSNAME,GMTSTIML,GMTSOCCL,"UPDATE")
Q 1
;
; Messages
INST ; Installing Component
N GMTST S GMTST=" Filing """_$$UP(GMTSMNM)_""" component in Health Summary" D BM(GMTST) Q
INSTE(GMTSNAME) ; Updating Component
D BM(" Updating """_$$UP(GMTSNAME)_""" component in Health Summary") Q
; Reasons to Abort Install
HSVNF ; Health Summary Version not found
N GMTST S GMTST=" Health Summary Version 2.7 not found" D BM(GMTST) Q
ALRDY ; Component Already Installed
N GMTST S GMTST=" Component has already been installed" D M(GMTST) Q
NNAME ; No Name
N GMTST S GMTST=" No or invalid Health Summary Component name" D M(GMTST)
I $D(GMTSINI) D NOTI
E D NOTE
Q
NABBR ; No abbreviation
N GMTST S GMTST=" No or invalid Health Summary Component abbreviation" D M(GMTST),NOTE Q
NRTN ; No Routine
N GMTST S GMTST=" No or invalid Health Summary display routine" D M(GMTST) D NOTI Q
FAILED ; Failed Installation
N GMTST S GMTST=" Failed to install component" D M(GMTST) Q
EXIST ; DINUMed entry Exist
N GMTST S GMTST=" Can not add component, DINUM'ed entry already exist" D M(GMTST) Q
NOTEXIST ; DINUMed entry Does Not Exist
N GMTST S GMTST=" DINUM'ed entry does not exist" D M(GMTST),NOTE Q
BNAME ; Existing component has wrong name
N GMTST S GMTST=" Unexpected Health Summary Component name" D M(GMTST),NOTE Q
BABBR ; Existing component has wrong abbreviation
N GMTST S GMTST=" Unexpected Health Summary Component abbreviation" D M(GMTST),NOTE Q
NOTI ; Not Installed
N GMTST S GMTST=" Could not install new component" D M(GMTST) Q
NOTE ; Not Edited/Updated
N GMTST S GMTST=" Could not edit/update component" D M(GMTST) Q
; Success
SCESS ; Successfully Installed
N GMTSD S GMTSD=0 D DISAB Q:+($G(GMTSD))
N GMTST S GMTST=" Successfully installed new component" D M(GMTST) Q
SCESE ; Successfully Edited
N GMTSD S GMTSD=0 D DISAB Q:+($G(GMTSD))
N GMTST S GMTST=" Successfully updated component" D M(GMTST) Q
DISAB ; Disabled Component
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 """_$$UP(GMTSMNM)_""" is installed, but "_GMTSF_" disabled" D M(GMTST)
S GMTST="" S:$L(GMTSM) GMTST=" Out of order message: """_GMTSM_"""" D:$L(GMTST) M(GMTST)
Q
;
; Other
ENV(X) ; Environment check
D HOME^%ZIS I '$D(^VA(200,+($G(DUZ)),0)) D BM(" User (DUZ) not defined"),M("") Q 0
I '$L($P($G(^VA(200,+($G(DUZ)),0)),"^",1)) D BM(" Invalid User defined (DUZ)"),M("") Q 0
Q 1
BM(X) ; Blank Line with Message
Q:$D(GMTSQT) D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q
M(X) ; Message
Q:$D(GMTSQT) D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q
UP(X) ; Uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXPD1 10986 printed Nov 22, 2024@17:11:02 Page 2
GMTSXPD1 ;SLC/KER - Health Summary Dist (Component) ;Jul 24, 2023@17:26
+1 ;;2.7;Health Summary;**35,56,144**;Oct 20, 1995;Build 17
+2 ;
+3 ; External References
+4 ; DBIA 1023 $$FIRSTUP^VAQUTL50
+5 ; DBIA 10006 ^DIC
+6 ; DBIA 10018 ^DIE (file #142.1)
+7 ; DBIA 10013 IX^DIK
+8 ; DBIA 10103 $$NOW^XLFDT
+9 ; DBIA 10030 ^DD(
+10 ; DBIA 10086 HOME^%ZIS
+11 ; DBIA 10060 ^VA(200,
+12 ; DBIA 2056 $$GET1^DIQ (file 200)
+13 ; DBIA 10141 BMES^XPDUTL
+14 ; DBIA 10141 MES^XPDUTL
+15 ;
+16 QUIT
ADD(GMTSINI) ; Add Health Summary Component
+1 ;
+2 ; ADD(<array>)
+3 ; GMTSIEN GMTSINI(0) Internal Entry Number File 142.1
+4 ; GMTSNAME GMTSINI(.01) Component Name
+5 ; GMTSRTN GMTSINI(1) Display Routine
+6 ; GMTSEXTR GMTSINI(1.1) Extract Routine (m)
+7 ; GMTSTIML GMTSINI(2) Time Limits Applicable
+8 ; GMTSABBR GMTSINI(3) Abbreviation
+9 ; GMTSDESC GMTSINI(3.5) Description (m)
+10 ; GMTSOCCL GMTSINI(4) Occurrence Limits Applicable
+11 ; GMTSDAF GMTSINI(5) Disable Flag (null, T or P)
+12 ; GMTSSKEY GMTSINI(6) Security Key (Component Locking)
+13 ; GMTSSELF GMTSINI(7) Selection File (m)
+14 ; GMTSOOM GMTSINI(8) Out of Order Message
+15 ; GMTSDHDN GMTSINI(9) Default Header Name
+16 ; GMTSHOSL GMTSINI(10) Hospital Location Applicable
+17 ; GMTSICDT GMTSINI(11) ICD Text Applicable
+18 ; GMTSPROV GMTSINI(12) Provider Narrative Text Applicable
+19 ; GMTSPREF GMTSINI(13) Prefix
+20 ; GMTSCPTM GMTSINI(14) CPT Modifiers Applicable
+21 ;
+22 NEW GMTSENV
SET GMTSENV=$$ENV
if 'GMTSENV
QUIT 0
+23 NEW GMTSIEN,GMTSNAME,GMTSMNM,GMTSABBR,GMTSTAG,GMTSRTN,GMTSTIML,GMTSOCCL,GMTSSELF
+24 NEW GMTSSKEY,GMTSDHDN,GMTSHOSL,GMTSICDT,GMTSPROV,GMTSDAF,GMTSOOM,GMTSINCL,GMTSPREF,GMTSCPTM
+25 NEW DIE,DIK,DA,DR,DIC,DLAYGO,DINUM,X,Y,INCLUDE,GMTS,GMTSROUT,GMTSTAT
+26 SET GMTSNAME=$GET(GMTSINI(.01))
SET GMTSMNM=$$FIRSTUP^VAQUTL50(GMTSNAME)
SET GMTSIEN=+($GET(GMTSINI(0)))
SET GMTSRTN=$GET(GMTSINI(1))
+27 SET GMTSTAG=$PIECE(GMTSRTN,";",1)
SET GMTSRTN=$PIECE(GMTSRTN,";",2)
if $LENGTH(GMTSTAG)&('$LENGTH(GMTSRTN))
SET GMTSRTN=GMTSTAG
SET GMTSTAG=""
+28 SET GMTSROUT=""
SET GMTSTAT=$DATA(^GMT(142.1,+GMTSIEN,0))
+29 IF '$LENGTH($GET(GMTSNAME))!(+($GET(GMTSIEN))'>0)!('$LENGTH($GET(GMTSRTN)))
QUIT 0
+30 DO INST
SET GMTS=+$ORDER(^GMT(142.1,"B",GMTSNAME,0))
if GMTS=GMTSIEN
DO ALRDY
IF GMTS=GMTSIEN
QUIT 0
+31 SET GMTSNAME=$$NAME^GMTSXPD2($GET(GMTSNAME))
if '$LENGTH($GET(GMTSNAME))
DO NNAME
if '$LENGTH(GMTSNAME)
QUIT 0
+32 SET GMTSROUT=$$ROUT^GMTSXPD2((GMTSTAG_";"_GMTSRTN))
if '$LENGTH($GET(GMTSROUT))
DO NRTN
if '$LENGTH(GMTSROUT)
QUIT 0
+33 SET GMTSTIML=$$TIML^GMTSXPD2($GET(GMTSINI(2)))
SET GMTSABBR=$$ABBR^GMTSXPD2($GET(GMTSINI(3)))
+34 SET GMTSOCCL=$$OCCL^GMTSXPD2($GET(GMTSINI(4)))
SET GMTSDAF=$$DAF^GMTSXPD2($GET(GMTSINI(5)))
+35 SET GMTSSKEY=$$LOCK^GMTSXPD2($GET(GMTSINI(6)))
SET GMTSOOM=$$OOM^GMTSXPD2($GET(GMTSINI(8)))
+36 SET GMTSDHDN=$$DHDN^GMTSXPD2($GET(GMTSINI(9)))
SET GMTSHOSL=$$HOSL^GMTSXPD2($GET(GMTSINI(10)))
+37 SET GMTSICDT=$$ICDT^GMTSXPD2($GET(GMTSINI(11)))
SET GMTSPROV=$$PROV^GMTSXPD2($GET(GMTSINI(12)))
+38 SET GMTSPREF=$$PREF^GMTSXPD2($GET(GMTSINI(13)))
SET GMTSCPTM=$$CPTM^GMTSXPD2($GET(GMTSINI(14)))
+39 if $LENGTH(GMTSDAF)&('$LENGTH(GMTSOOM))
SET GMTSOOM="Component "_GMTSNAME_$SELECT(GMTSDAF="T":" Temporarily",GMTSDAF="P":" Permanently",1:"")_" Disabled"
+40 SET DINUM=0
SET DIE="^GMT(142.1,"
SET (DIC,DLAYGO)=142.1
SET DIC(0)="NXL"
SET X=GMTSNAME
if '$DATA(^GMT(142.1,+($GET(GMTSIEN)),0))
SET DINUM=+($GET(GMTSIEN))
+41 IF +DINUM'>1
DO EXIST
QUIT 0
+42 DO ^DIC
SET DA=+($GET(Y))
if +($GET(Y))'>0
DO FAILED
if +($GET(Y))'>0
QUIT 0
+43 SET DR="1///^S X="""_$GET(GMTSTAG)_"""_$C(59)_"""_$GET(GMTSRTN)_""""
+44 if $LENGTH($GET(GMTSTIML))
SET DR=DR_";2///"_GMTSTIML
+45 if $LENGTH($GET(GMTSABBR))
SET DR=DR_";3///"_GMTSABBR
if $LENGTH($GET(GMTSOCCL))
SET DR=DR_";4///"_GMTSOCCL
+46 if $LENGTH($GET(GMTSDAF))
SET DR=DR_";5///"_GMTSDAF
if $LENGTH($GET(GMTSSKEY))
SET DR=DR_";6///"_GMTSSKEY
+47 if $LENGTH($GET(GMTSOOM))
SET DR=DR_";8///"_GMTSOOM
if $LENGTH($GET(GMTSDHDN))
SET DR=DR_";9///"_GMTSDHDN
+48 if $LENGTH($GET(GMTSHOSL))
SET DR=DR_";10///"_GMTSHOSL
if $LENGTH($GET(GMTSICDT))
SET DR=DR_";11///"_GMTSICDT
+49 if $LENGTH($GET(GMTSPROV))
SET DR=DR_";12///"_GMTSPROV
if $LENGTH($GET(GMTSPREF))
SET DR=DR_";13///"_GMTSPREF
+50 if $LENGTH($GET(GMTSCPTM))
SET DR=DR_";14///"_GMTSCPTM
+51 SET DIE="^GMT(142.1,"
DO ^DIE
if $DATA(GMTSINI)
DO DES(.GMTSINI)
DO SEL(.GMTSINI)
DO EXT(.GMTSINI)
+52 SET DIK="^GMT(142.1,"
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
+53 IF $DATA(GMTSINI("PDX"))
SET GMTSNAME=$GET(GMTSNAME)
SET GMTSTIML=$GET(GMTSTIML)
SET GMTSOCCL=$GET(GMTSOCCL)
DO PDX^GMTSXPD5(GMTSNAME,GMTSTIML,GMTSOCCL)
+54 QUIT 1
+55 ;
DES(GMTSINI) ; Description
+1 NEW GMTSD0,GMTSD1,GMTSN,GMTSD,GMTSDT,GMTSIEN
SET GMTSIEN=+($GET(GMTSINI(0)))
SET (GMTSD0,GMTSD1)=0
SET GMTSDT=$PIECE($$NOW^XLFDT,".",1)
+2 FOR
SET GMTSD1=$ORDER(GMTSINI(3.5,GMTSD1))
if +GMTSD1=0
QUIT
SET GMTSD0=GMTSD0+1
+3 if +($GET(GMTSD0))=0
QUIT
SET GMTSINI(3.5)=GMTSD0
SET GMTSD1=+($GET(GMTSINI(3.5)))
SET GMTSD0="^^"_GMTSD1_"^"_GMTSD1_"^"_GMTSDT_"^"
+4 SET GMTSN="^GMT(142.1,"_GMTSIEN_",3.5,0)"
SET GMTSD=GMTSD0
SET @GMTSN=GMTSD
SET GMTSD1=0
+5 FOR
SET GMTSD1=$ORDER(GMTSINI(3.5,GMTSD1))
if +GMTSD1=0
QUIT
SET GMTSN="^GMT(142.1,"_GMTSIEN_",3.5,"_GMTSD1_",0)"
SET GMTSD=$GET(GMTSINI(3.5,GMTSD1))
SET @GMTSN=GMTSD
+6 QUIT
SEL(GMTSINI) ; Selection Items
+1 NEW GMTSD0,GMTSD1,GMTSN,GMTSF,GMTST,GMTSD,GMTSIEN
SET GMTSIEN=+($GET(GMTSINI(0)))
SET (GMTSD0,GMTSD1)=0
+2 FOR
SET GMTSD1=$ORDER(GMTSINI(7,GMTSD1))
if +GMTSD1=0
QUIT
Begin DoDot:1
+3 SET GMTSD=$GET(GMTSINI(7,GMTSD1))
SET GMTSF=+($PIECE(GMTSD,"^",1))
if +GMTSF=0
QUIT
if '$DATA(^DD(+GMTSF))
QUIT
SET GMTSD0=GMTSD0+1
End DoDot:1
+4 if +($GET(GMTSD0))=0
QUIT
SET GMTSINI(7)=GMTSD0
SET GMTSD1=+($GET(GMTSINI(7)))
+5 SET GMTSD0="^142.17P^"_GMTSD1_"^"_GMTSD1
SET GMTSN="^GMT(142.1,"_GMTSIEN_",1,0)"
SET GMTSD=GMTSD0
SET @GMTSN=GMTSD
+6 SET GMTSD1=0
FOR
SET GMTSD1=$ORDER(GMTSINI(7,GMTSD1))
if +GMTSD1=0
QUIT
Begin DoDot:1
+7 SET GMTSN="^GMT(142.1,"_GMTSIEN_",1,"_GMTSD1_",0)"
+8 SET GMTSD=$GET(GMTSINI(7,GMTSD1))
SET GMTSF=+($PIECE(GMTSD,"^",1))
if +GMTSF=0
QUIT
if '$DATA(^DD(GMTSF))
QUIT
+9 SET GMTST=+($PIECE(GMTSD,"^",2))
if GMTST=0
SET GMTST=""
+10 SET GMTSD=GMTSF
if GMTST>0
SET $PIECE(GMTSD,"^",2)=GMTST
SET @GMTSN=GMTSD
+11 SET GMTSN="^GMT(142.1,"_GMTSIEN_",1,""B"","_GMTSF_","_GMTSD1_")"
SET GMTSD=""
SET @GMTSN=GMTSD
End DoDot:1
+12 QUIT
EXT(GMTSINI) ; Extract Routines
+1 NEW GMTSD0,GMTSD1,GMTSN,GMTSF,GMTST,GMTSD,GMTSIEN
SET GMTSIEN=+($GET(GMTSINI(0)))
SET (GMTSD0,GMTSD1)=0
+2 FOR
SET GMTSD1=$ORDER(GMTSINI(1.1,GMTSD1))
if +GMTSD1=0
QUIT
Begin DoDot:1
+3 SET GMTSD=$GET(GMTSINI(1.1,GMTSD1))
if '$LENGTH(GMTSD)
QUIT
SET GMTSTAG=$PIECE(GMTSD,";",1)
SET GMTSRTN=$PIECE(GMTSD,";",2)
+4 if $LENGTH(GMTSTAG)&('$LENGTH(GMTSRTN))
SET GMTSRTN=GMTSTAG
SET GMTSTAG=""
if '$LENGTH(GMTSRTN)
QUIT
SET GMTSD0=GMTSD0+1
End DoDot:1
+5 if +($GET(GMTSD0))=0
QUIT
SET GMTSINI(1.1)=GMTSD0
SET GMTSD1=+($GET(GMTSINI(1.1)))
+6 SET GMTSD0="^142.11^"_GMTSD1_"^"_GMTSD1
SET GMTSN="^GMT(142.1,"_GMTSIEN_",.1,0)"
SET GMTSD=GMTSD0
SET @GMTSN=GMTSD
+7 SET (GMTSD0,GMTSD1)=0
FOR
SET GMTSD1=$ORDER(GMTSINI(1.1,GMTSD1))
if +GMTSD1=0
QUIT
Begin DoDot:1
+8 SET GMTSD=$GET(GMTSINI(1.1,GMTSD1))
if '$LENGTH(GMTSD)
QUIT
SET GMTSTAG=$PIECE(GMTSD,";",1)
SET GMTSRTN=$PIECE(GMTSD,";",2)
if $LENGTH(GMTSTAG)&('$LENGTH(GMTSRTN))
SET GMTSRTN=GMTSTAG
SET GMTSTAG=""
if '$LENGTH(GMTSRTN)
QUIT
+9 SET GMTSD0=GMTSD0+1
SET GMTSN="^GMT(142.1,"_GMTSIEN_",.1,"_GMTSD0_",0)"
SET GMTSD=$GET(GMTSINI(1.1,GMTSD1))
SET @GMTSN=GMTSD
+10 SET GMTSN="^GMT(142.1,"_GMTSIEN_",.1,""B"","""_GMTSD_""","_GMTSD0_")"
SET GMTSD=""
SET @GMTSN=GMTSD
End DoDot:1
+11 QUIT
RENAME(GMTSOLD,GMTSNEW) ; Rename Health Summary Component
+1 NEW GMTSNAME,GMTSABBR,GMTSFDA,GMTSERROR,GMTSMESSAGE,GMTSLINE,Y
+2 SET GMTSOLD("IEN")=+$GET(GMTSOLD("IEN"),0)
SET GMTSOLD("NAME")=$GET(GMTSOLD("NAME"))
+3 SET GMTSOLD("ABBR")=$GET(GMTSOLD("ABBR"))
SET GMTSNEW("NAME")=$GET(GMTSNEW("NAME"))
+4 SET GMTSNEW("ABBR")=$GET(GMTSNEW("ABBR"))
+5 IF $PIECE($GET(^GMT(142.1,GMTSOLD("IEN"),0)),U,1)=GMTSNEW("NAME")
QUIT 1
+6 DO INSTE(GMTSOLD("NAME"))
+7 IF '$DATA(^GMT(142.1,GMTSOLD("IEN"),0))
DO NOTEXIST
QUIT 0
+8 IF GMTSOLD("NAME")'=$PIECE($GET(^GMT(142.1,GMTSOLD("IEN"),0)),U,1)
DO BNAME
QUIT 0
+9 IF GMTSOLD("ABBR")'=$PIECE($GET(^GMT(142.1,GMTSOLD("IEN"),0)),U,4)
DO BABBR
QUIT 0
+10 SET GMTSNAME=$$NAME^GMTSXPD2(GMTSNEW("NAME"))
IF '$LENGTH($GET(GMTSNAME))
DO NNAME
QUIT 0
+11 SET GMTSABBR=$$ABBR^GMTSXPD2(GMTSNEW("ABBR"))
IF '$LENGTH($GET(GMTSABBR))
DO NABBR
QUIT 0
+12 SET GMTSFDA(142.1,GMTSOLD("IEN")_",",.01)=GMTSNAME
+13 SET GMTSFDA(142.1,GMTSOLD("IEN")_",",3)=GMTSABBR
+14 DO FILE^DIE("","GMTSFDA","GMTSERROR")
+15 IF $DATA(GMTSERROR)
Begin DoDot:1
+16 DO MSG^DIALOG("AET",.GMTSMESSAGE,,,"GMTSERROR")
+17 FOR GMTSLINE=1:1:GMTSMESSAGE
DO M(GMTSMESSAGE(GMTSLINE))
+18 DO NOTE
End DoDot:1
QUIT 0
+19 SET GMTSTIML=$$TIML^GMTSXPD2($PIECE($GET(^GMT(142.1,GMTSOLD("IEN"),0)),U,3))
+20 SET GMTSOCCL=$$OCCL^GMTSXPD2($PIECE($GET(^GMT(142.1,GMTSOLD("IEN"),0)),U,5))
+21 DO SCESE
DO PDX^GMTSXPD5(GMTSNAME,GMTSTIML,GMTSOCCL,"UPDATE")
+22 QUIT 1
+23 ;
+24 ; Messages
INST ; Installing Component
+1 NEW GMTST
SET GMTST=" Filing """_$$UP(GMTSMNM)_""" component in Health Summary"
DO BM(GMTST)
QUIT
INSTE(GMTSNAME) ; Updating Component
+1 DO BM(" Updating """_$$UP(GMTSNAME)_""" component in Health Summary")
QUIT
+2 ; Reasons to Abort Install
HSVNF ; Health Summary Version not found
+1 NEW GMTST
SET GMTST=" Health Summary Version 2.7 not found"
DO BM(GMTST)
QUIT
ALRDY ; Component Already Installed
+1 NEW GMTST
SET GMTST=" Component has already been installed"
DO M(GMTST)
QUIT
NNAME ; No Name
+1 NEW GMTST
SET GMTST=" No or invalid Health Summary Component name"
DO M(GMTST)
+2 IF $DATA(GMTSINI)
DO NOTI
+3 IF '$TEST
DO NOTE
+4 QUIT
NABBR ; No abbreviation
+1 NEW GMTST
SET GMTST=" No or invalid Health Summary Component abbreviation"
DO M(GMTST)
DO NOTE
QUIT
NRTN ; No Routine
+1 NEW GMTST
SET GMTST=" No or invalid Health Summary display routine"
DO M(GMTST)
DO NOTI
QUIT
FAILED ; Failed Installation
+1 NEW GMTST
SET GMTST=" Failed to install component"
DO M(GMTST)
QUIT
EXIST ; DINUMed entry Exist
+1 NEW GMTST
SET GMTST=" Can not add component, DINUM'ed entry already exist"
DO M(GMTST)
QUIT
NOTEXIST ; DINUMed entry Does Not Exist
+1 NEW GMTST
SET GMTST=" DINUM'ed entry does not exist"
DO M(GMTST)
DO NOTE
QUIT
BNAME ; Existing component has wrong name
+1 NEW GMTST
SET GMTST=" Unexpected Health Summary Component name"
DO M(GMTST)
DO NOTE
QUIT
BABBR ; Existing component has wrong abbreviation
+1 NEW GMTST
SET GMTST=" Unexpected Health Summary Component abbreviation"
DO M(GMTST)
DO NOTE
QUIT
NOTI ; Not Installed
+1 NEW GMTST
SET GMTST=" Could not install new component"
DO M(GMTST)
QUIT
NOTE ; Not Edited/Updated
+1 NEW GMTST
SET GMTST=" Could not edit/update component"
DO M(GMTST)
QUIT
+2 ; Success
SCESS ; Successfully Installed
+1 NEW GMTSD
SET GMTSD=0
DO DISAB
if +($GET(GMTSD))
QUIT
+2 NEW GMTST
SET GMTST=" Successfully installed new component"
DO M(GMTST)
QUIT
SCESE ; Successfully Edited
+1 NEW GMTSD
SET GMTSD=0
DO DISAB
if +($GET(GMTSD))
QUIT
+2 NEW GMTST
SET GMTST=" Successfully updated component"
DO M(GMTST)
QUIT
DISAB ; Disabled Component
+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 """_$$UP(GMTSMNM)_""" is installed, but "_GMTSF_" disabled"
DO M(GMTST)
+6 SET GMTST=""
if $LENGTH(GMTSM)
SET GMTST=" Out of order message: """_GMTSM_""""
if $LENGTH(GMTST)
DO M(GMTST)
+7 QUIT
+8 ;
+9 ; Other
ENV(X) ; Environment check
+1 DO HOME^%ZIS
IF '$DATA(^VA(200,+($GET(DUZ)),0))
DO BM(" User (DUZ) not defined")
DO M("")
QUIT 0
+2 IF '$LENGTH($PIECE($GET(^VA(200,+($GET(DUZ)),0)),"^",1))
DO BM(" Invalid User defined (DUZ)")
DO M("")
QUIT 0
+3 QUIT 1
BM(X) ; Blank Line with Message
+1 if $DATA(GMTSQT)
QUIT
if $DATA(XPDNM)
DO BMES^XPDUTL($GET(X))
if '$DATA(XPDNM)
WRITE !!,$GET(X)
QUIT
M(X) ; Message
+1 if $DATA(GMTSQT)
QUIT
if $DATA(XPDNM)
DO MES^XPDUTL($GET(X))
if '$DATA(XPDNM)
WRITE !,$GET(X)
QUIT
UP(X) ; Uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
