- 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 Jan 18, 2025@03:11:32 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