SCMCENV ;ALB/REW - PCMM Environment Checker ; 3 Feb 1996
;;5.3;Scheduling;**41**;AUG 13, 1993
EN ;entry point
W !,"PCMM Installation Requirements:",!
IF $D(XPDABORT)#2 W !!?4,"*** Warning: Because variable XPDABORT exists, PCMM will not install."
N SCX,SCPATCH,SCROUT,SCCOMM,SC2LINE,SC2DATA,SCGLOB,SC2CHECK,SCARR,SCSUB
W !,">>> Checking Programmer Variables:"
IF +$G(DUZ)'>0!($G(DUZ(0))'="@")!($G(U)'="^")!('$D(DT)) D Q
. S XPDABORT=2
. W !,"You must first initialize Programmer Environment by running ^XUP",!
ELSE D
. W " ...Ok"
BLDCHK ;check build file entries
W !,">>> Checking BUILD File Entries:"
F SCX=1:1 S SCPATCH=$P($P($T(BUILD+SCX),";;",2),U,1) Q:'$L(SCPATCH) D
.W !,?5,SCPATCH
.IF '$D(^XPD(9.6,"B",SCPATCH)) D
..N SCPKG,SCVER
..S SCPKG=$P($P($T(BUILD+SCX),";;",2),U,2)
..S SCVER=$P($P($T(BUILD+SCX),";;",2),U,3)
..IF $$VERSION^XPDUTL(SCPKG)'=SCVER D
...S XPDABORT=2
...W !,"Missing Required Package File Entry (Package/Patch): ",SCPATCH
..ELSE D
...W " ...Ok - in Package File"
.ELSE D
..W " ...Ok"
PKGCHK ;check package file entries
W !,">>> Checking PACKAGE File Entries:"
F SCX=1:1 S SCPATCH=$P($T(PACKAGE+SCX),";;",2) Q:'$L(SCPATCH) D
.N SCPKG,SCVER,SCPTC,SCPKGI,SCVERI
.W !,?5,SCPATCH
.IF '$$PATCH^XPDUTL(SCPATCH) D
..S XPDABORT=2
..W:$G(XPDABORT) !,"Missing Required (Package/Patch) Entry: ",SCPATCH
.ELSE D
..W " Ok"
;check patched routines
;check patched routines
RTCHK W !,">>> Checking Routines: "
;needs to be improved if 1 digit patches are checked
F SCX=1:1 S SCRT=$P($T(ROUTINE+SCX),";;",2) Q:'$L(SCRT) D
.S SCROUT=$P(SCRT,U,1)
.W !,?5,$P(SCRT,U,3)," v",$P(SCRT,U,2),?30,"Patch#: ",$P(SCRT,U,4),?43,"Routine: ^",SCROUT," ..."
.S SCCOMM="S SC2LINE=$P($T(+2"_U_SCROUT_"),"";;"",2)"
.X SCCOMM
.S SC2CHECK=$P(SCRT,U,2,99)
.IF '$L(SC2LINE) D Q
..W "Missing (Required Routine)"
..S XPDABORT=2
.ELSE D
..IF $P(SC2LINE,";",1)>$P(SC2CHECK,U,1) D Q
...W !?10,"Version of ",$P(SC2LINE,";",2)," is greater than standard - No patch checks done"
..IF $P(SC2LINE,";",1)<$P(SC2CHECK,U,1) D Q
...W !?10,"Version of ",$P(SC2LINE,";",2)," is less than required"
...S XPDABORT=2
..IF $P(SC2LINE,";",3)'[$P(SC2CHECK,U,3) D Q
...W !?10,"Missing Patch # ",$P(SC2CHECK,U,3)
...S XPDABORT=2
..W "Ok"
GLOBCHK W !,">>> Checking Globals:"
F SCX=1:1 S SCGLOB=$P($T(GLOB+SCX),";;",2) Q:'$L(SCGLOB) D
.W !,?5,SCGLOB
.IF $$GET1^DID(.84,"","","NAME")'="DIALOG" D
..W " ...Missing"
..S XPDABORT=2
.ELSE D
..W " ...Ok"
W:$D(XPDABORT) !,">>> PCMM Aborted in Environment Checker"
W:'$D(XPDABORT) !!,">>> Environment is Ok"
Q
;
PACKAGE ;
;;XU*8.0*2
;;XU*8.0*15
;;XU*8.0*16
;;XU*8.0*28
BUILD ;
;;RPC BROKER 1.0^XWB^1.0
ROUTINE ;
;;DICA^21.0^VA FileMan^17^Dec 28, 1994
;;SDUTL3^5.3^Scheduling^30^AUG 13, 1993
;
GLOB ;
;;^DI(.84
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCENV 2892 printed Apr 09, 2024@22:02:21 Page 2
SCMCENV ;ALB/REW - PCMM Environment Checker ; 3 Feb 1996
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
EN ;entry point
+1 WRITE !,"PCMM Installation Requirements:",!
+2 IF $DATA(XPDABORT)#2
WRITE !!?4,"*** Warning: Because variable XPDABORT exists, PCMM will not install."
+3 NEW SCX,SCPATCH,SCROUT,SCCOMM,SC2LINE,SC2DATA,SCGLOB,SC2CHECK,SCARR,SCSUB
+4 WRITE !,">>> Checking Programmer Variables:"
+5 IF +$GET(DUZ)'>0!($GET(DUZ(0))'="@")!($GET(U)'="^")!('$DATA(DT))
Begin DoDot:1
+6 SET XPDABORT=2
+7 WRITE !,"You must first initialize Programmer Environment by running ^XUP",!
End DoDot:1
QUIT
+8 IF '$TEST
Begin DoDot:1
+9 WRITE " ...Ok"
End DoDot:1
BLDCHK ;check build file entries
+1 WRITE !,">>> Checking BUILD File Entries:"
+2 FOR SCX=1:1
SET SCPATCH=$PIECE($PIECE($TEXT(BUILD+SCX),";;",2),U,1)
if '$LENGTH(SCPATCH)
QUIT
Begin DoDot:1
+3 WRITE !,?5,SCPATCH
+4 IF '$DATA(^XPD(9.6,"B",SCPATCH))
Begin DoDot:2
+5 NEW SCPKG,SCVER
+6 SET SCPKG=$PIECE($PIECE($TEXT(BUILD+SCX),";;",2),U,2)
+7 SET SCVER=$PIECE($PIECE($TEXT(BUILD+SCX),";;",2),U,3)
+8 IF $$VERSION^XPDUTL(SCPKG)'=SCVER
Begin DoDot:3
+9 SET XPDABORT=2
+10 WRITE !,"Missing Required Package File Entry (Package/Patch): ",SCPATCH
End DoDot:3
+11 IF '$TEST
Begin DoDot:3
+12 WRITE " ...Ok - in Package File"
End DoDot:3
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 WRITE " ...Ok"
End DoDot:2
End DoDot:1
PKGCHK ;check package file entries
+1 WRITE !,">>> Checking PACKAGE File Entries:"
+2 FOR SCX=1:1
SET SCPATCH=$PIECE($TEXT(PACKAGE+SCX),";;",2)
if '$LENGTH(SCPATCH)
QUIT
Begin DoDot:1
+3 NEW SCPKG,SCVER,SCPTC,SCPKGI,SCVERI
+4 WRITE !,?5,SCPATCH
+5 IF '$$PATCH^XPDUTL(SCPATCH)
Begin DoDot:2
+6 SET XPDABORT=2
+7 if $GET(XPDABORT)
WRITE !,"Missing Required (Package/Patch) Entry: ",SCPATCH
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 WRITE " Ok"
End DoDot:2
End DoDot:1
+10 ;check patched routines
+11 ;check patched routines
RTCHK WRITE !,">>> Checking Routines: "
+1 ;needs to be improved if 1 digit patches are checked
+2 FOR SCX=1:1
SET SCRT=$PIECE($TEXT(ROUTINE+SCX),";;",2)
if '$LENGTH(SCRT)
QUIT
Begin DoDot:1
+3 SET SCROUT=$PIECE(SCRT,U,1)
+4 WRITE !,?5,$PIECE(SCRT,U,3)," v",$PIECE(SCRT,U,2),?30,"Patch#: ",$PIECE(SCRT,U,4),?43,"Routine: ^",SCROUT," ..."
+5 SET SCCOMM="S SC2LINE=$P($T(+2"_U_SCROUT_"),"";;"",2)"
+6 XECUTE SCCOMM
+7 SET SC2CHECK=$PIECE(SCRT,U,2,99)
+8 IF '$LENGTH(SC2LINE)
Begin DoDot:2
+9 WRITE "Missing (Required Routine)"
+10 SET XPDABORT=2
End DoDot:2
QUIT
+11 IF '$TEST
Begin DoDot:2
+12 IF $PIECE(SC2LINE,";",1)>$PIECE(SC2CHECK,U,1)
Begin DoDot:3
+13 WRITE !?10,"Version of ",$PIECE(SC2LINE,";",2)," is greater than standard - No patch checks done"
End DoDot:3
QUIT
+14 IF $PIECE(SC2LINE,";",1)<$PIECE(SC2CHECK,U,1)
Begin DoDot:3
+15 WRITE !?10,"Version of ",$PIECE(SC2LINE,";",2)," is less than required"
+16 SET XPDABORT=2
End DoDot:3
QUIT
+17 IF $PIECE(SC2LINE,";",3)'[$PIECE(SC2CHECK,U,3)
Begin DoDot:3
+18 WRITE !?10,"Missing Patch # ",$PIECE(SC2CHECK,U,3)
+19 SET XPDABORT=2
End DoDot:3
QUIT
+20 WRITE "Ok"
End DoDot:2
End DoDot:1
GLOBCHK WRITE !,">>> Checking Globals:"
+1 FOR SCX=1:1
SET SCGLOB=$PIECE($TEXT(GLOB+SCX),";;",2)
if '$LENGTH(SCGLOB)
QUIT
Begin DoDot:1
+2 WRITE !,?5,SCGLOB
+3 IF $$GET1^DID(.84,"","","NAME")'="DIALOG"
Begin DoDot:2
+4 WRITE " ...Missing"
+5 SET XPDABORT=2
End DoDot:2
+6 IF '$TEST
Begin DoDot:2
+7 WRITE " ...Ok"
End DoDot:2
End DoDot:1
+8 if $DATA(XPDABORT)
WRITE !,">>> PCMM Aborted in Environment Checker"
+9 if '$DATA(XPDABORT)
WRITE !!,">>> Environment is Ok"
+10 QUIT
+11 ;
PACKAGE ;
+1 ;;XU*8.0*2
+2 ;;XU*8.0*15
+3 ;;XU*8.0*16
+4 ;;XU*8.0*28
BUILD ;
+1 ;;RPC BROKER 1.0^XWB^1.0
ROUTINE ;
+1 ;;DICA^21.0^VA FileMan^17^Dec 28, 1994
+2 ;;SDUTL3^5.3^Scheduling^30^AUG 13, 1993
+3 ;
GLOB ;
+1 ;;^DI(.84
+2 ;
