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