- GMTSXPD5 ; SLC/KER - Health Summary Dist (PDX) ; 08/27/2002
- ;;2.7;Health Summary;**35,56**;Oct 20, 1995
- ;
- ; 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) ; Install PDX Data Segment
- ;
- ; PDX( )
- ; GMTSCOMP Component Name (.01 of 142.1)
- ; GMTSTIM Time Limits Applicable
- ; GMTSOCC Occurrence Limits Applicable
- ;
- N GMTSENV S GMTSENV=$$ENV Q:'GMTSENV 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
- ;
- ; PDX Messages
- INSP ; Installing PDX Segment
- N GMTST
- S GMTST=" Adding """_$$UP(GMTSNAME)_""" component to 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
- S GMTST=" Component successfully added" 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")
- GMTSXPD5 ; SLC/KER - Health Summary Dist (PDX) ; 08/27/2002
- +1 ;;2.7;Health Summary;**35,56**;Oct 20, 1995
- +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) ; 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 GMTSENV
- SET GMTSENV=$$ENV
- IF 'GMTSENV
- QUIT
- 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)
- +11 IF (GMTSERR<0)
- DO PDXER
- QUIT
- +12 DO PDXOK
- QUIT
- +13 ;
- +14 ; PDX Messages
- INSP ; Installing PDX Segment
- +1 NEW GMTST
- +2 SET GMTST=" Adding """_$$UP(GMTSNAME)_""" component to 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
- +2 SET GMTST=" Component successfully added"
- DO M(GMTST)
- DO M("")
- QUIT
- +3 ;
- +4 ; 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")
