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

MAGVRS41.m

Go to the documentation of this file.
  1. MAGVRS41 ;WOIFO/DAC,MLH,NST - Utilities for RPC calls for DICOM file processing ; 08 May 2018 10:41 AM
  1. ;;3.0;IMAGING;**118,201**;Mar 19, 2002;Build 4525;May 01, 2013
  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. INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
  1. Q "`"
  1. OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
  1. Q "|"
  1. STATSEP() ; Status and Result separator ie. -3``No record IEN
  1. Q "`"
  1. UPDATE(OUT,FILE,ATTS,OVERRIDE) ; Update Attributes
  1. N FDA,IEN,DATETIME,UIEN,UFILE,FIELDERR
  1. ; If File is out of range quit with error
  1. S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
  1. I (FILE<2005.6)!(FILE>2005.65) S OUT(1)="-1"_SSEP_"File is not in the 2005.6 to 2005.65 range" Q
  1. ; If first attribute is not the update record's IEN quit with error
  1. I $P($G(ATTS(1)),ISEP,1)'["IEN" S OUT(1)="-2"_SSEP_"No record IEN" Q
  1. S IEN=$P(ATTS(1),ISEP,2) K ATTS(1)
  1. I (IEN<1)!(IEN>($O(^MAGV(FILE," "),-1))) S OUT(1)="-6"_SSEP_"Invalid IEN" Q
  1. I FILE'=2005.6 D Q:$D(OUT(1)) ; logic for files with parents only!
  1. . I '$G(OVERRIDE) D Q:$D(OUT(1))
  1. . . I $P($G(ATTS(2)),ISEP,1)'["REFERENCE" S OUT(1)="-2"_SSEP_"No record IEN" Q
  1. . . S PIEN=$P(ATTS(2),ISEP,2)
  1. . . Q
  1. . I '$G(IEN) S OUT(1)="-1"_SSEP_"No IEN" Q
  1. . I '$G(OVERRIDE),'$$PARENT(FILE,IEN,PIEN) S OUT(1)="-9"_SSEP_"Parent Record not verified" Q
  1. . ; Check for STATUS INACCESSIBLE
  1. . I $G(PIEN),((FILE=2005.63)!(FILE=2005.64)) D Q:$D(OUT(1))
  1. . . N PFILE,STATUS
  1. . . I FILE=2005.63 S PFILE=2005.62
  1. . . I FILE=2005.64 S PFILE=2005.63
  1. . . S STATUS=$$GET1^DIQ(PFILE,PIEN,"STATUS","I")
  1. . . I STATUS="I" S OUT(1)="-100"_SSEP_"Parent status is Inaccessible."
  1. . . Q
  1. . Q
  1. S ATTS($O(ATTS(" "),-1)+1)="STATUS"_ISEP_"A" ; update always (re)activates
  1. D SETFDA^MAGVRS44(FILE,.ATTS,IEN_",",.FDA,.FIELDERR,1)
  1. D FILE^DIE("","FDA","ERR")
  1. I $D(ERR("DIERR")) S OUT(1)="-6"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
  1. I $D(ERR("DIERR")) Q
  1. K FDA,ERR
  1. I FILE=2005.65,$G(PIEN)'="" D AOFSET(PIEN,IEN)
  1. ;Update last update for record and parents
  1. S DATETIME=$$NOW^XLFDT
  1. S UIEN=IEN,UFILE=FILE
  1. F UFILE=UFILE:-.01:2005.62 Q:'UIEN D
  1. . I FILE'=2005.65 D
  1. . . S FDA(UFILE,UIEN_",",$$GETFIELD(UFILE,"LAST UPDATE DATE/TIME"))=DATETIME
  1. . . D FILE^DIE("","FDA","ERR")
  1. . . I $D(ERR("DIERR")) S OUT(1)="-3"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
  1. . . I $D(ERR("DIERR")) Q
  1. . . K FDA,ERR
  1. . . Q
  1. . I UIEN S PIEN=+$G(^MAGV(UFILE,UIEN,6))
  1. . Q
  1. S OUT(1)="0"_SSEP_$G(FIELDERR)_SSEP_IEN
  1. Q
  1. ATTACH(OUT,FILE,ATTS) ; Create record; attach to parent record if applicable
  1. ; Input Variables:
  1. ; FILE - File number of record
  1. ; ATTS - Array of name value pairs separated by an input separator
  1. ; Output Variables:
  1. ; OUT - Returns success and new record IEN or error and error message
  1. N FDA,OSEP,ISEP,SSEP,NAM,VAL,ATTNAMS,KEYFLD,UATT,IEN,STATUS,NEWATTS,I
  1. N PIEN,PPIEN,PFILE,ERR,CIEN,UID,UIEN,DATETIME,KEYNAM,FIELDERR,DFN,DEVFDA,DEVICE
  1. S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
  1. ; If file out of range quit with error
  1. I (FILE<2005.6)!(FILE>2005.65) S OUT(1)="-4"_SSEP_"File is not in the 2005.6 to 2005.65 range" Q
  1. ; If atts not defined quit with error
  1. S I=0
  1. F S I=$O(ATTS(I)) Q:'I D Q:$D(OUT(1))
  1. . S NAM=$P(ATTS(I),ISEP,1),VAL=$P(ATTS(I),ISEP,2)
  1. . I NAM="" S OUT(1)="-64"_SSEP_"Attribute name(s) missing from attribute array" Q
  1. . S ATTNAMS(NAM)=VAL
  1. . Q
  1. Q:$D(OUT(1))
  1. S KEYNAM=$$GET1^DID(FILE,.01,,"LABEL"),(UATT,KEYFLD(.01))=$G(ATTNAMS(KEYNAM))
  1. S KEYFLD(.01,"GSL")=$$GET1^DID(FILE,.01,,"GLOBAL SUBSCRIPT LOCATION")
  1. ; Set PIEN (parent IEN)
  1. I FILE=2005.61 S PIEN=$G(ATTNAMS("PATIENT REFERENCE")),PFILE=2005.6
  1. I FILE=2005.62 S PIEN=$G(ATTNAMS("PROCEDURE REFERENCE")),PFILE=2005.61
  1. I FILE=2005.63 S PIEN=$G(ATTNAMS("STUDY REFERENCE")),PFILE=2005.62
  1. I FILE=2005.64 S PIEN=$G(ATTNAMS("SERIES REFERENCE")),PFILE=2005.63
  1. I FILE=2005.65 S PIEN=$G(ATTNAMS("SOP INSTANCE REFERENCE")),PFILE=2005.64
  1. ; Check for STATUS INACCESSIBLE
  1. I (FILE=2005.63)!(FILE=2005.64) D Q:$D(OUT(1))
  1. . S STATUS=$$GET1^DIQ(PFILE,PIEN,"STATUS","I")
  1. . I STATUS="I" S OUT(1)="-100"_SSEP_"Parent status is Inaccessible."
  1. . Q
  1. ; File DEVICE MANUFACTURER and DEVICE MODEL as ACQUISITION DEVICE in file 2005.63
  1. I FILE=2005.63 D
  1. . ; Remove parentheses from DEVICE MANUFACTOR and DEVICE MODEL and concatenate DEVICE and place model in parentheses
  1. . S DEVMAN=$G(ATTNAMS("DEVICE MANUFACTURER"))
  1. . S DEVMODEL=$G(ATTNAMS("DEVICE MODEL"))
  1. . S DEVICE=DEVMAN_" ("_DEVMODEL_")"
  1. . ; If the device is not in 2006.04 add device
  1. . I '$D(^MAG(2006.04,"B",DEVICE)) D
  1. . . S DEVFDA(2006.04,"+1,",.01)=DEVICE
  1. . . D UPDATE^DIE("","DEVFDA","","DEVERR")
  1. . . Q
  1. . ; If the device is in 2006.04 get IEN of entry
  1. . S DEVIEN=$O(^MAG(2006.04,"B",DEVICE,""))
  1. . S ATTS($O(ATTS(" "),-1)+1)="DEVICE"_ISEP_DEVIEN
  1. . K ATTNAMS("DEVICE MANUFACTURER"),ATTNAMS("DEVICE MODEL")
  1. . Q
  1. D:('$D(ATTNAMS("ARTIFACT ON FILE")))&(FILE'=2005.65)
  1. . S ATTNAMS("ARTIFACT ON FILE")=0
  1. . S ATTS($O(ATTS(" "),-1)+1)="ARTIFACT ON FILE"_ISEP_0
  1. . Q
  1. I $G(UATT)="" S OUT(1)="-5"_SSEP_"Unique identifier not provided" Q
  1. ; If a patient ID is assigned by the VA set the PATIENT pointer
  1. I FILE=2005.6,$G(ATTNAMS("ASSIGNING AUTHORITY"))="V" D
  1. . S DFN=$G(ATTNAMS("ENTERPRISE PATIENT ID"))
  1. . I DFN'="" S ATTS($O(ATTS(" "),-1)+1)="PATIENT FILE REFERENCE"_ISEP_DFN
  1. . Q
  1. ;
  1. ; Quit with error if no assigning authority provided for a Procedure Reference
  1. I FILE=2005.61,$G(ATTNAMS("ASSIGNING AUTHORITY"))="" S OUT(1)="-5"_SSEP_"No ASSIGNING AUTHORITY provided." Q
  1. ;
  1. ; If entry exists for Patient or Procedure then it is an update
  1. D Q:$G(IEN) Q:$D(OUT(1)) ; Patient or procedure update?
  1. . ; Add multi-key (already checked .01)
  1. . I (FILE=2005.6)!(FILE=2005.61) D ADDMKEYS^MAGVRS46(.OUT,FILE,.ATTNAMS,.KEYFLD) Q:$D(OUT(1))
  1. . ;
  1. . S IEN=$$MATCH^MAGVRS46(FILE,UATT,$G(PIEN),.KEYFLD) ; Find match by keys
  1. . Q:'IEN ; no exact match, create new
  1. . ;
  1. . S STATUS=$$GET1^DIQ(FILE,IEN,"STATUS","I")
  1. . I (FILE>2005.6),(PIEN'=+$G(^MAGV(FILE,IEN,6))) D Q
  1. . . I STATUS="A" S OUT(1)="-66"_SSEP_"Parent IEN does not match parent IEN of record on file"
  1. . . E S IEN="" ; STATUS="I" INACCESSIBLE
  1. . . Q
  1. . I STATUS'="I" S OUT(1)="-63"_SSEP_"Active reference with same unique ID already exists" Q
  1. . S NEWATTS(1)="IEN"_ISEP_IEN
  1. . F I=1:1 Q:'$D(ATTS(I)) S NEWATTS(I+1)=ATTS(I)
  1. . S NEWATTS($O(NEWATTS(" "),-1)+1)="STATUS"_ISEP_"A"
  1. . D UPDATE(.OUT,FILE,.NEWATTS,1)
  1. . Q
  1. Q:$D(OUT(1))
  1. I FILE>2005.6 D Q:$G(OUT(1))'="" ; verify that parent IEN is set
  1. . I PIEN="" S OUT(1)="-1"_SSEP_"No parent record IEN" Q
  1. . I (PIEN<1)!(PIEN>($O(^MAGV(FILE-.01," "),-1))) S OUT(1)="-6"_SSEP_"Invalid parent IEN" Q
  1. . Q
  1. ; If a series and a consult, get the current TIU note for the study (parent IEN)
  1. I FILE=2005.63 D Q:$G(OUT(1))<0
  1. . D TIUCHK^MAGVRS43(.OUT,PIEN) Q:$G(OUT(1))<0 ; bail out if fatal exception raised
  1. . I $P(OUT(1),SSEP,1)=0 S ATTS($O(ATTS(" "),-1)+1)="TIU NOTE REFERENCE"_ISEP_$P(OUT(1),SSEP,3)
  1. . K OUT
  1. . Q
  1. S ATTS($O(ATTS(" "),-1)+1)="STATUS"_ISEP_"A"
  1. D SETFDA^MAGVRS44(FILE,.ATTS,"+1,",.FDA,.FIELDERR)
  1. S UID=$G(FDA(FILE,"+1,",.01))
  1. I UID="" S OUT(1)="-2"_SSEP_"No UID" Q
  1. ; Attach record
  1. D UPDATE^DIE("","FDA","","ERR")
  1. K FDA
  1. S CIEN=$O(^MAGV(FILE,"B",UID,""),-1) ; New Record IEN
  1. S OUT(1)="0"_SSEP_$G(FIELDERR)_SSEP_CIEN ; Set return output to IEN of new record
  1. I $D(ERR("DIERR")) S OUT(1)="-3"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
  1. I $D(ERR("DIERR")) Q
  1. K ERR
  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,6)),FDA(2005.62,PPIEN_",",20)=$P($G(^MAGV(2005.62,PPIEN,4)),U,2)+1
  1. D FILE^DIE("","FDA","ERR")
  1. K FDA
  1. I FILE=2005.65 D AOFSET(PIEN,CIEN)
  1. I FILE>2005.6 D Q:$G(OUT(1))'="" ;Update last update for record and parents
  1. . S DATETIME=$$NOW^XLFDT
  1. . S UIEN=CIEN
  1. . F UFILE=FILE:-.01:2005.62 Q:'UIEN D
  1. . . I UFILE'=2005.65 D
  1. . . . S FDA(UFILE,UIEN_",",$$GETFIELD(UFILE,"LAST UPDATE DATE/TIME"))=DATETIME
  1. . . . S:$G(ERR)'="" OUT(1)=ERR
  1. . . . K ERR
  1. . . . D FILE^DIE("","FDA","ERR")
  1. . . . I $D(ERR("DIERR")) S OUT(1)="-5"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
  1. . . . K FDA,ERR
  1. . . . Q
  1. . . I UIEN S UIEN=+$G(^MAGV(UFILE,UIEN,6))
  1. . . Q
  1. . Q
  1. Q
  1. REFRESH(OUT,FILE,IEN,PIEN,OVERRIDE) ; Retrieve specified file data attributes
  1. N OUTI,FIELD,MULTOUT,FDA,ERR,OSEP,ISEP,SSEP,MULTIPLE,DATETIME,UIEN,UFILE,FORMAT,SUBFILE,SUBIEN,FILEMULT,DD
  1. N DEVIEN,DEVNAME,DEVMAN,DEVMODEL,VALUE
  1. S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP K OUT
  1. I $G(FILE)="" S OUT(1)="-9"_SSEP_"Missing file specification" Q
  1. I '$D(^MAGV(FILE)),'$D(^MAGD(FILE)) S OUT(1)="-10"_SSEP_"Invalid file specification ("_$G(FILE)_")" Q
  1. I '$G(IEN) S OUT(1)="-1"_SSEP_"No record IEN" Q
  1. I '$G(OVERRIDE),'$G(PIEN) S OUT(1)="-2"_SSEP_"No parent record IEN" Q
  1. I FILE'=2005.61,'$G(OVERRIDE),'$$PARENT(FILE,IEN,PIEN) S OUT(1)="-3"_SSEP_"Parent Record not verified" Q
  1. I FILE'=2006.575,'$D(^MAGV(FILE,IEN)) S OUT(1)="-4"_SSEP_"IEN does not exist in "_FILE Q
  1. I FILE=2006.575,'$D(^MAGD(FILE,IEN)) S OUT(1)="-5"_SSEP_"IEN does not exist in "_FILE Q
  1. S FIELD=$$GETFIELD(FILE,"STATUS") I FIELD D Q:$D(OUT)
  1. . S STATUS=$$GET1^DIQ(FILE,IEN,FIELD,"I")
  1. . S:STATUS="I" OUT(1)="-11"_SSEP_"No accessible entry for UID found in file "_FILE
  1. . Q
  1. S FIELD="",OUTI=2,FNUM=""
  1. D GETS^DIQ(FILE,IEN_",","**","I","DD")
  1. ; Process all non-multiple fields
  1. F D Q:FNUM=""
  1. . S FNUM=$O(DD(FILE,IEN_",",FNUM)) Q:FNUM=""
  1. . I FILE=2005.63,FNUM=18 D Q ; DEVICE returns DEVICE MANUFACTURER and DEVICE MODEL from the ACQUISITION DEVICE file NAME (.01) field
  1. . . S DEVIEN=$G(DD("2005.63",IEN_",","18","I"))
  1. . . Q:$G(DEVIEN)=""
  1. . . S DEVNAME=$P($G(^MAG(2006.04,DEVIEN,0)),U,1)
  1. . . S DEVMAN=$P(DEVNAME," (",1)
  1. . . S DEVMODEL=$TR($P(DEVNAME," (",2),")")
  1. . . S OUT(OUTI)="DEVICE MANUFACTURER"_OSEP_DEVMAN_SSEP
  1. . . S OUT(OUTI+1)="DEVICE MODEL"_OSEP_DEVMODEL_SSEP
  1. . . S OUTI=OUTI+2
  1. . . Q
  1. . S FIELD=$$GET1^DID(FILE,FNUM,,"LABEL")
  1. . S FORMAT=$S((FIELD["INDEX")!(FIELD="SOP CLASS UID")!(FIELD="PHOTOMETRIC INTERPRETATION"):"E",1:"I") ; return internal formats except for index terms and SOP CLASS UID
  1. . I (FIELD["REFERENCE") S FORMAT="I" ; If the field is an IEN pointer return the internal format rather than the UID string
  1. . S VALUE=$$GET1^DIQ(FILE,IEN,FIELD,$G(FORMAT))
  1. . I $$DATETIME(FILE,FIELD) S VALUE=$$FM2IDF^MAGVAF01(VALUE)
  1. . I FILE=2005.63,FIELD="ACQUISITION LOCATION",VALUE'="" S VALUE=$$GETSINST(VALUE)
  1. . I ((FILE=2005.6)!(FILE=2005.61))&(FIELD="SERVICE INSTITUTION REFERENCE"),VALUE'="" S VALUE=$$GETSINST(VALUE),FIELD="CREATING ENTITY"
  1. . S OUT(OUTI)=FIELD_OSEP_VALUE_SSEP
  1. . S OUTI=OUTI+1
  1. . Q
  1. ; Process multiple fields
  1. S FILEMULT=FILE
  1. F D Q:FILEMULT=""
  1. . S FILEMULT=$O(DD(FILEMULT)) Q:FILEMULT=""
  1. . S FNUM=$E(FILEMULT,$L(FILE)+1,$L(FILEMULT))
  1. . D GETS^DIQ(FILE,IEN_",",FNUM_"*","","MULTOUT")
  1. . I '$D(MULTOUT) Q
  1. . S FIELD=$$GET1^DID(FILE,FNUM,,"LABEL")
  1. . S SUBFILE=$O(MULTOUT("")),SUBIEN=""
  1. . F D Q:$O(MULTOUT(SUBFILE,SUBIEN))=""
  1. . . S SUBIEN=$O(MULTOUT(SUBFILE,SUBIEN))
  1. . . S OUT(OUTI)=FIELD_OSEP_MULTOUT(SUBFILE,SUBIEN,.01)_SSEP
  1. . . S OUTI=OUTI+1
  1. . . Q
  1. . Q
  1. S OUT(1)="0"_SSEP ; Look up successful
  1. ; Update last access date time for study
  1. S DATETIME=$$NOW^XLFDT
  1. S UIEN=IEN
  1. F UFILE=FILE:-.01:2005.62 Q:'UIEN D
  1. . I UFILE=2005.62 D
  1. . . S FDA(UFILE,UIEN_",",$$GETFIELD(UFILE,"LAST ACCESS DATE/TIME"))=DATETIME
  1. . . K ERR
  1. . . D FILE^DIE("","FDA","ERR")
  1. . . S:$G(ERR("DIERR"))'="" OUT(1)="-7"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
  1. . . K FDA,ERR
  1. . . Q
  1. . I UIEN S UIEN=+$G(^MAGV(UFILE,UIEN,6))
  1. . Q
  1. Q
  1. MULTIPLE(FILE,FIELD) ; Process multiple DB entries
  1. N DATATYPE,MULTIPLE,FNUM
  1. S MULTIPLE=$$GET1^DID(FILE,FIELD,,"MULTIPLE-VALUED")
  1. Q +MULTIPLE
  1. NUMERIC(FILE,FIELD) ; Determine if field is numeric
  1. N DATATYPE,NUMERIC
  1. S NUMERIC=0
  1. I $$GET1^DID(FILE,FIELD,"","TYPE")="NUMERIC" S NUMERIC=1
  1. Q NUMERIC
  1. DATETIME(FILE,FIELD) ; Determine if field is date time
  1. N DATATYPE,DATETIME
  1. S DATETIME=0
  1. I $$GET1^DID(FILE,FIELD,"","TYPE")="DATE/TIME" S DATETIME=1
  1. Q DATETIME
  1. GETFIELD(FILE,FNAME) ; Returns a field number given a field name
  1. Q $$FLDNUM^DILFD(FILE,FNAME)
  1. PARENT(FILE,IEN,PIEN) ; Check if provided parent IEN is linked to current record
  1. I PIEN'=+$G(^MAGV(FILE,IEN,6)) Q 0
  1. Q 1
  1. AOFSET(PIEN,IEN) ; Set artifact on file to 1 for all parent nodes of file instance
  1. N AOFFILE,FIELD,FDA,ERR,MAGVIEN,MAGVPIEN,MAGVOUT
  1. S MAGVPIEN=PIEN ; IEN in file #2005.64
  1. S MAGVIEN=IEN ; IEN in file #2005.65
  1. ;
  1. F AOFFILE=2005.64,2005.63,2005.62,2005.61,2005.6 D
  1. . S FIELD=$$GETFIELD(AOFFILE,"ARTIFACT ON FILE")
  1. . I $G(FIELD)="" Q
  1. . S FDA(AOFFILE,PIEN_",",FIELD)=1
  1. . D FILE^DIE("","FDA")
  1. . K FDA,ERR
  1. . I AOFFILE>2005.6 S PIEN=+$G(^MAGV(AOFFILE,PIEN,6))
  1. . Q
  1. D NWI34^MAGNWRK1(.MAGVOUT,MAGVPIEN,MAGVIEN) ; add a new storage work item
  1. ;
  1. Q
  1. INACTIVT(OUT,FILE,IEN,PIEN,OVERRIDE,REASON) ; Marks the entry indicated by file # and IEN as deleted
  1. N OSEP,ISEP,SSEP,STATUS,PFILE,ERR,FDA,AOF,FIELD,AOFIEN
  1. S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
  1. I $G(FILE)="" S OUT(1)="-23"_SSEP_"No file number provided" Q
  1. I $G(IEN)="" S OUT(1)="-20"_SSEP_"No IEN provided" Q
  1. I '$G(PIEN)="" S OUT(1)="-21"_SSEP_"No parent IEN provided" Q
  1. I '$D(OVERRIDE) S OUT(1)="-22"_SSEP_"No OVERRIDE flag provided" Q
  1. I '$D(^MAGV(FILE,IEN,0)) S OUT(1)="-1"_SSEP_"Record IEN not found in file" Q
  1. I '$D(REASON) S OUT(1)="-4"_SSEP_"No deletion reason provided" Q
  1. ; If record status is already INACCESIBLE quit with error
  1. S FIELD=$$GETFIELD(FILE,"STATUS")
  1. S STATUS=$$GET1^DIQ(FILE,IEN,FIELD,"E")
  1. I STATUS="INACCESSIBLE" S OUT(1)="2"_SSEP_"Record is already inaccessible" Q
  1. ; Call INACT to delete identified record and all children
  1. D INACT^MAGVRS44(.OUT,FILE,IEN,$G(PIEN),$G(OVERRIDE),$G(REASON))
  1. I $D(OUT(1)) Q
  1. ; Set parent records artifact on file to false if no active child records
  1. S AOFIEN=IEN,AOF=""
  1. F FILE=FILE:2005.61:-.01 Q:AOF'="" D
  1. . F S AOFIEN=+$G(^MAGV(FILE,"C",PIEN,AOFIEN)) Q:(AOF'="")!(AOFIEN="") D
  1. . . S FIELD=$$GETFIELD(FILE,"ARTIFACT ON FILE")
  1. . . S AOF=$$GET1^DIQ(FILE,AOFIEN,FIELD)
  1. . Q
  1. . ;If no child records are on file then set parent to artifact not on file
  1. . I AOF="" D
  1. . . S PFILE=FILE-.01
  1. . . S FIELD=$$GETFIELD(FILE,"ARTIFACT ON FILE")
  1. . . S FDA(PFILE,PIEN_",",FIELD)=""
  1. . . D FILE^DIE("","FDA")
  1. . . K FDA,ERR
  1. . . Q
  1. . Q
  1. I '$D(OUT(1)) S OUT(1)="0"_SSEP_SSEP_IEN
  1. Q
  1. FINDBUID(OUT,FILE,UID) ;Find SOP or series by UID
  1. N STATUS,IEN,OSEP,ISEP,SSEP
  1. S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
  1. I $G(FILE)="" S OUT="-3"_SSEP_"No file specified" Q
  1. I "^2005.62^2005.63^2005.64^"'[("^"_FILE_"^") S OUT="-4"_SSEP_"Invalid file specified ("_FILE_")" Q
  1. I $G(UID)="" S OUT="-5"_SSEP_"No UID specified" Q
  1. S IEN=$O(^MAGV(FILE,"B",UID,""))
  1. S FIELD=$$GETFIELD(FILE,"STATUS")
  1. S STATUS=$$GET1^DIQ(FILE,IEN,FIELD,"I")
  1. I IEN'="",STATUS'="I" S OUT="0"_SSEP_SSEP_IEN Q
  1. I IEN="" S OUT="-1"_SSEP_"UID not found in file "_FILE Q
  1. I STATUS="I" S OUT="-2"_SSEP_"No active entry for UID found in file "_FILE Q
  1. Q
  1. GETSINST(VALUE) ; Get the service institution value
  1. N IEN,FILE,SITE,X
  1. S SITE="Error - unknown service institution"
  1. S X=$G(^MAGV(2005.8,$G(VALUE),0))
  1. S IEN=$P(X,";",1),FILE=$P(X,";",2)
  1. I FILE="DIC(4," S SITE=$P($$NS^XUAF4(IEN),U,2) ; IA #2171 Get Station Number
  1. Q SITE