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

MAGIPS51.m

Go to the documentation of this file. 
  1. MAGIPS51 ;Post init routine to queue site activity at install. ; 06/09/2005  09:45
  1.  ;;3.0;IMAGING;**51**;26-August-2005
  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.  ;; |                                                               |
  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.574,2006.575,2006.5762,2006.587 D
  1.  . S DIU(0)="" D EN^DIU2
  1.  . Q
  1.  ; File-roots can be left.
  1.  Q
  1.  ;
  1. POST N CVT
  1.  ; 1. Convert simple pointers to variable pointers
  1.  ; 2. Add RPCs to secondary menus
  1.  ; 3. Clean up obsolete cross-references
  1.  ; 4. Clean up obsolete FileMan header
  1.  ; 5. Create missing PT pointers (QA issue)
  1.  ; 6. Pre-populate AutoRoute Prior Studies table
  1.  ; 7. Re-Cross-Reference file # 2006.587
  1.  ; 8. Send confirmation message
  1.  ;
  1.  D  ; Pointer Conversion
  1.  . N D0,DE,H1,H2,IM,N,OR,PR,ST,T,TY,X
  1.  . S H1=$H L +^MAGQUEUE(2006.035):1E9 ; Background process MUST wait.
  1.  . W !,"Starting correction of variable pointers in SEND QUEUE."
  1.  . K ^MAGQUEUE(2006.035,"DEST")
  1.  . K ^MAGQUEUE(2006.035,"STS")
  1.  . S N=0,D0=0 F  S D0=$O(^MAGQUEUE(2006.035,D0)) Q:'D0  D
  1.  . . S X=$G(^MAGQUEUE(2006.035,D0,1)),N=N+1
  1.  . . S ST=$P(X,"^",1),PR=$P(X,"^",2)
  1.  . . S X=$G(^MAGQUEUE(2006.035,D0,0))
  1.  . . S IM=$P(X,"^",1),DE=$P(X,"^",2),TY=$P(X,"^",3)
  1.  . . S ME=$P(X,"^",4),OR=$P(X,"^",5)
  1.  . . I DE,ME=1 S DE=(+DE)_";MAG(2005.2,"
  1.  . . I DE,ME=2 S DE=(+DE)_";MAG(2006.587,"
  1.  . . I 'DE!(DE'[";") S DE=""
  1.  . . S $P(X,"^",2)=DE,^MAGQUEUE(2006.035,D0,0)=X
  1.  . . Q:DE=""  Q:ST=""
  1.  . . I IM'="",TY'="" S ^MAGQUEUE(2006.035,"DEST",DE,ST,IM,TY,D0)=""
  1.  . . I OR'="",PR'="" S ^MAGQUEUE(2006.035,"STS",OR,ST,PR,DE,D0)=""
  1.  . . Q
  1.  . L -^MAGQUEUE(2006.035)
  1.  . S H2=$H,H1=H1*86400+$P(H1,",",2),H2=H2*86400+$P(H2,",",2)
  1.  . S X=H2-H1,CVT=N_" entr"_$S(N=1:"y",1:"ies")_" in "
  1.  . S T=X\3600 S:T CVT=CVT_T_" hour" S:T>1 CVT=CVT_"s"
  1.  . S T=X\60#60 I T S:CVT'="" CVT=CVT_", " S SVT=CVT_T_" minute" S:T>1 CVT=CVT_"s"
  1.  . S T=X#60 I T S:CVT'="" CVT=CVT_", " S SVT=CVT_T_" second" S:T>1 CVT=CVT_"s"
  1.  . S:'X CVT=CVT_"less than 1 second."
  1.  . Q
  1.  ;
  1.  D ADDRPC("MAG CFIND QUERY","MAG DICOM GATEWAY FULL")
  1.  D ADDRPC("MAG STUDY UID QUERY","MAG DICOM GATEWAY FULL")
  1.  D ADDRPC("MAG DICOM CHECK MACHINE ID","MAG DICOM GATEWAY FULL")
  1.  D ADDRPC("MAG DICOM UPDATE MACHINE ID","MAG DICOM GATEWAY FULL")
  1.  D ADDRPC("MAG VISTA CHECKSUMS","MAG DICOM GATEWAY FULL")
  1.  ;
  1.  D ADDRPC("MAG CFIND QUERY","MAG DICOM GATEWAY VIEW")
  1.  D ADDRPC("MAG STUDY UID QUERY","MAG DICOM GATEWAY VIEW")
  1.  D ADDRPC("MAG DICOM CHECK MACHINE ID","MAG DICOM GATEWAY VIEW")
  1.  D ADDRPC("MAG DICOM UPDATE MACHINE ID","MAG DICOM GATEWAY VIEW")
  1.  D ADDRPC("MAG VISTA CHECKSUMS","MAG DICOM GATEWAY VIEW")
  1.  ;
  1.  F X="C","DPAT","E" K ^MAGD(2006.575,X)
  1.  K ^MAGDICOM("HL7")
  1.  ;
  1.  S ^DD(2006.587,0,"PT",2005.0111,3)=""
  1.  S ^DD(2006.587,0,"PT",2005.1111,3)=""
  1.  ;
  1.  D  ; Pre-populate AutoRoute Prior Studies Table
  1.  . N A,D0,D1,X
  1.  . S D0=0 F  S D0=$O(^MAG(2006.65,D0)) Q:'D0  D
  1.  . . S D1=0 F  S D1=$O(^MAG(2006.65,D0,1,D1)) Q:'D1  D
  1.  . . . S X=$G(^MAG(2006.65,D0,1,D1,0)),A=0
  1.  . . . I $P(X,"^",2)="" S:$P(X,"^",5) $P(X,"^",2)=$P(X,"^",5),A=1
  1.  . . . I $P(X,"^",3)="" S $P(X,"^",3)=1800,A=1
  1.  . . . I $P(X,"^",4)="" S $P(X,"^",4)=1,A=1
  1.  . . . S:A ^MAG(2006.65,D0,1,D1,0)=X
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ; Re-Crossreference
  1.  ;
  1.  F X="B","C","D" K ^MAG(2006.587,X)
  1.  S DIK="^MAG(2006.587," D IXALL^DIK
  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.  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.  ;