MAGVIM12 ;WOIFO/NST/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. |
;; +---------------------------------------------------------------+
;;
; This function returns Service (Radiology, Consult, or Lab) based on Modality and Procedure
; If service found, it will be returned as:
; RAD --------- Radiology
; CON --------- Consult/Procedure Request Tracking (CPRS)
; LAB --------- Anatomic Pathology
; If no Service found, this function will add an entry
; with Modalty and Procedure into File #2006.9423
; and return "" if successful otherwise return "-1^"_Error
;
GETSRV(MDL,PROC) ;Get SERVICE
N FILE,SRV,IEN
S FILE=2006.9423,IEN=""
S SRV=$$GETS(MDL,PROC)
I $P(SRV,U,1)="-1" Q IEN ;return error
I SRV'="" Q SRV
;Does not exist, create it
S IEN=$$UPDSRV("",MDL,PROC)
I $P(IEN,U,1)="-1" Q IEN ;return error
I IEN Q $$GET1^DIQ(FILE,IEN,1)
Q "-1^Unable to update file #2006.9423"
;
GETS(MDL,PROC) ;Get Service
N FILE S FILE=2006.9423
I $G(MDL)="" Q "" ;no value to lookup, must have PROC or MDL defined
S MDL=$$UPCASE(MDL),PROC=$G(PROC),PROC=$$UPCASE(PROC)
S IEN=$O(^MAGV(FILE,"B",MDL_"|"_PROC,""))
I IEN Q $$GET1^DIQ(FILE,IEN,1)
S IEN=$O(^MAGV(FILE,"B",MDL,""))
I IEN Q $$GET1^DIQ(FILE,IEN,1)
Q ""
;
UPDSRV(SRV,MDL,PROC) ;Update service or Add the new entry and return IEN or error
N FILE,MAGFDA,MAGIEN,MAGXE
S FILE=2006.9423
S MAGFDA(FILE,"?+1,",.01)=MDL_$S(PROC'="":"|"_PROC,1:"")
S MAGFDA(FILE,"?+1,",1)=SRV
D UPDATE^DIE("S","MAGFDA","MAGIEN","MAGXE")
I $D(MAGXE("DIERR","E")) Q "-1^"_$G(MAGXE("DIERR",1,"TEXT",1))
Q MAGIEN(1)
;
GTCSRV(IEN) ; Get computed Service in Work Item FIle 2006.941
N FILE,MTGIDX,PTGIDX
N SRV,MOD,PROC
S FILE=2006.941
S MTGIDX=$O(^MAGV(FILE,"H","Modality",IEN,""))
I 'MTGIDX Q ""
S MOD=$P(^MAGV(FILE,IEN,4,MTGIDX,0),U,2)
S PROC=""
S PTGIDX=$O(^MAGV(FILE,"H","Procedure",IEN,""))
I PTGIDX S PROC=$P(^MAGV(FILE,IEN,4,PTGIDX,0),U,2)
S SRV=$$GETS(MOD,PROC)
Q SRV
;
UPCASE(X) ;
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM12 3089 printed Sep 23, 2025@19:46:16 Page 2
MAGVIM12 ;WOIFO/NST/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 ; This function returns Service (Radiology, Consult, or Lab) based on Modality and Procedure
+18 ; If service found, it will be returned as:
+19 ; RAD --------- Radiology
+20 ; CON --------- Consult/Procedure Request Tracking (CPRS)
+21 ; LAB --------- Anatomic Pathology
+22 ; If no Service found, this function will add an entry
+23 ; with Modalty and Procedure into File #2006.9423
+24 ; and return "" if successful otherwise return "-1^"_Error
+25 ;
GETSRV(MDL,PROC) ;Get SERVICE
+1 NEW FILE,SRV,IEN
+2 SET FILE=2006.9423
SET IEN=""
+3 SET SRV=$$GETS(MDL,PROC)
+4 ;return error
IF $PIECE(SRV,U,1)="-1"
QUIT IEN
+5 IF SRV'=""
QUIT SRV
+6 ;Does not exist, create it
+7 SET IEN=$$UPDSRV("",MDL,PROC)
+8 ;return error
IF $PIECE(IEN,U,1)="-1"
QUIT IEN
+9 IF IEN
QUIT $$GET1^DIQ(FILE,IEN,1)
+10 QUIT "-1^Unable to update file #2006.9423"
+11 ;
GETS(MDL,PROC) ;Get Service
+1 NEW FILE
SET FILE=2006.9423
+2 ;no value to lookup, must have PROC or MDL defined
IF $GET(MDL)=""
QUIT ""
+3 SET MDL=$$UPCASE(MDL)
SET PROC=$GET(PROC)
SET PROC=$$UPCASE(PROC)
+4 SET IEN=$ORDER(^MAGV(FILE,"B",MDL_"|"_PROC,""))
+5 IF IEN
QUIT $$GET1^DIQ(FILE,IEN,1)
+6 SET IEN=$ORDER(^MAGV(FILE,"B",MDL,""))
+7 IF IEN
QUIT $$GET1^DIQ(FILE,IEN,1)
+8 QUIT ""
+9 ;
UPDSRV(SRV,MDL,PROC) ;Update service or Add the new entry and return IEN or error
+1 NEW FILE,MAGFDA,MAGIEN,MAGXE
+2 SET FILE=2006.9423
+3 SET MAGFDA(FILE,"?+1,",.01)=MDL_$SELECT(PROC'="":"|"_PROC,1:"")
+4 SET MAGFDA(FILE,"?+1,",1)=SRV
+5 DO UPDATE^DIE("S","MAGFDA","MAGIEN","MAGXE")
+6 IF $DATA(MAGXE("DIERR","E"))
QUIT "-1^"_$GET(MAGXE("DIERR",1,"TEXT",1))
+7 QUIT MAGIEN(1)
+8 ;
GTCSRV(IEN) ; Get computed Service in Work Item FIle 2006.941
+1 NEW FILE,MTGIDX,PTGIDX
+2 NEW SRV,MOD,PROC
+3 SET FILE=2006.941
+4 SET MTGIDX=$ORDER(^MAGV(FILE,"H","Modality",IEN,""))
+5 IF 'MTGIDX
QUIT ""
+6 SET MOD=$PIECE(^MAGV(FILE,IEN,4,MTGIDX,0),U,2)
+7 SET PROC=""
+8 SET PTGIDX=$ORDER(^MAGV(FILE,"H","Procedure",IEN,""))
+9 IF PTGIDX
SET PROC=$PIECE(^MAGV(FILE,IEN,4,PTGIDX,0),U,2)
+10 SET SRV=$$GETS(MOD,PROC)
+11 QUIT SRV
+12 ;
UPCASE(X) ;
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
