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
;
Q
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")
Q
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)
Q
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 Dec 13, 2024@01:58:57 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")
