- GMTSXPD1 ; SLC/KER - Health Summary Dist (Component) ; 08/27/2002
- ;;2.7;Health Summary;**35,56**;Oct 20, 1995
- ;
- ; 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
- ;
- ; Messages
- INST ; Installing Component
- N GMTST S GMTST=" Filing """_$$UP(GMTSMNM)_""" component in Health Summary" D BM(GMTST) 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) D NOTI 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
- NOTI ; Not Installed
- N GMTST S GMTST=" Could not install new 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 edited/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")
- GMTSXPD1 ; SLC/KER - Health Summary Dist (Component) ; 08/27/2002
- +1 ;;2.7;Health Summary;**35,56**;Oct 20, 1995
- +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
- +12 ;
- +13 ; Messages
- INST ; Installing Component
- +1 NEW GMTST
- SET GMTST=" Filing """_$$UP(GMTSMNM)_""" component in Health Summary"
- DO BM(GMTST)
- 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)
- DO NOTI
- 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
- NOTI ; Not Installed
- +1 NEW GMTST
- SET GMTST=" Could not install new 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 edited/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")