Routine: GMTSP56

GMTSP56 ; CIO/SLC - Post Install GMTS*2.7*56    ; 08/27/2002

 ;;2.7;Health Summary;**56**;Oct 20, 1995

 ; External References

 ;   DBIA 10096  ^%ZOSF("DEL"

 ;   DBIA 10096  ^%ZOSF("TEST"

 ;   DBIA 10013  ^DIK

 ;   DBIA 10141  BMES^XPDUTL

 ;   DBIA 10141  MES^XPDUTL

POST ; Post-Install

 N GMTSRTN,GMTSEXT,GMTSCMP,GMTSDEL S GMTSDEL=0

 D BM(" Checking for obsolete components NTM and MEAS")

 S GMTSRTN="GMTSPXM",GMTSEXT="PXRHS09",GMTSCMP="NTM" D CHKDEL

 S GMTSRTN="GMTSPXMP",GMTSEXT="PXRHS20",GMTSCMP="MEAS" D CHKDEL

 I +($G(GMTSDEL))=0 D M("   Components not found, nothing deleted")

CHKDEL ; Check and Delete

 Q:'$L($G(GMTSRTN))  Q:'$L($G(GMTSEXT))  Q:'$L($G(GMTSCMP))

 N GMTSROK,GMTSEOK,GMTSCPI,X

 S GMTSEOK=$$ROK(GMTSEXT) Q:+GMTSEOK>0

 S GMTSROK=$$ROK(GMTSRTN),GMTSCPI=$O(^GMT(142.1,"C",GMTSCMP,0))

 I +GMTSCPI>0 D

 . N DA,DIK,GMTSTY,GMTSST S GMTSTY=0,GMTSDEL=+($G(GMTSDEL))+1

 . D M(("   Deleting Component "_$P($G(^GMT(142.1,+GMTSCPI,0)),"^",1)))

 . F  S GMTSTY=$O(^GMT(142,"AE",GMTSCPI,GMTSTY)) Q:+GMTSTY=0  D

 . . S GMTSST=0 F  S GMTSST=$O(^GMT(142,"AE",GMTSCPI,GMTSTY,GMTSST)) Q:+GMTSST=0  D

 . . . S DA(1)=+GMTSTY,DA=+GMTSST,DIK="^GMT(142,"_DA(1)_",1," D ^DIK

 . S DA=GMTSCPI,DIK="^GMT(142.1," D ^DIK

 S X=GMTSRTN X ^%ZOSF("DEL")

 S GMTSROK=$$ROK(GMTSRTN)

ROK(X) ; Routine OK

 S X=$G(X) Q:'$L(X) 0  Q:$L(X)>8 0  X ^%ZOSF("TEST") Q:$T 1  Q 0

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[HGMTSP56   1701     printed  Feb 18, 2025@23:25:18                                                                                                                                                                                                     Page 2

GMTSP56   ; CIO/SLC - Post Install GMTS*2.7*56    ; 08/27/2002

 +1       ;;2.7;Health Summary;**56**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10096  ^%ZOSF("DEL"

 +5       ;   DBIA 10096  ^%ZOSF("TEST"

 +6       ;   DBIA 10013  ^DIK

 +7       ;   DBIA 10141  BMES^XPDUTL

 +8       ;   DBIA 10141  MES^XPDUTL

 +9       ;

 +10       QUIT

POST      ; Post-Install

 +1        NEW GMTSRTN,GMTSEXT,GMTSCMP,GMTSDEL

           SET GMTSDEL=0

 +2        DO BM(" Checking for obsolete components NTM and MEAS")

 +3        SET GMTSRTN="GMTSPXM"

           SET GMTSEXT="PXRHS09"

           SET GMTSCMP="NTM"

           DO CHKDEL

 +4        SET GMTSRTN="GMTSPXMP"

           SET GMTSEXT="PXRHS20"

           SET GMTSCMP="MEAS"

           DO CHKDEL

 +5        IF +($GET(GMTSDEL))=0

               DO M("   Components not found, nothing deleted")

 +6        QUIT

CHKDEL    ; Check and Delete

 +1        if '$LENGTH($GET(GMTSRTN))

               QUIT

           if '$LENGTH($GET(GMTSEXT))

               QUIT

           if '$LENGTH($GET(GMTSCMP))

               QUIT

 +2        NEW GMTSROK,GMTSEOK,GMTSCPI,X

 +3        SET GMTSEOK=$$ROK(GMTSEXT)

           if +GMTSEOK>0

               QUIT

 +4        SET GMTSROK=$$ROK(GMTSRTN)

           SET GMTSCPI=$ORDER(^GMT(142.1,"C",GMTSCMP,0))

 +5        IF +GMTSCPI>0

               Begin DoDot:1

 +6                NEW DA,DIK,GMTSTY,GMTSST

                   SET GMTSTY=0

                   SET GMTSDEL=+($GET(GMTSDEL))+1

 +7                DO M(("   Deleting Component "_$PIECE($GET(^GMT(142.1,+GMTSCPI,0)),"^",1)))

 +8                FOR

                       SET GMTSTY=$ORDER(^GMT(142,"AE",GMTSCPI,GMTSTY))

                       if +GMTSTY=0

                           QUIT

                       Begin DoDot:2

 +9                        SET GMTSST=0

FOR

                               SET GMTSST=$ORDER(^GMT(142,"AE",GMTSCPI,GMTSTY,GMTSST))

                               if +GMTSST=0

                                   QUIT

                               Begin DoDot:3

 +10                               SET DA(1)=+GMTSTY

                                   SET DA=+GMTSST

                                   SET DIK="^GMT(142,"_DA(1)_",1,"

                                   DO ^DIK

                               End DoDot:3

                       End DoDot:2

 +11               SET DA=GMTSCPI

                   SET DIK="^GMT(142.1,"

                   DO ^DIK

               End DoDot:1

 +12       SET X=GMTSRTN

           XECUTE ^%ZOSF("DEL")

 +13       SET GMTSROK=$$ROK(GMTSRTN)

 +14       QUIT

ROK(X)    ; Routine OK

 +1        SET X=$GET(X)

           if '$LENGTH(X)

               QUIT 0

           if $LENGTH(X)>8

               QUIT 0

           XECUTE ^%ZOSF("TEST")

           if $TEST

               QUIT 1

           QUIT 0

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

GMTSP56.m