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

MAGVIM12.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VA Directive 6402, 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.  ; This function returns Service (Radiology, Consult, or Lab) based on Modality and Procedure
  1.  ; If service found, it will be returned as:
  1.  ;   RAD --------- Radiology
  1.  ;   CON --------- Consult/Procedure Request Tracking (CPRS)
  1.  ;   LAB --------- Anatomic Pathology
  1.  ; If no Service found, this function will add an entry 
  1.  ;   with Modalty and Procedure into File #2006.9423
  1.  ;   and return "" if successful otherwise return "-1^"_Error
  1.  ;
  1. GETSRV(MDL,PROC) ;Get SERVICE
  1.  N FILE,SRV,IEN
  1.  S FILE=2006.9423,IEN=""
  1.  S SRV=$$GETS(MDL,PROC)
  1.  I $P(SRV,U,1)="-1" Q IEN  ;return error
  1.  I SRV'="" Q SRV
  1.  ;Does not exist, create it
  1.  S IEN=$$UPDSRV("",MDL,PROC)
  1.  I $P(IEN,U,1)="-1" Q IEN  ;return error
  1.  I IEN Q $$GET1^DIQ(FILE,IEN,1)
  1.  Q "-1^Unable to update file #2006.9423"
  1.  ;
  1. GETS(MDL,PROC) ;Get Service
  1.  N FILE S FILE=2006.9423
  1.  I $G(MDL)="" Q ""     ;no value to lookup, must have PROC or MDL defined
  1.  S MDL=$$UPCASE(MDL),PROC=$G(PROC),PROC=$$UPCASE(PROC)
  1.  S IEN=$O(^MAGV(FILE,"B",MDL_"|"_PROC,""))
  1.  I IEN Q $$GET1^DIQ(FILE,IEN,1)
  1.  S IEN=$O(^MAGV(FILE,"B",MDL,""))
  1.  I IEN Q $$GET1^DIQ(FILE,IEN,1)
  1.  Q ""
  1.  ;
  1. UPDSRV(SRV,MDL,PROC) ;Update service or Add the new entry and return IEN or error
  1.  N FILE,MAGFDA,MAGIEN,MAGXE
  1.  S FILE=2006.9423
  1.  S MAGFDA(FILE,"?+1,",.01)=MDL_$S(PROC'="":"|"_PROC,1:"")
  1.  S MAGFDA(FILE,"?+1,",1)=SRV
  1.  D UPDATE^DIE("S","MAGFDA","MAGIEN","MAGXE")
  1.  I $D(MAGXE("DIERR","E")) Q "-1^"_$G(MAGXE("DIERR",1,"TEXT",1))
  1.  Q MAGIEN(1)
  1.  ;
  1. GTCSRV(IEN) ; Get computed Service in Work Item FIle 2006.941
  1.  N FILE,MTGIDX,PTGIDX
  1.  N SRV,MOD,PROC
  1.  S FILE=2006.941
  1.  S MTGIDX=$O(^MAGV(FILE,"H","Modality",IEN,""))
  1.  I 'MTGIDX Q ""
  1.  S MOD=$P(^MAGV(FILE,IEN,4,MTGIDX,0),U,2)
  1.  S PROC=""
  1.  S PTGIDX=$O(^MAGV(FILE,"H","Procedure",IEN,""))
  1.  I PTGIDX S PROC=$P(^MAGV(FILE,IEN,4,PTGIDX,0),U,2)
  1.  S SRV=$$GETS(MOD,PROC)
  1.  Q SRV
  1.  ; 
  1. UPCASE(X) ;
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")