source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGIPS59.m@ 1279

Last change on this file since 1279 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.7 KB
Line 
1MAGIPS59 ;Post init routine to queue site activity at install ; 16 Feb 2004 2:41 PM
2 ;;3.0;IMAGING;**59**;Mar 27, 2007;Build 20
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 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20POST ;
21 ; create and send the site installation message
22 D VERCHKON ; Turn on Version Checking
23 D CR ; Run the Cross Reference on Field #2 SPEC LEVEL of File #2005.84
24 ; Check for and display Users that are assigned the MAG WINDOWS Option
25 ; but do not have either MAGDISP CLIN or MAGDISP ADMIN
26 D CHKKEY^MAGGTU9
27 D REMTASK^MAGQE4
28 D STTASK^MAGQE4
29 D INS(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
30 D NEWRPC ; Add RPC's to the OPTION: MAG WINDOWS
31 D FIXTASK ; Task off the FIX^MAGGTUX process.
32 Q
33NEWRPC ; Add new RPC's to MAG WINDOWS Option.
34 D ADDRPC("MAG3 TIU CREATE ADDENDUM","MAG WINDOWS")
35 D ADDRPC("MAG3 TIU LONG LIST OF TITLES","MAG WINDOWS")
36 D ADDRPC("MAG3 TIU MODIFY NOTE","MAG WINDOWS")
37 D ADDRPC("MAG3 TIU NEW","MAG WINDOWS")
38 D ADDRPC("MAG3 TIU SIGN RECORD","MAG WINDOWS")
39 D ADDRPC("MAG4 INDEX GET EVENT","MAG WINDOWS")
40 D ADDRPC("MAG4 INDEX GET SPECIALTY","MAG WINDOWS")
41 D ADDRPC("MAG4 INDEX GET TYPE","MAG WINDOWS")
42 D ADDRPC("MAGG PAT INFO","MAG WINDOWS")
43 D ADDRPC("TIU AUTHORIZATION","MAG WINDOWS")
44 D ADDRPC("TIU LOAD BOILERPLATE TEXT","MAG WINDOWS")
45 D ADDRPC("TIU IS THIS A CONSULT?","MAG WINDOWS")
46 D ADDRPC("GMRC LIST CONSULT REQUESTS","MAG WINDOWS")
47 D ADDRPC("MAG4 VERSION STATUS","MAG WINDOWS")
48 D ADDRPC("MAGG IS DOC CLASS","MAG WINDOWS")
49 Q
50 ; We add RPC to MAG WINDOWS Option this way instead of sending Option : MAG WINDOWS
51 ; If we send MAG WINDOWS Option, the last one installed will overwrite others.
52 ; ADDRPC copied from Patch 51, added the call "D MES^XPDUTL(" instead of "W !"
53ADDRPC(RPCNAME,OPTNAME) ;
54 N DA,DIC
55 S DIC="^DIC(19,",DIC(0)="",X=OPTNAME D ^DIC
56 I Y<0 D Q
57 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
58 . D MES^XPDUTL("Cannot find Option: """_OPTNAME_""".")
59 . Q
60 I '$D(^XWB(8994,"B",RPCNAME)) D Q
61 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
62 . D MES^XPDUTL("Cannot find RPC: """_RPCNAME_""".")
63 . Q
64 S DA(1)=+Y
65 S DIC=DIC_DA(1)_",""RPC"","
66 S DIC(0)="L" ; LAYGO should be allowed here
67 S X=RPCNAME
68 D ^DIC
69 I Y<0 D Q
70 . D MES^XPDUTL("Error Adding RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
71 . Q
72 Q
73CR ; Run the Cross reference on Field #2 SPEC LEVEL
74 ; of File #2005.84 IMAGE INDEX FOR SPECIALTY/SUBSPECIALTY
75 N DIK
76 S DIK="^MAG(2005.84,"
77 D IXALL2^DIK ; Kill all cross references.
78 D IXALL^DIK ; Set all cross references.
79 Q
80VERCHKON ; Turn on Version Checking at the Sites.
81 ; We aren't forcing it to stay on, sites can turn it back off.
82 N MAGIEN,MAGSITE,VERCHK,MSG
83 S MAGIEN=0
84 F S MAGIEN=$O(^MAG(2006.1,MAGIEN)) Q:'MAGIEN D
85 . S MSG="is already ON, no action taken"
86 . S MAGSITE=$P($G(^MAG(2006.1,MAGIEN,0)),"^",1)
87 . S VERCHK=$P($G(^MAG(2006.1,MAGIEN,"KEYS")),"^",5)
88 . I 'VERCHK S $P(^MAG(2006.1,MAGIEN,"KEYS"),"^",5)=1 S MSG="has been turned ON"
89 . D MES^XPDUTL("Patch 59 is turning Version Checking ON...")
90 . D MES^XPDUTL("Version Checking "_MSG_" for Site: "_MAGSITE)
91 Q
92FIXTASK ; This will task off the FIX^MAGGTUX process that will fix the
93 ; Invalid INDEX VALUES in the Image File.
94 N ANS
95 S ZTDTH=$$NOW^XLFDT
96 S ZTRTN="TASK^MAGGTUX",ZTDESC="VALIDATE IMAGE INDEX VALUES",ZTIO=""
97 S ZTSAVE("COMMIT")=1,ZTSAVE("MAGN")="MAGGTUX",ZTSAVE("QUEUED")=1
98 D ^%ZTLOAD
99 D MES^XPDUTL("The Utility to Fix invalid Index Values in the entire")
100 D MES^XPDUTL("Image File (#2005) has been Queued as TASK# : "_ZTSK)
101 Q
102INS(XP,DUZ,DATE,IDA) ;
103 N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
104 D GETENV^%ZOSV
105 S CNT=0
106 S CNT=CNT+1,MAGMSG(CNT)="PACKAGE INSTALL"
107 S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
108 S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XP
109 S CNT=CNT+1,MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XP)
110 S ST=$$GET1^DIQ(9.7,IDA,11,"I")
111 S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
112 S CT=$$GET1^DIQ(9.7,IDA,17,"I") S:+CT'=CT CT=$$NOW^XLFDT
113 S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
114 S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
115 S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
116 S COM=$$GET1^DIQ(9.7,IDA,6,"I")
117 S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_COM
118 S CNT=CNT+1,MAGMSG(CNT)="DATE: "_DATE
119 S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,IDA,9,"E")
120 S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,IDA,.01,"E")
121 S DDATE=$$GET1^DIQ(9.7,IDA,51,"I")
122 S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
123 S XMSUB=XP_" INSTALLATION"
124 S XMID=$G(DUZ) S:'XMID XMID=.5
125 S XMY(XMID)=""
126 S XMY("G.MAG SERVER")=""
127 S:$G(MAGDUZ) XMY(MAGDUZ)=""
128 S XMSUB=$E(XMSUB,1,63)
129 D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
130 I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
131 Q
Note: See TracBrowser for help on using the repository browser.