| 1 | MAGENV77 ;WOIFO/MJK; P77 (Reports) Environment Check ; 06 Jun 2006 7:50 AM
|
|---|
| 2 | ;;3.0;IMAGING;**77**;07-December-2006;;Build 982
|
|---|
| 3 | ;; Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | ; Check for the existence of an 'AD' cross reference in the 2005 or 2005.1 file.
|
|---|
| 19 | ; If one exists and it was not created by the VistA Imaging Team, alert the installer
|
|---|
| 20 | ; and terminate the install.
|
|---|
| 21 | ;
|
|---|
| 22 | ; Also check for any cross reference on Field 7 - Date/Time Image Saved. There should be
|
|---|
| 23 | ; no cross references except the 'AD' cross reference created by this Patch.
|
|---|
| 24 | ;
|
|---|
| 25 | NEW %,%X,%Y,CTR,D,D0,D1,D2,DA,DG,DIC,DICR,DIK,DIW,IMGFILE,MAILMSG,MESSAGE,SS4,SS5,SS6
|
|---|
| 26 | NEW X,XMDUZ,XMERR,XMSUBJ,XMTO,XMZ,Y
|
|---|
| 27 | ;
|
|---|
| 28 | S CTR=0
|
|---|
| 29 | ;
|
|---|
| 30 | F IMGFILE=2005,2005.1 U IO(0) W !! D 1,2,3,4
|
|---|
| 31 | I $G(XPDQUIT) D XPDQUIT
|
|---|
| 32 | Q
|
|---|
| 33 | 1 ; I started out with the Traditional Type cross reference for the 'AD' xref. Skip Ormsby suggested that I use 'AD' as the
|
|---|
| 34 | ; xref but use the New Index type. This code removes the Traditional xref from the DD at those alpha sites that installed
|
|---|
| 35 | ; the earlier p77 't' versions.
|
|---|
| 36 | ;
|
|---|
| 37 | S SS4=0
|
|---|
| 38 | F S SS4=$O(^DD(IMGFILE,7,1,SS4)) Q:'SS4 D
|
|---|
| 39 | . I $P(^DD(IMGFILE,7,1,SS4,0),U,2)="AD",($G(^DD(IMGFILE,7,1,SS4,"%D",1,0))["VistA Imaging Team") D
|
|---|
| 40 | . . S DA=SS4,DA(1)=7,DA(2)=IMGFILE,DIK="^DD("_DA(2)_","_DA(1)_",1," D ^DIK
|
|---|
| 41 | . . K ^MAG(IMGFILE,"AD")
|
|---|
| 42 | . . Q
|
|---|
| 43 | . Q
|
|---|
| 44 | Q
|
|---|
| 45 | 2 ; If an 'AD' xref is not defined, there should not be an 'AD' node.
|
|---|
| 46 | ;
|
|---|
| 47 | I '$D(^DD(IMGFILE,0,"IX","AD"))&('$D(^DD("IX","BB",IMGFILE,"AD"))) D
|
|---|
| 48 | . I '$D(^MAG(IMGFILE,"AD")) Q
|
|---|
| 49 | . S MESSAGE="File: "_$P(^DIC(IMGFILE,0),U)_" (#"_IMGFILE_") dictionary does not have an 'AD' cross reference defined for any field yet an 'AD' global node exists in global ^MAG("_IMGFILE_","
|
|---|
| 50 | . D ABORT(MESSAGE)
|
|---|
| 51 | . Q
|
|---|
| 52 | Q
|
|---|
| 53 | 3 ; There should not be a Traditional 'AD' xref.
|
|---|
| 54 | ;
|
|---|
| 55 | I $D(^DD(IMGFILE,0,"IX","AD")) D
|
|---|
| 56 | . S SS5=""
|
|---|
| 57 | . F S SS5=$O(^DD(IMGFILE,0,"IX","AD",SS5)) Q:'SS5 S SS6="" D
|
|---|
| 58 | . . F S SS6=$O(^DD(IMGFILE,0,"IX","AD",SS5,SS6)) Q:'SS6 D
|
|---|
| 59 | . . . S MESSAGE="File: "_$P(^DIC(IMGFILE,0),U)_" (#"_IMGFILE_") Field: "_$P(^DD(IMGFILE,SS6,0),U)_" (#"_SS6_") - has an illegal 'AD' cross reference"
|
|---|
| 60 | . . . D ABORT(MESSAGE)
|
|---|
| 61 | . . . Q
|
|---|
| 62 | . . Q
|
|---|
| 63 | . Q
|
|---|
| 64 | Q
|
|---|
| 65 | 4 ; Check for 'AD' New Type Index Cross Reference.
|
|---|
| 66 | ; It must have been created by P77 for field 7 (Date/Time Image Saved.)
|
|---|
| 67 | ;
|
|---|
| 68 | I $D(^DD("IX","BB",IMGFILE,"AD")) D
|
|---|
| 69 | . S SS5=""
|
|---|
| 70 | . F S SS5=$O(^DD("IX","BB",IMGFILE,"AD",SS5)) Q:SS5="" D
|
|---|
| 71 | . . I $P(^DD("IX",SS5,0),U,3)["Created by Patch 77" Q
|
|---|
| 72 | . . S MESSAGE="File: "_$P(^DIC(IMGFILE,0),U)_" - has an illegal 'AD' 'New Index' type cross reference"
|
|---|
| 73 | . . D ABORT(MESSAGE)
|
|---|
| 74 | . . Q
|
|---|
| 75 | . Q
|
|---|
| 76 | Q
|
|---|
| 77 | ABORT(MESSAGE) ; Build a mail message. Set 'Do not install' flag.
|
|---|
| 78 | ;
|
|---|
| 79 | S XPDQUIT=2
|
|---|
| 80 | I CTR=0 D
|
|---|
| 81 | . D GETENV^%ZOSV
|
|---|
| 82 | . S CTR=CTR+1,MAILMSG(CTR)=$P(Y,U,3)_" "_$P(Y,U)
|
|---|
| 83 | . S CTR=CTR+1,MAILMSG(CTR)=""
|
|---|
| 84 | . Q
|
|---|
| 85 | S CTR=CTR+1
|
|---|
| 86 | S MAILMSG(CTR)=MESSAGE
|
|---|
| 87 | D BMES^XPDUTL(MESSAGE)
|
|---|
| 88 | Q
|
|---|
| 89 | XPDQUIT ;
|
|---|
| 90 | ;
|
|---|
| 91 | U IO(0) W !!!
|
|---|
| 92 | S MESSAGE="Please resolve these issues before installing Patch 77"
|
|---|
| 93 | D ABORT(MESSAGE)
|
|---|
| 94 | U IO(0) W !!!
|
|---|
| 95 | S XMDUZ=$G(DUZ) S:'XMDUZ XMDUZ=.5
|
|---|
| 96 | S XMSUBJ="Patch 77 Cross Reference Issues"
|
|---|
| 97 | S XMTO("G.MAG SERVER")=""
|
|---|
| 98 | D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,"MAILMSG",.XMTO,,.XMZ,)
|
|---|
| 99 | I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
