GMTSXPD5.m

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")