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

MAGIP201.m

Go to the documentation of this file.
  1. MAGIP201 ;WOIFO/NST - Install code for MAG*3.0*201 ; Jan 22, 2019@09:15 AM
  1. ;;3.0;IMAGING;**201**;Mar 19, 2002;Build 2461;Jan 18, 2012
  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. ; There are no environment checks here but the MAGIP201 has to be
  1. ; referenced by the "Environment Check Routine" field of the KIDS
  1. ; build so that entry points of the routine are available to the
  1. ; KIDS during all installation phases.
  1. Q
  1. ;
  1. ;+++++ INSTALLATION ERROR HANDLING
  1. ERROR ;
  1. S:$D(XPDNM) XPDABORT=1
  1. ;--- Display the messages and store them to the INSTALL file
  1. D DUMP^MAGUERR1(),ABTMSG^MAGKIDS()
  1. Q
  1. ;
  1. ;***** POST-INSTALL CODE
  1. POS ;
  1. N CALLBACK
  1. D CLEAR^MAGUERR(1)
  1. ;
  1. D UPDATE()
  1. ;
  1. ;--- Send the notification e-mail
  1. D BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
  1. Q
  1. ;
  1. ;***** PRE-INSTALL CODE
  1. PRE ;
  1. Q
  1. ;
  1. ;+++++ Various updates
  1. UPDATE() ;
  1. N ANSERV,I,ITEM,MAGFDA,MAGERR,MAGIENS,MSG,IEN1,IEN2,IENS
  1. ;
  1. ; Add "PRECACHE" to WORKLIST file (#2006.9412)
  1. K MAGFDA,MAGERR
  1. S ITEM="PRECACHE"
  1. I '$O(^MAGV(2006.9412,"B",ITEM,0)) D
  1. . S MAGFDA(2006.9412,"+1,",.01)=ITEM
  1. . S MAGFDA(2006.9412,"+1,",1)=1 ;ACTIVE
  1. . D UPDATE^DIE("","MAGFDA","","MAGERR")
  1. . Q
  1. I $D(MAGERR) S MSG(1)=MAGERR("DIERR",1,"TEXT",1) D BMES^MAGKIDS("Error in Updating: ",.MSG) ;ERROR
  1. ;
  1. ; Add "ACQUISITION", "REGISTRATION" and "REMOTEPRIOR" to MAG WORK ITEM SUBTYPE file (#2006.9414)
  1. ;
  1. K MAGFDA,MAGERR
  1. F ITEM="ACQUISITION","REGISTRATION","REMOTEPRIOR" D
  1. . I '$O(^MAGV(2006.9414,"B",ITEM,0)) D
  1. . . S MAGFDA(2006.9414,"+1,",.01)=ITEM
  1. . . D UPDATE^DIE("","MAGFDA","","MAGERR")
  1. . . Q
  1. . I $D(MAGERR) S MSG(1)=MAGERR("DIERR",1,"TEXT",1) D BMES^MAGKIDS("Error in Updating: ",.MSG) ;ERROR
  1. . Q
  1. ;
  1. ; Add MAG PRECACHE as a subscriber of RA REG
  1. ;
  1. K MAGFDA
  1. S IEN1=$$FIND1^DIC(101,"","BX","RA REG") ; Get [RA REG] IEN
  1. I 'IEN1 D Q
  1. . S MSG(1)="RA REG protocol not found"
  1. . D BMES^MAGKIDS("Error in Updating: ",.MSG)
  1. . Q
  1. ;
  1. S IEN2=$$FIND1^DIC(101,"","BX","MAG PRECACHE") ; Get [MAG PRECACHE] IEN
  1. I 'IEN2 D Q
  1. . S MSG(1)="MAG PRECACHE protocol not found"
  1. . D BMES^MAGKIDS("Error in Updating: ",.MSG)
  1. . Q
  1. ;
  1. S IENS="?+1,"_IEN1_","
  1. S MAGFDA(101.0775,IENS,.01)=IEN2
  1. D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
  1. I $D(DIERR) D Q
  1. . D MES^MAGKIDS("Error in updating event driver protocol [RA REG].")
  1. . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I)) D
  1. . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
  1. . . Q
  1. . Q
  1. ;
  1. ; **** Convert external Annotation service value to internal value
  1. S IEN1=0
  1. F S IEN1=$O(^MAG(2005.003,IEN1)) Q:'IEN1 D
  1. . S IEN2=0
  1. . F S IEN2=$O(^MAG(2005.003,IEN1,1,IEN2)) Q:'IEN2 D
  1. . . S ANSERV=$P($G(^MAG(2005.003,IEN1,1,IEN2,0)),"^",7)
  1. . . Q:(ANSERV>0)!(ANSERV="")
  1. . . N X,DIC S DIC=49,DIC(0)="B",X=ANSERV D ^DIC S ANSERV=$S(+Y:+Y,1:"") ;SERVICE/SECTION
  1. . . K MAGFDA,MAGIENS,MAGERR
  1. . . S IENS=IEN2_","_IEN1_","
  1. . . S MAGIENS(1)=IEN1
  1. . . S MAGIENS(2)=IEN2
  1. . . S MAGFDA(2005.0031,IENS,7)=ANSERV ;SERVICE/SECTION
  1. . . D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
  1. . . I $D(MAGERR) D
  1. . . . D MES^MAGKIDS("Error in updating event driver protocol [RA REG].")
  1. . . . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I)) D
  1. . . . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . Q
  1. Q