- GMTSXPD5 ;SLC/KER - Health Summary Dist (PDX) ;Jun 05, 2023@17:01
- ;;2.7;Health Summary;**35,56,144**;Oct 20, 1995;Build 17
- ;
- ; External References
- ; DBIA 1023 $$FIRSTUP^VAQUTL50
- ; DBIA 1023 $$ADDSEG^VAQUTL50
- ; DBIA 10086 HOME^%ZIS
- ; DBIA 10060 ^VA(200,
- ; DBIA 2056 $$GET1^DIQ (file 200)
- ; DBIA 10141 BMES^XPDUTL
- ; DBIA 10141 MES^XPDUTL
- ;
- Q
- PDX(GMTSCOMP,GMTSTIM,GMTSOCC,GMTSACT) ; Install PDX Data Segment
- ;
- ; PDX( )
- ; GMTSCOMP Component Name (.01 of 142.1)
- ; GMTSTIM Time Limits Applicable
- ; GMTSOCC Occurrence Limits Applicable
- ; GMTSACT Action to perform; INSTALL (default) or UPDATE
- ;
- N GMTSENV S GMTSENV=$$ENV Q:'GMTSENV N GMTSNAME,GMTSERR,GMTS Q:'$L(GMTSCOMP)
- S (GMTS,GMTSERR)="",GMTSTIM=$G(GMTSTIM),GMTSOCC=$G(GMTSOCC),GMTSACT=$G(GMTSACT,"INSTALL")
- S GMTSNAME=$$FIRSTUP^VAQUTL50(GMTSCOMP)
- D INSP S GMTS=+$O(^GMT(142.1,"B",GMTSCOMP,0)) I ('GMTS) D NOPDX Q
- I GMTSACT="INSTALL" S GMTSERR=$$ADDSEG^VAQUTL50(GMTS,GMTSTIM,GMTSOCC)
- I GMTSACT="UPDATE" S GMTSERR=$$UPDSEG^VAQUTL50(GMTS,GMTSTIM,GMTSOCC)
- I (GMTSERR<0) D PDXER Q
- D PDXOK Q
- ;
- ; PDX Messages
- INSP ; Installing PDX Segment
- N GMTST,GMTSA,GMTSG
- I GMTSACT="UPDATE" S GMTSA=" Updating",GMTSG="in"
- E S GMTSA=" Adding",GMTSG="to"
- S GMTST=GMTSA_" """_$$UP(GMTSNAME)_""" component "_GMTSG_" the PDX package" D BM(GMTST) Q
- NOPDX ; No PDX Segment Installed
- N GMTST
- S GMTST=" Component not found in Health Summary" D M(GMTST)
- S GMTST=" and not added to PDX package" 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 M(GMTST),M("") Q
- PDXOK ; PDX Segment filled ok
- N GMTST,GMTSA
- S GMTSA=$S(GMTSACT="UPDATE":"updated",1:"added")
- S GMTST=" Component successfully "_GMTSA D M(GMTST),M("") Q
- ;
- ; Misc
- ENV(X) ; Environment check
- D HOME^%ZIS I +($G(DUZ))=0 D BM(" User (DUZ) not defined"),M(" ") Q 0
- I '$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) 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[HGMTSXPD5 2485 printed Mar 13, 2025@21:05:47 Page 2
- GMTSXPD5 ;SLC/KER - Health Summary Dist (PDX) ;Jun 05, 2023@17:01
- +1 ;;2.7;Health Summary;**35,56,144**;Oct 20, 1995;Build 17
- +2 ;
- +3 ; External References
- +4 ; DBIA 1023 $$FIRSTUP^VAQUTL50
- +5 ; DBIA 1023 $$ADDSEG^VAQUTL50
- +6 ; DBIA 10086 HOME^%ZIS
- +7 ; DBIA 10060 ^VA(200,
- +8 ; DBIA 2056 $$GET1^DIQ (file 200)
- +9 ; DBIA 10141 BMES^XPDUTL
- +10 ; DBIA 10141 MES^XPDUTL
- +11 ;
- +12 QUIT
- PDX(GMTSCOMP,GMTSTIM,GMTSOCC,GMTSACT) ; 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 ; GMTSACT Action to perform; INSTALL (default) or UPDATE
- +7 ;
- +8 NEW GMTSENV
- SET GMTSENV=$$ENV
- if 'GMTSENV
- QUIT
- NEW GMTSNAME,GMTSERR,GMTS
- if '$LENGTH(GMTSCOMP)
- QUIT
- +9 SET (GMTS,GMTSERR)=""
- SET GMTSTIM=$GET(GMTSTIM)
- SET GMTSOCC=$GET(GMTSOCC)
- SET GMTSACT=$GET(GMTSACT,"INSTALL")
- +10 SET GMTSNAME=$$FIRSTUP^VAQUTL50(GMTSCOMP)
- +11 DO INSP
- SET GMTS=+$ORDER(^GMT(142.1,"B",GMTSCOMP,0))
- IF ('GMTS)
- DO NOPDX
- QUIT
- +12 IF GMTSACT="INSTALL"
- SET GMTSERR=$$ADDSEG^VAQUTL50(GMTS,GMTSTIM,GMTSOCC)
- +13 IF GMTSACT="UPDATE"
- SET GMTSERR=$$UPDSEG^VAQUTL50(GMTS,GMTSTIM,GMTSOCC)
- +14 IF (GMTSERR<0)
- DO PDXER
- QUIT
- +15 DO PDXOK
- QUIT
- +16 ;
- +17 ; PDX Messages
- INSP ; Installing PDX Segment
- +1 NEW GMTST,GMTSA,GMTSG
- +2 IF GMTSACT="UPDATE"
- SET GMTSA=" Updating"
- SET GMTSG="in"
- +3 IF '$TEST
- SET GMTSA=" Adding"
- SET GMTSG="to"
- +4 SET GMTST=GMTSA_" """_$$UP(GMTSNAME)_""" component "_GMTSG_" the PDX package"
- DO BM(GMTST)
- QUIT
- NOPDX ; No PDX Segment Installed
- +1 NEW GMTST
- +2 SET GMTST=" Component not found in Health Summary"
- DO M(GMTST)
- +3 SET GMTST=" and not added to PDX package"
- DO M(GMTST)
- DO M("")
- QUIT
- PDXER ; Error filing PDX Segment
- +1 NEW GMTST
- +2 SET GMTST=$PIECE($GET(GMTSERR),"^",2)
- if '$LENGTH(GMTST)
- QUIT
- +3 SET GMTST=" "_GMTST
- DO M(GMTST)
- DO M("")
- QUIT
- PDXOK ; PDX Segment filled ok
- +1 NEW GMTST,GMTSA
- +2 SET GMTSA=$SELECT(GMTSACT="UPDATE":"updated",1:"added")
- +3 SET GMTST=" Component successfully "_GMTSA
- DO M(GMTST)
- DO M("")
- QUIT
- +4 ;
- +5 ; Misc
- ENV(X) ; Environment check
- +1 DO HOME^%ZIS
- IF +($GET(DUZ))=0
- DO BM(" User (DUZ) not defined")
- DO M(" ")
- QUIT 0
- +2 IF '$LENGTH($$GET1^DIQ(200,(+($GET(DUZ))_","),.01))
- 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")
