MAGIP357 ;WOIFO/JSL - Install code for MAG*3.0*357 IMPORTER III ; 05 SEP 2024@12:17:21
;;3.0;IMAGING;**357**;Mar 19, 2002;Build 11
;; Per VA Directive 6402, 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 MAGIP357 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,CNT,I,J,IEN,TAG,VAL,DIK
D CLEAR^MAGUERR(1)
;
;--- Link new remote procedures to the Broker context option.
S X=$$ADDRPCS("RPCLST^MAGIP357","MAG DICOM VISA")
;
D CLEANUP19("MAG DICOM VISA") ; Delete dangling RPC pointers for an option
;
;ReIndex MAG WORK ITEM file#2006.941
L +^MAGV(2006.941):1999999
S DIK="^MAGV(2006.941,"
K ^MAGV(2006.941,"B")
K ^MAGV(2006.941,"C")
K ^MAGV(2006.941,"H")
K ^MAGV(2006.941,"HH")
K ^MAGV(2006.941,"I")
K ^MAGV(2006.941,"T")
D IXALL^DIK
L -^MAGV(2006.941)
;
;--- 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 ;
N OPTNAME,OPTIEN,OPTIEN2,RPCIEN,DIERR,IENS,MAGFDA,NAME,MAGMSG
;
S NAME="MAGV RAD STAT COMPLETE"
S OPTNAME="MAG DICOM VISA"
S OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
I OPTIEN D
. S OPTIEN2=$$FIND1^DIC(19.05,","_OPTIEN_",",,NAME,"",,"MAGMSG")
. I OPTIEN2 D ; Delete RPC from option file
. . K MAGFDA,MAGMSG,DIERR
. . S IENS=OPTIEN2_","_OPTIEN_","
. . S MAGFDA(19.05,IENS,.01)="@"
. . D UPDATE^DIE(,"MAGFDA",,"MAGMSG")
. . I $G(DIERR) W !,"Error removing RPC="_NAME_" from option "_OPTNAME
. . Q
. Q
;
S RPCIEN=$$FIND1^DIC(8994,,,NAME,"B",,"MAGMSG")
I $G(DIERR) Q
I RPCIEN'>0 Q
;--- Remove RPC, will be added later with the updated parameter name
K MAGFDA,MAGMSG,DIERR
S IENS=RPCIEN_","
S MAGFDA(8994,IENS,.01)="@"
D UPDATE^DIE(,"MAGFDA",,"MAGMSG")
I $G(DIERR) W !,"Error removing RPC="_NAME
Q
;
ADDRPCS(RPCNAMES,OPTNAME,FLAGS) ;
N IENS,MAGFDA,MAGMSG,MAGRC,NAME,OPTIEN,RPCIEN,SILENT
;
;=== Validate and prepare parameters
S FLAGS=$G(FLAGS),SILENT=(FLAGS["S")
;--- Single RPC name or a list?
I $D(RPCNAMES)<10 Q:$G(RPCNAMES)?." " $$IPVE^MAGUERR("RPCNAMES") D
. N I,GET
. ;--- Get the list from the source code
. S GET=$P(RPCNAMES,"^")_"+I^"_$P(RPCNAMES,"^",2)
. S GET="S NAME=$$TRIM^XLFSTR($P($T("_GET_"),"";;"",2))"
. F I=1:1 X GET Q:NAME="" S RPCNAMES(NAME)=""
. Q
;--- Name of the menu option (RPC Broker context)
S OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
Q:OPTIEN'>0 $$ERROR^MAGUERR(-44,,OPTNAME)
;
;=== Add the names to the multiple
D:'SILENT BMES^MAGKIDS("Attaching RPCs to the '"_OPTNAME_"' option...")
S NAME="",MAGRC=0
F S NAME=$O(RPCNAMES(NAME)) Q:NAME="" D Q:MAGRC<0
. D:'SILENT MES^MAGKIDS(NAME)
. ;--- Check if the remote procedure exists
. S RPCIEN=$$FIND1^DIC(8994,,"X",NAME,"B",,"MAGMSG")
. I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",8994) Q
. I RPCIEN'>0 S MAGRC=$$ERROR^MAGUERR(-45,,NAME) Q
. ;--- Add the remote procedure to the multiple
. S IENS="?+1,"_OPTIEN_","
. S MAGFDA(19.05,IENS,.01)=RPCIEN
. D UPDATE^DIE(,"MAGFDA",,"MAGMSG")
. I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",19.05,IENS) Q
. ;---
. Q
I MAGRC<0 D:'SILENT MES^MAGKIDS("ABORTED!") Q MAGRC
;
;=== Success
D:'SILENT MES^MAGKIDS("RPCs have been successfully attached.")
Q 0
;
;+++++ LIST OF NEW REMOTE PROCEDURES
RPCLST ;
;;MAGV GET WORK ITEM MODALITIES
;;MAGV GET WORK ITEM PROCEDURES
;;MAGV GET WORK ITEM SOURCES
;;MAGV UPDATE WORK ITEM SERVICE
;;MAGV RAD STAT COMPLETE
Q 0
;
CLEANUP19(OPTNAME) ; Delete dangling RPC pointers for an option
N IEN,OPTIEN,RPCIEN
S OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
Q:'OPTIEN
S RPCIEN=0
F S RPCIEN=$O(^DIC(19,OPTIEN,"RPC","B",RPCIEN)) Q:'RPCIEN D
. Q:$D(^XWB(8994,RPCIEN))
. ; RPC is not found
. S IEN=$O(^DIC(19,OPTIEN,"RPC","B",RPCIEN,0))
. K ^DIC(19,OPTIEN,"RPC","B",RPCIEN)
. K:IEN ^DIC(19,OPTIEN,"RPC",IEN)
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP357 5239 printed Dec 13, 2024@02:06:06 Page 2
MAGIP357 ;WOIFO/JSL - Install code for MAG*3.0*357 IMPORTER III ; 05 SEP 2024@12:17:21
+1 ;;3.0;IMAGING;**357**;Mar 19, 2002;Build 11
+2 ;; Per VA Directive 6402, 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 MAGIP357 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,CNT,I,J,IEN,TAG,VAL,DIK
+2 DO CLEAR^MAGUERR(1)
+3 ;
+4 ;--- Link new remote procedures to the Broker context option.
+5 SET X=$$ADDRPCS("RPCLST^MAGIP357","MAG DICOM VISA")
+6 ;
+7 ; Delete dangling RPC pointers for an option
DO CLEANUP19("MAG DICOM VISA")
+8 ;
+9 ;ReIndex MAG WORK ITEM file#2006.941
+10 LOCK +^MAGV(2006.941):1999999
+11 SET DIK="^MAGV(2006.941,"
+12 KILL ^MAGV(2006.941,"B")
+13 KILL ^MAGV(2006.941,"C")
+14 KILL ^MAGV(2006.941,"H")
+15 KILL ^MAGV(2006.941,"HH")
+16 KILL ^MAGV(2006.941,"I")
+17 KILL ^MAGV(2006.941,"T")
+18 DO IXALL^DIK
+19 LOCK -^MAGV(2006.941)
+20 ;
+21 ;--- Send the notification e-mail
+22 DO BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
+23 DO INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+24 QUIT
+25 ;
+26 ;***** PRE-INSTALL CODE
PRE ;
+1 NEW OPTNAME,OPTIEN,OPTIEN2,RPCIEN,DIERR,IENS,MAGFDA,NAME,MAGMSG
+2 ;
+3 SET NAME="MAGV RAD STAT COMPLETE"
+4 SET OPTNAME="MAG DICOM VISA"
+5 SET OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
+6 IF OPTIEN
Begin DoDot:1
+7 SET OPTIEN2=$$FIND1^DIC(19.05,","_OPTIEN_",",,NAME,"",,"MAGMSG")
+8 ; Delete RPC from option file
IF OPTIEN2
Begin DoDot:2
+9 KILL MAGFDA,MAGMSG,DIERR
+10 SET IENS=OPTIEN2_","_OPTIEN_","
+11 SET MAGFDA(19.05,IENS,.01)="@"
+12 DO UPDATE^DIE(,"MAGFDA",,"MAGMSG")
+13 IF $GET(DIERR)
WRITE !,"Error removing RPC="_NAME_" from option "_OPTNAME
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 ;
+17 SET RPCIEN=$$FIND1^DIC(8994,,,NAME,"B",,"MAGMSG")
+18 IF $GET(DIERR)
QUIT
+19 IF RPCIEN'>0
QUIT
+20 ;--- Remove RPC, will be added later with the updated parameter name
+21 KILL MAGFDA,MAGMSG,DIERR
+22 SET IENS=RPCIEN_","
+23 SET MAGFDA(8994,IENS,.01)="@"
+24 DO UPDATE^DIE(,"MAGFDA",,"MAGMSG")
+25 IF $GET(DIERR)
WRITE !,"Error removing RPC="_NAME
+26 QUIT
+27 ;
ADDRPCS(RPCNAMES,OPTNAME,FLAGS) ;
+1 NEW IENS,MAGFDA,MAGMSG,MAGRC,NAME,OPTIEN,RPCIEN,SILENT
+2 ;
+3 ;=== Validate and prepare parameters
+4 SET FLAGS=$GET(FLAGS)
SET SILENT=(FLAGS["S")
+5 ;--- Single RPC name or a list?
+6 IF $DATA(RPCNAMES)<10
if $GET(RPCNAMES)?." "
QUIT $$IPVE^MAGUERR("RPCNAMES")
Begin DoDot:1
+7 NEW I,GET
+8 ;--- Get the list from the source code
+9 SET GET=$PIECE(RPCNAMES,"^")_"+I^"_$PIECE(RPCNAMES,"^",2)
+10 SET GET="S NAME=$$TRIM^XLFSTR($P($T("_GET_"),"";;"",2))"
+11 FOR I=1:1
XECUTE GET
if NAME=""
QUIT
SET RPCNAMES(NAME)=""
+12 QUIT
End DoDot:1
+13 ;--- Name of the menu option (RPC Broker context)
+14 SET OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
+15 if OPTIEN'>0
QUIT $$ERROR^MAGUERR(-44,,OPTNAME)
+16 ;
+17 ;=== Add the names to the multiple
+18 if 'SILENT
DO BMES^MAGKIDS("Attaching RPCs to the '"_OPTNAME_"' option...")
+19 SET NAME=""
SET MAGRC=0
+20 FOR
SET NAME=$ORDER(RPCNAMES(NAME))
if NAME=""
QUIT
Begin DoDot:1
+21 if 'SILENT
DO MES^MAGKIDS(NAME)
+22 ;--- Check if the remote procedure exists
+23 SET RPCIEN=$$FIND1^DIC(8994,,"X",NAME,"B",,"MAGMSG")
+24 IF $GET(DIERR)
SET MAGRC=$$DBS^MAGUERR("MAGMSG",8994)
QUIT
+25 IF RPCIEN'>0
SET MAGRC=$$ERROR^MAGUERR(-45,,NAME)
QUIT
+26 ;--- Add the remote procedure to the multiple
+27 SET IENS="?+1,"_OPTIEN_","
+28 SET MAGFDA(19.05,IENS,.01)=RPCIEN
+29 DO UPDATE^DIE(,"MAGFDA",,"MAGMSG")
+30 IF $GET(DIERR)
SET MAGRC=$$DBS^MAGUERR("MAGMSG",19.05,IENS)
QUIT
+31 ;---
+32 QUIT
End DoDot:1
if MAGRC<0
QUIT
+33 IF MAGRC<0
if 'SILENT
DO MES^MAGKIDS("ABORTED!")
QUIT MAGRC
+34 ;
+35 ;=== Success
+36 if 'SILENT
DO MES^MAGKIDS("RPCs have been successfully attached.")
+37 QUIT 0
+38 ;
+39 ;+++++ LIST OF NEW REMOTE PROCEDURES
RPCLST ;
+1 ;;MAGV GET WORK ITEM MODALITIES
+2 ;;MAGV GET WORK ITEM PROCEDURES
+3 ;;MAGV GET WORK ITEM SOURCES
+4 ;;MAGV UPDATE WORK ITEM SERVICE
+5 ;;MAGV RAD STAT COMPLETE
+6 QUIT 0
+7 ;
CLEANUP19(OPTNAME) ; Delete dangling RPC pointers for an option
+1 NEW IEN,OPTIEN,RPCIEN
+2 SET OPTIEN=$$LKOPT^XPDMENU(OPTNAME)
+3 if 'OPTIEN
QUIT
+4 SET RPCIEN=0
+5 FOR
SET RPCIEN=$ORDER(^DIC(19,OPTIEN,"RPC","B",RPCIEN))
if 'RPCIEN
QUIT
Begin DoDot:1
+6 if $DATA(^XWB(8994,RPCIEN))
QUIT
+7 ; RPC is not found
+8 SET IEN=$ORDER(^DIC(19,OPTIEN,"RPC","B",RPCIEN,0))
+9 KILL ^DIC(19,OPTIEN,"RPC","B",RPCIEN)
+10 if IEN
KILL ^DIC(19,OPTIEN,"RPC",IEN)
+11 QUIT
End DoDot:1
+12 QUIT
