Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGIPS54

MAGIPS54.m

Go to the documentation of this file. 
  1. MAGIPS54 ;Post init routine to queue site activity at install. ; 09/11/2008 02:17 pm
  1.  ;;3.0;IMAGING;**54**;03-July-2009;;Build 1424
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1. PRE ;
  1.  N DIU
  1.  ; Remove obsolete DD definitions
  1.  F DIU=2006.589 D
  1.  . S DIU(0)="" D EN^DIU2
  1.  . Q
  1.  K ^MAGDICOM(2006.589)
  1.  Q
  1.  ;
  1. POST N CVT,OPT
  1.  ;  1. Add RPCs to Secondary menu(s)
  1.  ;  2. Convert tables
  1.  ;  3. Run INIT^MAGDRUID (create UID root)
  1.  ;  4. Remove any dangling cross references from #2006.575
  1.  ;
  1.  F OPT="MAG DICOM GATEWAY FULL","MAG DICOM GATEWAY VIEW" D
  1.  . ; Don't ADDRPC("MAG DICOM CHECK MACHINE ID",OPT) ; removed at site
  1.  . D ADDRPC("MAG DICOM GET MACHINE ID",OPT)
  1.  . D ADDRPC("MAG DICOM GET UID ROOT",OPT)
  1.  . ; Don't ADDRPC("MAG DICOM UPDATE MACHINE ID",OPT) ; removed at site
  1.  . D ADDRPC("MAG GET SOP CLASS METHOD",OPT)
  1.  . Q
  1.  ;
  1.  D  ; Convert Tables:
  1.  . ; 2006.5641 (Gateway Registry)
  1.  . ; 2006.5715 (Last Image UID)
  1.  . ;
  1.  . ; NOTE: The code below is such that if this routine
  1.  . ;       is run multiple times, the 2nd and later times
  1.  . ;       are no-ops.
  1.  . ;
  1.  . N D0,ID,HN,HOST,L,LO,LOC,N,NA,UID,UP,X
  1.  . S LO="abcdefghijklmnopqrstuvwxyz"
  1.  . S UP="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  1.  . S D0=0 F  S D0=$O(^MAGDICOM(2006.5641,D0)) Q:'D0  D
  1.  . . S X=$G(^MAGDICOM(2006.5641,D0,0)),ID=$P(X,"^",1),NA=$P(X,"^",2)
  1.  . . Q:ID  ; Entry is already converted
  1.  . . S HN=$TR(NA,LO,UP)
  1.  . . D:ID'=""
  1.  . . . K ^MAGDICOM(2006.5641,"B",ID,D0)
  1.  . . . S ^MAGDICOM(2006.5641,"B",D0,D0)=""
  1.  . . . S $P(^MAGDICOM(2006.5641,D0,0),"^",1,2)=D0_"^"_HN
  1.  . . . S HOST(ID)=HN
  1.  . . . Q
  1.  . . D:NA'=""
  1.  . . . K ^MAGDICOM(2006.5641,"C",NA,D0)
  1.  . . . S ^MAGDICOM(2006.5641,"C",HN,D0)=""
  1.  . . . Q
  1.  . . Q
  1.  . S (N,L,D0)=0 F  S D0=$O(^MAGD(2006.5715,D0)) Q:'D0  D
  1.  . . S X=$G(^MAGD(2006.5715,D0,0)),UID=$P(X,"^",2),X=$P(X,"^",1)
  1.  . . Q:X'?1U  ; Entry is empty or already converted
  1.  . . I X'="" K ^MAGD(2006.5715,"B",X,D0) S X=$G(HOST(X))
  1.  . . I X="" K ^MAGD(2006.5715,D0) Q
  1.  . . S N=N+1,L=D0,^MAGD(2006.5715,D0,0)=X_"^"_UID
  1.  . . S ^MAGD(2006.5715,"B",X,D0)=""
  1.  . . Q
  1.  . S ^MAGD(2006.5715,0)="CURRENT IMAGE^2006.5715^"_L_"^"_N
  1.  . Q
  1.  ;
  1.  D INIT^MAGDRUID
  1.  D UPDATE
  1.  ;
  1.  D  ; Add shortcuts to DICOM Correct
  1.  . N FDA,IEN,LBL,MSG,SUB
  1.  . S SUB(1)="MAGD FIX DICOM FILE",LBL(1)="RAD"
  1.  . S SUB(2)="MAGD FIX CLINSPEC DICOM FILE",LBL(2)="CLN"
  1.  . D FIND^DIC(19,"",".001","","MAGD DICOM MENU","","B","","","LST","MSG")
  1.  . S LST="" F  S LST=$O(LST("DILIST",2,LST)) Q:LST=""  D
  1.  . . F SUB=1,2 D
  1.  . . . K FDA,IEN,MSG
  1.  . . . S FDA(19.01,"?1,"_LST("DILIST",2,LST)_",",.01)=SUB(SUB)
  1.  . . . S FDA(19.01,"?1,"_LST("DILIST",2,LST)_",",2)=LBL(SUB)
  1.  . . . D UPDATE^DIE("E","FDA","IEN","MSG")
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  ;
  1.  D  ; Confirmation message
  1.  . N CT,CNT,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
  1.  . ;
  1.  . D GETENV^%ZOSV
  1.  . S CNT=0
  1.  . S CNT=CNT+1,MAGMSG(CNT)="PACKAGE INSTALL"
  1.  . S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
  1.  . S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XPDNM
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XPDNM)
  1.  . S ST=$$GET1^DIQ(9.7,XPDA,11,"I")
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
  1.  . S CT=$$GET1^DIQ(9.7,XPDA,17,"I") S:+CT'=CT CT=$$NOW^XLFDT()
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
  1.  . S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_$$GET1^DIQ(9.7,XPDA,6,"I")
  1.  . S CNT=CNT+1,MAGMSG(CNT)="DATE: "_$$NOW^XLFDT()
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,XPDA,9,"E")
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,XPDA,.01,"E")
  1.  . S DDATE=$$GET1^DIQ(9.7,XPDA,51,"I")
  1.  . S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
  1.  . S:$G(CVT)'="" CNT=CNT+1,MAGMSG(CNT)="Conversion time: "_CVT
  1.  . S XMSUB=XPDNM_" INSTALLATION"
  1.  . S XMID=$G(DUZ) S:'XMID XMID=.5
  1.  . S XMY(XMID)=""
  1.  . S XMY("G.MAG SERVER")=""
  1.  . S:$G(MAGDUZ) XMY(MAGDUZ)=""
  1.  . S XMSUB=$E(XMSUB,1,63)
  1.  . D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
  1.  . I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
  1.  . Q
  1.  K ^MAGD(2006.575) S ^MAGD(2006.575,0)="DICOM FAILED IMAGES^2006.575" ; remove any vestigal nodes
  1.  Q
  1.  ;
  1. ADDRPC(RPCNAME,OPTNAME) N DA,DIC
  1.  S DIC="^DIC(19,",DIC(0)="",X=OPTNAME D ^DIC
  1.  I Y<0 D  Q
  1.  . W !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
  1.  . W !,"Cannot find """_OPTNAME_"""."
  1.  . Q
  1.  S DA(1)=+Y
  1.  S DIC=DIC_DA(1)_",""RPC"","
  1.  S DIC(0)="L" ; LAYGO should be allowed here
  1.  S X=RPCNAME
  1.  D ^DIC
  1.  I Y<0 D  Q
  1.  . W !,"Cannot add """_RPCNAME_""" to """_OPTNAME_"""."
  1.  . W !,"Cannot find """_RPCNAME_"""."
  1.  . Q
  1.  Q
  1.  ;
  1. UP(X) ; special UPPER CASE function -- removes redundant blanks as well
  1.  F  Q:X'["  "  S $E(X,$F(X,"  ")-1)=""  ; remove redundant blank
  1.  I $E(X)=" " S $E(X)=""  ; remove leading blank
  1.  I $E(X,$L(X))=" " S $E(X,$L(X))=""  ; remove trailing blank
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz^|","ABCDEFGHIJKLMNOPQRSTUVWXYZ~~")
  1.  ;
  1. UPDATE ;Update description for menu option
  1.  N IEN
  1.  S IEN=$$FIND1^DIC(19,"","X","MAGD DICOM MENU","","","")
  1.  I 'IEN D BMES^XPDUTL("Menu option MAGD DICOM MENU is undefined in the Option file!") Q
  1.  S ^TMP($J,"WP",1)="Menu to allow correcting of DICOM Image file references that failed"
  1.  S ^TMP($J,"WP",2)="the matching process during the initial DICOM image acquistion."
  1.  D WP^DIE(19,IEN_",",3.5,"","^TMP($J,""WP"")","MAGMSG")
  1.  I $D(MAGMSG) D BMES^XPDUTL("Error setting the description field for MAGD DICOM MENU")
  1.  K ^TMP($J,"WP")
  1.  Q
  1.