MAGIP201 ;WOIFO/NST - Install code for MAG*3.0*201 ; Jan 22, 2019@09:15 AM
;;3.0;IMAGING;**201**;Mar 19, 2002;Build 2461;Jan 18, 2012
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
; There are no environment checks here but the MAGIP201 has to be
; referenced by the "Environment Check Routine" field of the KIDS
; build so that entry points of the routine are available to the
; KIDS during all installation phases.
Q
;
;+++++ INSTALLATION ERROR HANDLING
ERROR ;
S:$D(XPDNM) XPDABORT=1
;--- Display the messages and store them to the INSTALL file
D DUMP^MAGUERR1(),ABTMSG^MAGKIDS()
Q
;
;***** POST-INSTALL CODE
POS ;
N CALLBACK
D CLEAR^MAGUERR(1)
;
D UPDATE()
;
;--- Send the notification e-mail
D BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
Q
;
;***** PRE-INSTALL CODE
PRE ;
Q
;
;+++++ Various updates
UPDATE() ;
N ANSERV,I,ITEM,MAGFDA,MAGERR,MAGIENS,MSG,IEN1,IEN2,IENS
;
; Add "PRECACHE" to WORKLIST file (#2006.9412)
K MAGFDA,MAGERR
S ITEM="PRECACHE"
I '$O(^MAGV(2006.9412,"B",ITEM,0)) D
. S MAGFDA(2006.9412,"+1,",.01)=ITEM
. S MAGFDA(2006.9412,"+1,",1)=1 ;ACTIVE
. D UPDATE^DIE("","MAGFDA","","MAGERR")
. Q
I $D(MAGERR) S MSG(1)=MAGERR("DIERR",1,"TEXT",1) D BMES^MAGKIDS("Error in Updating: ",.MSG) ;ERROR
;
; Add "ACQUISITION", "REGISTRATION" and "REMOTEPRIOR" to MAG WORK ITEM SUBTYPE file (#2006.9414)
;
K MAGFDA,MAGERR
F ITEM="ACQUISITION","REGISTRATION","REMOTEPRIOR" D
. I '$O(^MAGV(2006.9414,"B",ITEM,0)) D
. . S MAGFDA(2006.9414,"+1,",.01)=ITEM
. . D UPDATE^DIE("","MAGFDA","","MAGERR")
. . Q
. I $D(MAGERR) S MSG(1)=MAGERR("DIERR",1,"TEXT",1) D BMES^MAGKIDS("Error in Updating: ",.MSG) ;ERROR
. Q
;
; Add MAG PRECACHE as a subscriber of RA REG
;
K MAGFDA
S IEN1=$$FIND1^DIC(101,"","BX","RA REG") ; Get [RA REG] IEN
I 'IEN1 D Q
. S MSG(1)="RA REG protocol not found"
. D BMES^MAGKIDS("Error in Updating: ",.MSG)
. Q
;
S IEN2=$$FIND1^DIC(101,"","BX","MAG PRECACHE") ; Get [MAG PRECACHE] IEN
I 'IEN2 D Q
. S MSG(1)="MAG PRECACHE protocol not found"
. D BMES^MAGKIDS("Error in Updating: ",.MSG)
. Q
;
S IENS="?+1,"_IEN1_","
S MAGFDA(101.0775,IENS,.01)=IEN2
D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
I $D(DIERR) D Q
. D MES^MAGKIDS("Error in updating event driver protocol [RA REG].")
. F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I)) D
. . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
. . Q
. Q
;
; **** Convert external Annotation service value to internal value
S IEN1=0
F S IEN1=$O(^MAG(2005.003,IEN1)) Q:'IEN1 D
. S IEN2=0
. F S IEN2=$O(^MAG(2005.003,IEN1,1,IEN2)) Q:'IEN2 D
. . S ANSERV=$P($G(^MAG(2005.003,IEN1,1,IEN2,0)),"^",7)
. . Q:(ANSERV>0)!(ANSERV="")
. . N X,DIC S DIC=49,DIC(0)="B",X=ANSERV D ^DIC S ANSERV=$S(+Y:+Y,1:"") ;SERVICE/SECTION
. . K MAGFDA,MAGIENS,MAGERR
. . S IENS=IEN2_","_IEN1_","
. . S MAGIENS(1)=IEN1
. . S MAGIENS(2)=IEN2
. . S MAGFDA(2005.0031,IENS,7)=ANSERV ;SERVICE/SECTION
. . D UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
. . I $D(MAGERR) D
. . . D MES^MAGKIDS("Error in updating event driver protocol [RA REG].")
. . . F I=1:1 Q:'$D(MAGERR("DIERR",1,"TEXT",I)) D
. . . . D MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
. . . . Q
. . . Q
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP201 4321 printed Apr 09, 2024@21:01:56 Page 2
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
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ; There are no environment checks here but the MAGIP201 has to be
+18 ; referenced by the "Environment Check Routine" field of the KIDS
+19 ; build so that entry points of the routine are available to the
+20 ; KIDS during all installation phases.
+21 QUIT
+22 ;
+23 ;+++++ INSTALLATION ERROR HANDLING
ERROR ;
+1 if $DATA(XPDNM)
SET XPDABORT=1
+2 ;--- Display the messages and store them to the INSTALL file
+3 DO DUMP^MAGUERR1()
DO ABTMSG^MAGKIDS()
+4 QUIT
+5 ;
+6 ;***** POST-INSTALL CODE
POS ;
+1 NEW CALLBACK
+2 DO CLEAR^MAGUERR(1)
+3 ;
+4 DO UPDATE()
+5 ;
+6 ;--- Send the notification e-mail
+7 DO BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
+8 DO INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+9 QUIT
+10 ;
+11 ;***** PRE-INSTALL CODE
PRE ;
+1 QUIT
+2 ;
+3 ;+++++ Various updates
UPDATE() ;
+1 NEW ANSERV,I,ITEM,MAGFDA,MAGERR,MAGIENS,MSG,IEN1,IEN2,IENS
+2 ;
+3 ; Add "PRECACHE" to WORKLIST file (#2006.9412)
+4 KILL MAGFDA,MAGERR
+5 SET ITEM="PRECACHE"
+6 IF '$ORDER(^MAGV(2006.9412,"B",ITEM,0))
Begin DoDot:1
+7 SET MAGFDA(2006.9412,"+1,",.01)=ITEM
+8 ;ACTIVE
SET MAGFDA(2006.9412,"+1,",1)=1
+9 DO UPDATE^DIE("","MAGFDA","","MAGERR")
+10 QUIT
End DoDot:1
+11 ;ERROR
IF $DATA(MAGERR)
SET MSG(1)=MAGERR("DIERR",1,"TEXT",1)
DO BMES^MAGKIDS("Error in Updating: ",.MSG)
+12 ;
+13 ; Add "ACQUISITION", "REGISTRATION" and "REMOTEPRIOR" to MAG WORK ITEM SUBTYPE file (#2006.9414)
+14 ;
+15 KILL MAGFDA,MAGERR
+16 FOR ITEM="ACQUISITION","REGISTRATION","REMOTEPRIOR"
Begin DoDot:1
+17 IF '$ORDER(^MAGV(2006.9414,"B",ITEM,0))
Begin DoDot:2
+18 SET MAGFDA(2006.9414,"+1,",.01)=ITEM
+19 DO UPDATE^DIE("","MAGFDA","","MAGERR")
+20 QUIT
End DoDot:2
+21 ;ERROR
IF $DATA(MAGERR)
SET MSG(1)=MAGERR("DIERR",1,"TEXT",1)
DO BMES^MAGKIDS("Error in Updating: ",.MSG)
+22 QUIT
End DoDot:1
+23 ;
+24 ; Add MAG PRECACHE as a subscriber of RA REG
+25 ;
+26 KILL MAGFDA
+27 ; Get [RA REG] IEN
SET IEN1=$$FIND1^DIC(101,"","BX","RA REG")
+28 IF 'IEN1
Begin DoDot:1
+29 SET MSG(1)="RA REG protocol not found"
+30 DO BMES^MAGKIDS("Error in Updating: ",.MSG)
+31 QUIT
End DoDot:1
QUIT
+32 ;
+33 ; Get [MAG PRECACHE] IEN
SET IEN2=$$FIND1^DIC(101,"","BX","MAG PRECACHE")
+34 IF 'IEN2
Begin DoDot:1
+35 SET MSG(1)="MAG PRECACHE protocol not found"
+36 DO BMES^MAGKIDS("Error in Updating: ",.MSG)
+37 QUIT
End DoDot:1
QUIT
+38 ;
+39 SET IENS="?+1,"_IEN1_","
+40 SET MAGFDA(101.0775,IENS,.01)=IEN2
+41 DO UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
+42 IF $DATA(DIERR)
Begin DoDot:1
+43 DO MES^MAGKIDS("Error in updating event driver protocol [RA REG].")
+44 FOR I=1:1
if '$DATA(MAGERR("DIERR",1,"TEXT",I))
QUIT
Begin DoDot:2
+45 DO MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
QUIT
+48 ;
+49 ; **** Convert external Annotation service value to internal value
+50 SET IEN1=0
+51 FOR
SET IEN1=$ORDER(^MAG(2005.003,IEN1))
if 'IEN1
QUIT
Begin DoDot:1
+52 SET IEN2=0
+53 FOR
SET IEN2=$ORDER(^MAG(2005.003,IEN1,1,IEN2))
if 'IEN2
QUIT
Begin DoDot:2
+54 SET ANSERV=$PIECE($GET(^MAG(2005.003,IEN1,1,IEN2,0)),"^",7)
+55 if (ANSERV>0)!(ANSERV="")
QUIT
+56 ;SERVICE/SECTION
NEW X,DIC
SET DIC=49
SET DIC(0)="B"
SET X=ANSERV
DO ^DIC
SET ANSERV=$SELECT(+Y:+Y,1:"")
+57 KILL MAGFDA,MAGIENS,MAGERR
+58 SET IENS=IEN2_","_IEN1_","
+59 SET MAGIENS(1)=IEN1
+60 SET MAGIENS(2)=IEN2
+61 ;SERVICE/SECTION
SET MAGFDA(2005.0031,IENS,7)=ANSERV
+62 DO UPDATE^DIE("","MAGFDA","MAGIENS","MAGERR")
+63 IF $DATA(MAGERR)
Begin DoDot:3
+64 DO MES^MAGKIDS("Error in updating event driver protocol [RA REG].")
+65 FOR I=1:1
if '$DATA(MAGERR("DIERR",1,"TEXT",I))
QUIT
Begin DoDot:4
+66 DO MES^MAGKIDS(MAGERR("DIERR",1,"TEXT",I))
+67 QUIT
End DoDot:4
+68 QUIT
End DoDot:3
+69 QUIT
End DoDot:2
+70 QUIT
End DoDot:1
+71 QUIT
