Routine: DIPR165

DIPR165 ;O-OIFO/GMB-Save DIDT as %DT ;4MAY2011

 ;;22.0;VA FileMan;**165**;Mar 30, 1999;Build 34

 ;Per VHA Directive 2004-038, this routine should not be modified.

ENV ; Environmental Check

 D BMES^XPDUTL("Perform Environment Check...")

 D CHKSTOP

 D CHKOS

 D BMES^XPDUTL("Finished Environment Check.")

CHKSTOP ;

 ; Check XPDENV 0 = Loading; 1 = Installing

 Q:'XPDENV  ; Loading Distribution - No Check

INSCHK ; Do Checks During Install Only

 W $C(7)

 D MES^XPDUTL("** Although Queuing is allowed - it is HIGHLY recommended that ALL Users and")

 D MES^XPDUTL("VISTA Background jobs be STOPPED before installation of this patch.  Failure")

 D MES^XPDUTL("to do so may result in 'source routine edited' error(s). Edits will be")

 D MES^XPDUTL("lost and record(s) may be left in an inconsistent state, for example,")

 D MES^XPDUTL("not all Cross-Referencing completed; which in turn may cause FUTURE")

 D MES^XPDUTL("VistA/FileMan Hard Errors or corrupted Data. **")

TMCHK ; Check to see if TaskMan is still running

 S X=$$TM^%ZTLOAD

 I X,'$D(^%ZTSCH("WAIT")) D

 . W $C(7)

 . D BMES^XPDUTL("* Warning TaskMan Has NOT Been Stopped or Placed in a WAIT State!")

LINH ; Check to see if Logons are Inhibited

 D GETENV^%ZOSV  ; $P(Y,"^",2) = Installing Volume

 Q:$G(^%ZIS(14.5,"LOGON",$P(Y,"^",2)))

 W $C(7)

 D BMES^XPDUTL("* Warning Logons are NOT Inhibited!")

CHKOS ; Check to see if CACHE/OpenM entry exists

 D BMES^XPDUTL("I'm checking to ensure that entry 18, CACHE/OpenM,")

 D MES^XPDUTL("exists in the MUMPS OPERATING SYSTEM (#.7) file.")

 I $P($G(^DD("OS",18,0)),U,1)="CACHE/OpenM" D  Q

 . D MES^XPDUTL("...It does.")

 W $C(7)

 D MES^XPDUTL("...Error: ^DD(""OS"",18,0) should be CACHE/OpenM, but isn't.")

 D MES^XPDUTL("...Something's not right with IEN 18 of the MUMPS OPERATING SYSTEM (#.7) file.")

 D MES^XPDUTL("...Notify SD&D.")

 S XPDQUIT=2

POSTINIT ; Post-Init

 D BMES^XPDUTL("Beginning Post-Installation...")

 D BMES^XPDUTL("  I'm saving routine DIDT as %DT.")

 N SCR,%S,%D,ZTOS

 S SCR="I 1",ZTOS=$$OSNUM^ZTMGRSET,%S="DIDT",%D="%DT" D MOVE^ZTMGRSET

 D MES^XPDUTL("  I'm saving routine DIDTC as %DTC.")

 K SCR,%S,%D,ZTOS

 S SCR="I 1",ZTOS=$$OSNUM^ZTMGRSET,%S="DIDTC",%D="%DTC" D MOVE^ZTMGRSET

 D BMES^XPDUTL("  I'm checking the settings for CACHE/OpenM")

 D MES^XPDUTL("  in the MUMPS OPERATING SYSTEM (#.7) file.")

 N LINE

 S LINE=$G(^DD("OS",18,0))

 I $P(LINE,U,3,4)="250^15000",$P(LINE,U,7)=250 D

 . D MES^XPDUTL("  ...The settings are correct. No action taken.")

 E  D

 . I $P(LINE,U,3)'=250 D

 . . D MES^XPDUTL("  ...I'm changing the GLOBAL LENGTH (MAX) (#2) field from "_$S($P(LINE,U,3)="":"Null",1:$P(LINE,U,3))_" to 250.")

 . . S $P(LINE,U,3)=250

 . I $P(LINE,U,4)'=15000 D

 . . D MES^XPDUTL("  ...I'm changing the ROUTINE SIZE (MAX) (#3) field from "_$S($P(LINE,U,4)="":"Null",1:$P(LINE,U,4))_" to 15000.")

 . . S $P(LINE,U,4)=15000

 . I $P(LINE,U,7)'=250 D

 . . D MES^XPDUTL("  ...I'm changing the INDIVIDUAL SUBSCRIPT LENGTH (#7) field from "_$S($P(LINE,U,7)="":"Null",1:$P(LINE,U,7))_" to 250.")

 . . S $P(LINE,U,7)=250

 . S ^DD("OS",18,0)=LINE

 D BMES^XPDUTL("Finished Post-Installation.")

DIPR165   ;O-OIFO/GMB-Save DIDT as %DT ;4MAY2011

 +1       ;;22.0;VA FileMan;**165**;Mar 30, 1999;Build 34

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

ENV       ; Environmental Check

 +1        DO BMES^XPDUTL("Perform Environment Check...")

 +2        DO CHKSTOP

 +3        DO CHKOS

 +4        DO BMES^XPDUTL("Finished Environment Check.")

 +5        QUIT

CHKSTOP   ;

 +1       ; Check XPDENV 0 = Loading; 1 = Installing

 +2       ; Loading Distribution - No Check

           IF 'XPDENV

               QUIT

 +3       ;

 +4       ;

INSCHK    ; Do Checks During Install Only

 +1        WRITE $CHAR(7)

 +2        DO MES^XPDUTL("** Although Queuing is allowed - it is HIGHLY recommended that ALL Users and")

 +3        DO MES^XPDUTL("VISTA Background jobs be STOPPED before installation of this patch.  Failure")

 +4        DO MES^XPDUTL("to do so may result in 'source routine edited' error(s). Edits will be")

 +5        DO MES^XPDUTL("lost and record(s) may be left in an inconsistent state, for example,")

 +6        DO MES^XPDUTL("not all Cross-Referencing completed; which in turn may cause FUTURE")

 +7        DO MES^XPDUTL("VistA/FileMan Hard Errors or corrupted Data. **")

 +8       ;

TMCHK     ; Check to see if TaskMan is still running

 +1        SET X=$$TM^%ZTLOAD

 +2        IF X

               IF '$DATA(^%ZTSCH("WAIT"))

                   Begin DoDot:1

 +3                    WRITE $CHAR(7)

 +4                    DO BMES^XPDUTL("* Warning TaskMan Has NOT Been Stopped or Placed in a WAIT State!")

                   End DoDot:1

 +5       ;

LINH      ; Check to see if Logons are Inhibited

 +1       ; $P(Y,"^",2) = Installing Volume

           DO GETENV^%ZOSV

 +2        IF $GET(^%ZIS(14.5,"LOGON",$PIECE(Y,"^",2)))

               QUIT

 +3        WRITE $CHAR(7)

 +4        DO BMES^XPDUTL("* Warning Logons are NOT Inhibited!")

 +5        QUIT

CHKOS     ; Check to see if CACHE/OpenM entry exists

 +1        DO BMES^XPDUTL("I'm checking to ensure that entry 18, CACHE/OpenM,")

 +2        DO MES^XPDUTL("exists in the MUMPS OPERATING SYSTEM (#.7) file.")

 +3        IF $PIECE($GET(^DD("OS",18,0)),U,1)="CACHE/OpenM"

               Begin DoDot:1

 +4                DO MES^XPDUTL("...It does.")

               End DoDot:1

               QUIT

 +5        WRITE $CHAR(7)

 +6        DO MES^XPDUTL("...Error: ^DD(""OS"",18,0) should be CACHE/OpenM, but isn't.")

 +7        DO MES^XPDUTL("...Something's not right with IEN 18 of the MUMPS OPERATING SYSTEM (#.7) file.")

 +8        DO MES^XPDUTL("...Notify SD&D.")

 +9        SET XPDQUIT=2

 +10       QUIT

POSTINIT  ; Post-Init

 +1        DO BMES^XPDUTL("Beginning Post-Installation...")

 +2        DO BMES^XPDUTL("  I'm saving routine DIDT as %DT.")

 +3        NEW SCR,%S,%D,ZTOS

 +4        SET SCR="I 1"

           SET ZTOS=$$OSNUM^ZTMGRSET

           SET %S="DIDT"

           SET %D="%DT"

           DO MOVE^ZTMGRSET

 +5        DO MES^XPDUTL("  I'm saving routine DIDTC as %DTC.")

 +6        KILL SCR,%S,%D,ZTOS

 +7        SET SCR="I 1"

           SET ZTOS=$$OSNUM^ZTMGRSET

           SET %S="DIDTC"

           SET %D="%DTC"

           DO MOVE^ZTMGRSET

 +8        DO BMES^XPDUTL("  I'm checking the settings for CACHE/OpenM")

 +9        DO MES^XPDUTL("  in the MUMPS OPERATING SYSTEM (#.7) file.")

 +10       NEW LINE

 +11       SET LINE=$GET(^DD("OS",18,0))

 +12       IF $PIECE(LINE,U,3,4)="250^15000"

               IF $PIECE(LINE,U,7)=250

                   Begin DoDot:1

 +13                   DO MES^XPDUTL("  ...The settings are correct. No action taken.")

                   End DoDot:1

 +14      IF '$TEST

               Begin DoDot:1

 +15               IF $PIECE(LINE,U,3)'=250

                       Begin DoDot:2

 +16                       DO MES^XPDUTL("  ...I'm changing the GLOBAL LENGTH (MAX) (#2) field from "_$SELECT($PIECE(LINE,U,3)="":"Null",1:$PIECE(LINE,U,3))_" to 250.")

 +17                       SET $PIECE(LINE,U,3)=250

                       End DoDot:2

 +18               IF $PIECE(LINE,U,4)'=15000

                       Begin DoDot:2

 +19                       DO MES^XPDUTL("  ...I'm changing the ROUTINE SIZE (MAX) (#3) field from "_$SELECT($PIECE(LINE,U,4)="":"Null",1:$PIECE(LINE,U,4))_" to 15000.")

 +20                       SET $PIECE(LINE,U,4)=15000

                       End DoDot:2

 +21               IF $PIECE(LINE,U,7)'=250

                       Begin DoDot:2

 +22                       DO MES^XPDUTL("  ...I'm changing the INDIVIDUAL SUBSCRIPT LENGTH (#7) field from "_$SELECT($PIECE(LINE,U,7)="":"Null",1:$PIECE(LINE,U,7))_" to 250.")

 +23                       SET $PIECE(LINE,U,7)=250

                       End DoDot:2

 +24               SET ^DD("OS",18,0)=LINE

               End DoDot:1

 +25       DO BMES^XPDUTL("Finished Post-Installation.")

 +26       QUIT

DIPR165.m