- SCMCENV ;ALB/REW - PCMM Environment Checker ; 3 Feb 1996
- ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- 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
- ;
- SCMCENV ;ALB/REW - PCMM Environment Checker ; 3 Feb 1996
- +1 ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- 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 ;
