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

MAGVRS44.m

Go to the documentation of this file.
  1. MAGVRS44 ;WOIFO/DAC,MLH - Utilities for RPC calls for DICOM file processing ; 09 Sep 2019 1:59 PM
  1. ;;3.0;IMAGING;**118,239**;Mar 19, 2002;Build 18
  1. ;; Per VHA Directive 2004-038, 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. Q
  1. INACT(OUT,FILE,IEN,PIEN,OVERRIDE,REASON) ; Marks the entry indicated by file # and IEN as deleted
  1. N FDA,ERR,DELAPP,DIEN,UID,AOFUNSET,PPIEN,PFILE,RESULT,STATUS,SSEP,OSEP,ISEP,TOKEN,MAGRY
  1. S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
  1. S OUT(1)=0
  1. I $G(IEN)="" S OUT(1)="-1"_SSEP_"No IEN" Q
  1. I $G(FILE)="" S OUT(1)="-2"_SSEP_"No FILE number provided" Q
  1. I '$D(OVERRIDE) S OUT(1)="-7"_SSEP_"Override flag not passed" Q
  1. I $G(REASON)="" S REASON="Not provided"
  1. I IEN'=+IEN S OUT(1)="-6"_SSEP_"Invalid IEN format" Q
  1. I FILE'=2005.6,'OVERRIDE,'$$PARENT^MAGVRS41(FILE,IEN,PIEN) S OUT(1)="-2"_SSEP_"Parent Record not verified" Q
  1. ; can only invalidate PATIENT REF and PROCEDURE REF entries w/o children
  1. I ((FILE=2005.6)!(FILE=2005.61)),$D(^MAGV(FILE+.01,"C",IEN)) D Q
  1. . S OUT(1)="-6"_SSEP_"Cannot inactivate "
  1. . S:FILE=2005.6 OUT(1)=OUT(1)_"PATIENT REF"
  1. . S:FILE=2005.61 OUT(1)=OUT(1)_"PROCEDURE REF"
  1. . S OUT(1)=OUT(1)_" entry with children"
  1. . Q
  1. I '$D(^MAGV(FILE,IEN,0)) S OUT(1)="-3"_SSEP_"No record for file # and IEN provided." Q
  1. ; Delete main record and then delete all related child records
  1. S FIELD=$$GETFIELD^MAGVRS41(FILE,"STATUS")
  1. ; If record is already INACTIVE quit
  1. S STATUS=$$GET1^DIQ(FILE,IEN,FIELD,"I")
  1. I STATUS="I" Q
  1. S FDA(FILE,IEN_",",FIELD)="I" ; Set Status to Inactive
  1. I FILE=2005.65 D
  1. . S FDA(2005.65,IEN_",",9)=$$NOW^XLFDT
  1. . S FDA(2005.65,IEN_",",10)=DUZ
  1. . S FDA(2005.65,IEN_",",12)=REASON
  1. . S TOKEN=$P(^MAGV(2005.65,IEN,0),U,1)
  1. . S DELAPP="MAG SYS DELETE"
  1. . D DELAFACT^MAGVAD02(.MAGRY,TOKEN,DELAPP)
  1. . S MAGRY=$TR(MAGRY,$$RESDEL^MAGVAF02,ISEP)
  1. . I MAGRY'=0 S OUT(1)=MAGRY
  1. . Q
  1. I FILE'=2005.65 D
  1. . S FIELD=$$GETFIELD^MAGVRS41(FILE,"ARTIFACT ON FILE")
  1. . I FIELD'="" S FDA(FILE,IEN_",",FIELD)=0 ; Set Artifact on File to false
  1. . Q
  1. D FILE^DIE("","FDA","ERR")
  1. I FILE'=2005.65 D DELLOG^MAGVRS61(.RESULT,IEN,FILE) I +RESULT<0 S OUT(1)=RESULT
  1. I $D(ERR("DIERR")) S OUT(1)="-3"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
  1. K ERR,FDA
  1. ;
  1. ; Update Number of SOP and SERIES Number fields in the Study and Series files
  1. I (FILE=2005.63)!(FILE=2005.64) S PFILE=FILE-.01,FDA(PFILE,PIEN_",",7)=+$G(^MAGV(PFILE,PIEN,4))-1
  1. I FILE=2005.64 S PFILE=2005.62 S PPIEN=+$G(^MAGV(2005.63,PIEN,4)),FDA(2005.62,PPIEN_",",20)=$P($G(^MAGV(2005.62,PPIEN,4)),U,2)-1
  1. I (FILE=2005.63)!(FILE=2005.64) D FILE^DIE("","FDA","ERR") K FDA
  1. S DIEN=""
  1. F S DIEN=$O(^MAGV(FILE+.01,"C",IEN,DIEN)) Q:DIEN="" D
  1. . D INACT(.OUT,FILE+.01,DIEN,IEN,1,REASON)
  1. . Q
  1. Q
  1. SETFDA(FILE,ATTS,IENS,FDA,FIELDERR,UPDATE,FDB) ; Set the FDA array for updates and new attachments
  1. N FIELDVAL,VALUE,FIELD,I,IX,J,MIEN,MFILE,MSFILE,MULT,MVALUE,VALID,VALUE,DIC,ISEP,OSEP,TYPEFDA,TYPEIEN,SOPIEN,SOPFDA,X,Y,FNUM
  1. N SIVAL,SIFLD,ERROR,CLASSIEN
  1. S FIELDVAL="",IX="",MIEN=2,ISEP=$$INPUTSEP^MAGVRS41
  1. F D Q:IX="" Q:$D(ERROR)
  1. . S IX=$O(ATTS(IX)) Q:IX=""
  1. . S FIELDVAL=ATTS(IX)
  1. . S FIELD=$P(FIELDVAL,ISEP,1)
  1. . ; Kill DEVICE MANUFACTURER and DEVICE MODEL
  1. . I (FIELD="DEVICE MANUFACTURER")!(FIELD="DEVICE MODEL") K ATTS(IX) Q
  1. . I FIELD["OVERRIDE" Q
  1. . S VALUE=$P(FIELDVAL,ISEP,2)
  1. . S VALUE=$TR(VALUE,"^","~")
  1. . ; Set ACQUISITION LOCATION and SERVICE INSTITUTION REFERENCE
  1. . I (FIELD="CREATING ENTITY")!(FIELD="ACQUISITION LOCATION") D Q:$D(FIELDERR)
  1. . . D SERVINST(VALUE,.SIVAL)
  1. . . I ($G(SIVAL)<0) D SERVERR(.FIELDERR,FIELD,VALUE) S:FIELDERR["Error" ERROR=1 Q
  1. . . S FIELD=$S(FIELD="CREATING ENTITY":"SERVICE INSTITUTION REFERENCE",1:FIELD)
  1. . . S VALUE=SIVAL
  1. . . Q
  1. . ; Handle SOP CLASS UID
  1. . I FIELD="SOP CLASS UID",$G(VALUE)'="" D
  1. . . I '$D(^MAG(2006.532,"B",VALUE)) D
  1. . . . S SOPFDA(2006.532,"+1,",.01)=VALUE
  1. . . . D UPDATE^DIE("","SOPFDA","","SOPERR")
  1. . . . Q
  1. . . ; If the device is in 2006.04 get IEN of entry
  1. . . S SOPIEN=$O(^MAG(2006.532,"B",VALUE,""))
  1. . . S VALUE=SOPIEN
  1. . . Q
  1. . I FIELD="TYPE INDEX",$G(VALUE)'="" D
  1. . . I '$D(^MAG(2005.83,"B",VALUE)) D
  1. . . . S TYPEFDA(2005.83,"+1,",.01)=VALUE
  1. . . . D UPDATE^DIE("","TYPEFDA","","TYPEERR")
  1. . . . Q
  1. . . ; If the device is in 2005.83 get IEN of entry
  1. . . S TYPEIEN=$O(^MAG(2005.83,"B",VALUE,""))
  1. . . S VALUE=TYPEIEN
  1. . . Q
  1. . ; P239 DAC - Class Index was storing as free text, changed to pointer value (#2005.82)
  1. . I FIELD="CLASS INDEX",$G(VALUE)'="" D
  1. . . I '$D(^MAG(2005.82,"B",VALUE)) S VALUE=""
  1. . . I VALUE="" S FIELDERR="Warning - Invalid field: "_FIELD Q
  1. . . S CLASSIEN=$O(^MAG(2005.82,"B",VALUE,""))
  1. . . S VALUE=CLASSIEN
  1. . . Q
  1. . I FIELD="PHOTOMETRIC INTERPRETATION",$G(VALUE)'="" D
  1. . . S VALUE=$$PHOTOIN(VALUE)
  1. . . I VALUE="" S FIELDERR="Warning - Invalid field: "_FIELD Q
  1. . . Q
  1. . I ((FIELD="TYPE INDEX")!(FIELD="SOP CLASS UID"))&(VALUE="") Q
  1. . S FNUM=$$GETFIELD^MAGVRS41(FILE,FIELD)
  1. . I FNUM=0 S FIELDERR="Warning - Invalid field: "_FIELD Q
  1. . I $$NUMERIC^MAGVRS41(FILE,FIELD) S VALUE=$TR(VALUE,"")
  1. . I $$DATETIME^MAGVRS41(FILE,FIELD) S VALUE=$$IDF2FM^MAGVAF01(VALUE)
  1. . ; Do not validate for internal values or LAYGO fields
  1. . I (VALUE'=""),$$GET1^DID(FILE,FNUM,"","TYPE")'="POINTER" D CHK^DIE(FILE,FNUM,"E",VALUE,.VALID) I VALID="^" S FIELDERR="Warning - Invalid data:"_VALUE_" Field:"_FIELD Q
  1. . S FDA(FILE,IENS,FNUM)=VALUE
  1. . Q
  1. Q
  1. PHOTOIN(VALUE) ; Return the enumerated code for a photometric interpretation
  1. N CODE,CODEVAL,I,RES
  1. S CODE=""
  1. D FIELD^DID(2005.64,21,"","POINTER","RES")
  1. F I=1:1:$L(RES("POINTER"),";") S CODEVAL=$P(RES("POINTER"),";",I) Q:CODE'="" D
  1. . I $P(CODEVAL,":",2)=$G(VALUE) S CODE=$P(CODEVAL,":",1)
  1. . Q
  1. Q CODE
  1. ;
  1. ;***** Returns and stores Service Institution
  1. ;
  1. ; Input Parameters
  1. ; ================
  1. ; VALUE=Site IEN
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; SIVAL=IEN of entry in the Imaging Service Institution file (#2005.8)
  1. ;
  1. SERVINST(VALUE,SIVAL) ;
  1. N DIC,DLAYGO,X,Y
  1. S (DIC,DLAYGO)=2005.8,DIC(0)="LX",X=$G(VALUE) D ^DIC S SIVAL=$P(Y,"^",1)
  1. Q
  1. SERVERR(FIELDERR,FIELD,VALUE) ; Sets field error with field and value
  1. I FIELD="ACQUISITION LOCATION" S FIELDERR="Warning - "_$G(FIELD)_" ("_$G(VALUE)_") "_" not found in IMAGING SERVICE INSTITUTION file (#2005.8)."
  1. I FIELD="CREATING ENTITY" S FIELDERR="Error - "_$G(FIELD)_" ("_$G(VALUE)_") "_" not found in IMAGING SERVICE INSTITUTION file (#2005.8)."
  1. Q