- MAGVIM13 ;WOIFO/BT/JL - Utilities for RPC calls for DICOM file processing ; May 05, 2023@080:09:32
- ;;3.0;IMAGING;**357**;Mar 19, 2002;Build 29
- ;; 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. |
- ;; +---------------------------------------------------------------+
- ;;
- ;+++++ UPDATE IMAGE SERVICE MAPPING #2006.9423
- ; RPC: MAGV UPDATE WORK ITEM SERVICE
- ;
- ; .MAGRY Reference to a local variable where the results are returned.
- ;
- ; MDL MODALITY of image WORK ITEM (DICOM)
- ; PROC PROCEDURE of image WORK ITEM (DICOM)
- ; NEWSRV NEW SERVICE where File 2006.941 and 2006.9423
- ;
- ; This RPC Updates or Adds Service in both
- ; File 2006.941 (for IEN: WIEN) - Service is inside TAGS
- ; and File 2006.9423 (SERVICE (Field #1) )
- ;
- ; Return Values
- ; =============
- ; If MAGRY 1st '^'-piece is 0, then OKay. Otherwise, the output
- ; is as follows:
- ;
- ; MAGRY Description
- ; ^01: 0 or -1
- ; ^02: -1 Error message if any
- ;
- UPDSRV(OUT,PRVSRV,MDL,PROC,NEWSRV) ;
- N FILE,SRV,IEN,MPIEN,TAGIDX,ERR
- N MAGFDA,MAGXE,MAGIEN,SHORT
- ;---- update Service in Work Item Service File #2006.9423 --------------
- S FILE=2006.9423
- I $G(MDL)="" S OUT="-1"_U_"Modality must not be empty" Q
- I $G(NEWSRV)="" S OUT="-1"_U_"New Service must not be empty" Q
- S MDL=$$UPCASE(MDL)
- S PROC=$$UPCASE($G(PROC))
- S SHORT=""
- I NEWSRV="Radiology" S SHORT="RAD"
- I NEWSRV="Lab" S SHORT="LAB"
- I NEWSRV="Consult" S SHORT="CON"
- I SHORT="" S OUT="-1"_U_"Invalid Service" Q
- S SRV=""
- S MPIEN=$O(^MAGV(FILE,"B",MDL_"|"_PROC,""))
- I MPIEN S SRV=$$GET1^DIQ(FILE,MPIEN,1)
- I 'MPIEN D
- . S MPIEN=$O(^MAGV(FILE,"B",MDL,""))
- . I MPIEN S SRV=$$GET1^DIQ(FILE,MPIEN,1)
- I SRV'=SHORT D
- . S MPIEN=$$UPDSRV^MAGVIM12(SHORT,MDL,PROC)
- I $P(MPIEN,U,1)="-1" S OUT=MPIEN Q ;return error
- S OUT=0
- Q
- ;
- UPCASE(X) ;
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM13 2866 printed Apr 23, 2025@18:24:34 Page 2
- MAGVIM13 ;WOIFO/BT/JL - Utilities for RPC calls for DICOM file processing ; May 05, 2023@080:09:32
- +1 ;;3.0;IMAGING;**357**;Mar 19, 2002;Build 29
- +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 ;+++++ UPDATE IMAGE SERVICE MAPPING #2006.9423
- +18 ; RPC: MAGV UPDATE WORK ITEM SERVICE
- +19 ;
- +20 ; .MAGRY Reference to a local variable where the results are returned.
- +21 ;
- +22 ; MDL MODALITY of image WORK ITEM (DICOM)
- +23 ; PROC PROCEDURE of image WORK ITEM (DICOM)
- +24 ; NEWSRV NEW SERVICE where File 2006.941 and 2006.9423
- +25 ;
- +26 ; This RPC Updates or Adds Service in both
- +27 ; File 2006.941 (for IEN: WIEN) - Service is inside TAGS
- +28 ; and File 2006.9423 (SERVICE (Field #1) )
- +29 ;
- +30 ; Return Values
- +31 ; =============
- +32 ; If MAGRY 1st '^'-piece is 0, then OKay. Otherwise, the output
- +33 ; is as follows:
- +34 ;
- +35 ; MAGRY Description
- +36 ; ^01: 0 or -1
- +37 ; ^02: -1 Error message if any
- +38 ;
- UPDSRV(OUT,PRVSRV,MDL,PROC,NEWSRV) ;
- +1 NEW FILE,SRV,IEN,MPIEN,TAGIDX,ERR
- +2 NEW MAGFDA,MAGXE,MAGIEN,SHORT
- +3 ;---- update Service in Work Item Service File #2006.9423 --------------
- +4 SET FILE=2006.9423
- +5 IF $GET(MDL)=""
- SET OUT="-1"_U_"Modality must not be empty"
- QUIT
- +6 IF $GET(NEWSRV)=""
- SET OUT="-1"_U_"New Service must not be empty"
- QUIT
- +7 SET MDL=$$UPCASE(MDL)
- +8 SET PROC=$$UPCASE($GET(PROC))
- +9 SET SHORT=""
- +10 IF NEWSRV="Radiology"
- SET SHORT="RAD"
- +11 IF NEWSRV="Lab"
- SET SHORT="LAB"
- +12 IF NEWSRV="Consult"
- SET SHORT="CON"
- +13 IF SHORT=""
- SET OUT="-1"_U_"Invalid Service"
- QUIT
- +14 SET SRV=""
- +15 SET MPIEN=$ORDER(^MAGV(FILE,"B",MDL_"|"_PROC,""))
- +16 IF MPIEN
- SET SRV=$$GET1^DIQ(FILE,MPIEN,1)
- +17 IF 'MPIEN
- Begin DoDot:1
- +18 SET MPIEN=$ORDER(^MAGV(FILE,"B",MDL,""))
- +19 IF MPIEN
- SET SRV=$$GET1^DIQ(FILE,MPIEN,1)
- End DoDot:1
- +20 IF SRV'=SHORT
- Begin DoDot:1
- +21 SET MPIEN=$$UPDSRV^MAGVIM12(SHORT,MDL,PROC)
- End DoDot:1
- +22 ;return error
- IF $PIECE(MPIEN,U,1)="-1"
- SET OUT=MPIEN
- QUIT
- +23 SET OUT=0
- +24 QUIT
- +25 ;
- UPCASE(X) ;
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +2 ;