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

MAGVIM05.m

Go to the documentation of this file.
  1. MAGVIM05 ;WOIFO/MAT,JL,DAC,PMK,BT - Utilities for RPC calls for DICOM file processing ;15 March 2023 9:56 AM
  1. ;;3.0;IMAGING;**118,138,164,166,194,278,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. ;
  1. Q
  1. ;
  1. ;+++++ Wrap call to code underlying RPC: RAMAG EXAM COMPLETE & re-format output
  1. ;
  1. ; RPC: MAGV RAD STAT COMPLETE Private IA #5072
  1. ;
  1. ; Inputs:
  1. ; =======
  1. ;
  1. ; RETURN ...... variable to hold the results
  1. ; RADPT ....... IEN of the RAD/NUC MED PATIENT file (#70)
  1. ; RAEXAM1 ..... EXAM DATE (#.01) of the REGISTERED EXAMS sub-file (#70.02)
  1. ; RAEXAM2 ..... IEN of the EXAMINATIONS sub-file (#70.03)
  1. ; MAGVUSR ..... DUZ of the Importer 2 application user.
  1. ; MAGVUSRDV ... DUZ(2) of the Importer 2 user.
  1. ; RAIMGTYP .... TYPE OF IMAGING (#2) of the REGISTERED EXAMS sub-file (#70.02)
  1. ; [RASTDRPT] ... IEN of an entry in the STANDARD REPORTS file (#74.1)
  1. ; [RADXPRIM] .. Primary Diagnostic Code --> RAMISC Param PRIMDXCODE
  1. ; IEN(s) of entries in the DIAGNOSTIC CODES file(#78.3)
  1. ; [RADXSCND] ... In the RPC (defined as OTHDIAG). Contains List of
  1. ; ... (1) One or more IENs of entries in the DIAGNOSTIC CODES file (#78.3).
  1. ; ... (These will be the exam's Secondary Diagnostic Codes via the RAMISC parameter 'SECDXCODE')
  1. ; ... (2) Report Text and Impression Text
  1. ; ... (Either entered manually or populated using 'GET Report from SR' in the Importer app)
  1. ;
  1. ; Outputs:
  1. ; ========
  1. ;
  1. ; Notes:
  1. ; ======
  1. ;
  1. ; The parameters mirror those of the underlying call.
  1. ;
  1. XMCOMPLT(RETURN,RADPT,RAEXAM1,RAEXAM2,MAGVUSR,MAGVUSRDV,RAIMGTYP,RASTDRPT,RADXPRIM,RADXSCND) ;
  1. ;
  1. ;--- Initialize
  1. K RETURN
  1. N MSG,RARESULT,SEPSTAT,SEPOUTP D ZRUSEPIN
  1. ;
  1. N RAMAN ; Use Manually entered Report and Impression Text
  1. N RARPTXT S RARPTXT="" ; Manually entered Report Text (List - multiple lines of text)
  1. N RAIMPRS S RAIMPRS="" ; Manually entered Impression Text (List - multiple lines of text)
  1. N RASCND
  1. ;
  1. ;--- Validate incoming parameters.
  1. N MAGERR,PARAM S MAGERR=0
  1. D
  1. . F PARAM="RADPT","RAEXAM1","RAEXAM2","MAGVUSR","MAGVUSRDV","RAIMGTYP" D Q:MAGERR
  1. . . S:@PARAM="" MAGERR=1
  1. . . Q
  1. . Q
  1. ;
  1. I MAGERR D Q
  1. . S RETURN(0)="-1"_SEPSTAT_"Required parameter "_PARAM_" missing or invalid."
  1. . Q
  1. ;
  1. ;--- Format incoming RAD Exam Identifiers.
  1. S RAEXAM=RADPT_U_RAEXAM1_U_RAEXAM2
  1. ;
  1. ;--- Set IMAGING SITE PARAMETERS file (#2006.1) IEN from DUZ(2).
  1. N MAGSITEP
  1. D
  1. . S MAGVUSRDV=$G(MAGVUSRDV,$G(DUZ(2))),MAGSITEP=$O(^MAG(2006.1,"B",MAGVUSRDV,"")) ;P164
  1. . I MAGSITEP="" D ;P164 - if it is not Site IEN, try Station Number
  1. . . ;--- Get IEN of INSTITUTION file (#4) from STATION NUMBER (Supported IA# 2171)
  1. . . N IENINST S IENINST=$$IEN^XUAF4(MAGVUSRDV)
  1. . . S MAGSITEP=$O(^MAG(2006.1,"B",IENINST,"")) Q:+MAGSITEP ;found the site
  1. . . S MAGERR=1,MSG="Unable to resolve Imaging Site Parameters entry. {DUZ(2)="_MAGVUSRDV_"} "
  1. . Q
  1. ;
  1. I MAGERR D Q
  1. . S RETURN(0)="-1"_SEPSTAT_MSG
  1. . Q
  1. ;
  1. ;--- Compile Report Text, and Impression if passed in.
  1. ;--- must do it this way, HDIG RPC broker doesn't work with multiple LIST input parameters
  1. D:$G(RADXSCND(0))'=""
  1. . ;
  1. . N RCT S RCT=0
  1. . N ICT S ICT=0
  1. . N SCT S SCT=0
  1. . N CT S CT=""
  1. . F S CT=$O(RADXSCND(CT)) Q:CT="" D
  1. . . I $E(RADXSCND(CT),1,3)="|R|" S RAMAN=1,RCT=RCT+1,RARPTXT(RCT)=$P(RADXSCND(CT),"|R|",2),RARPTXT=RARPTXT_RARPTXT(RCT) Q
  1. . . I $E(RADXSCND(CT),1,3)="|I|" S RAMAN=1,ICT=ICT+1,RAIMPRS(ICT)=$P(RADXSCND(CT),"|I|",2),RAIMPRS=RAIMPRS_RAIMPRS(ICT) Q
  1. . . S RASCND(SCT)=RADXSCND(CT),SCT=SCT+1
  1. . . Q
  1. . K RADXSCND M RADXSCND=RASCND
  1. . Q
  1. ;
  1. ;--- Set additional RAD Order/Exam parameters.
  1. S MAGERR=$$MAKELIST("C",RAIMGTYP,.RAMSC,MAGVUSR,MAGSITEP)
  1. I MAGERR D Q
  1. . S RETURN(0)="-1"_SEPSTAT_$P(MAGERR,U,2)
  1. . Q
  1. ;
  1. ;--- Set flag to insert Primary DX code if passed in.
  1. D:$G(RADXPRIM)'="" OUTPUT("PRIMDXCODE^^"_RADXPRIM,.RAMSC)
  1. ;
  1. ;--- Set flag to insert Secondary DX code(s) if passed in.
  1. D:$G(RADXSCND(0))'=""
  1. . ;
  1. . N CT S CT=""
  1. . F S CT=$O(RADXSCND(CT)) Q:CT="" D OUTPUT("SECDXCODE"_U_(CT+1)_U_RADXSCND(CT),.RAMSC)
  1. . Q
  1. ;
  1. ;--- Set flag to suppress HL7 message to dictation systems.
  1. D OUTPUT("FLAGS^^FS",.RAMSC)
  1. ;--- Call code underlying RPC: RAMAG EXAM COMPLETE (Private IA #5072)
  1. D COMPLETE^RAMAGRP1(.RARESULT,RAEXAM,.RAMSC)
  1. I $G(RARESULT(1))="-11^2" D ; add the OUTSIDE STUDY and try the RPC again
  1. . N INFO
  1. . D ADDROOM(.INFO,RAEXAM)
  1. . K RARESULT
  1. . I INFO(1)<0 M RARESULT=INFO Q
  1. . D COMPLETE^RAMAGRP1(.RARESULT,RAEXAM,.RAMSC)
  1. . Q
  1. ;
  1. ;--- Re-format error output or return 0.
  1. I RARESULT(0)<0 D
  1. . ;
  1. . S RETURN(0)=-1_SEPSTAT_$O(RARESULT("A"),-1)_" error lines returned."
  1. . N X S X=0
  1. . F S X=$O(RARESULT(X)) Q:X="" D
  1. . . S RETURN(X)=$P(RARESULT(X),U,1)_SEPSTAT_$P(RARESULT(X),U,2,999)
  1. . . Q
  1. E D
  1. . S RETURN(0)=0_SEPSTAT_RARESULT(0)
  1. . N X S X=0
  1. . F S X=$O(RARESULT(X)) Q:X="" D
  1. . . S RETURN(X)=$TR(RARESULT(X),U,SEPOUTP)
  1. . . Q
  1. . ;--- Call RA* code to trigger alerts for DX codes.
  1. . D ALERT^MAGVIMRA(RADPT,RAEXAM1,RAEXAM2,1)
  1. . Q
  1. Q
  1. ;+++++ Wrap call to code underlying RPC: RAMAG EXAMINED & re-format output
  1. ;
  1. ; RPC: MAGV RAD STAT EXAMINED Private IA #5071
  1. ;
  1. ; Inputs:
  1. ; =======
  1. ;
  1. ; See input parameter descriptions above tag XMCOMPLT (above).
  1. ;
  1. XMEXAMIN(RETURN,RADFN,RAEXAM1,RAEXAM2,MAGVUSR,MAGVUSRDV,RAIMGTYP) ;
  1. ;
  1. ;--- Initialize.
  1. K RETURN
  1. N MSG,RARESULT,SEPSTAT,SEPOUTP D ZRUSEPIN
  1. ;--- Validate incoming parameters.
  1. N MAGERR,PARAM S MAGERR=0
  1. D
  1. . F PARAM="RADFN","RAEXAM1","RAEXAM2","MAGVUSR","MAGVUSRDV","RAIMGTYP" D Q:MAGERR
  1. . . S:@PARAM="" MAGERR=1
  1. . . Q
  1. . Q
  1. ;
  1. I MAGERR D Q
  1. . S RETURN(0)="-1"_SEPSTAT_"Required parameter "_PARAM_" missing or invalid."
  1. . Q
  1. ;
  1. ;--- Format incoming RAD Exam Identifiers
  1. N RAEXAM S RAEXAM=RADFN_U_RAEXAM1_U_RAEXAM2
  1. ;
  1. ;--- Set IMAGING SITE PARAMETERS file (#2006.1) IEN from DUZ(2).
  1. N MAGSITEP
  1. D
  1. . S MAGVUSRDV=$G(MAGVUSRDV,$G(DUZ(2))),MAGSITEP=$O(^MAG(2006.1,"B",MAGVUSRDV,"")) ;DAC P166
  1. . I MAGSITEP="" D ;DAC P166 - if it is not Site IEN, try Station Number
  1. . . ;--- Get IEN of INSTITUTION file (#4) from STATION NUMBER (Supported IA# 2171)
  1. . . N IENINST S IENINST=$$IEN^XUAF4(MAGVUSRDV)
  1. . . I IENINST'="" S MAGSITEP=$O(^MAG(2006.1,"B",IENINST,"")) Q:+MAGSITEP ;found the site
  1. . . S MAGERR=1,MSG="Unable to resolve Imaging Site Parameters entry. {DUZ(2)="_MAGVUSRDV_"} "
  1. . Q
  1. ;
  1. I MAGERR D Q
  1. . S RETURN(0)="-1"_SEPSTAT_MSG
  1. . Q
  1. ;
  1. ;
  1. ;--- Set required parameters
  1. S MAGERR=$$MAKELIST("E",RAIMGTYP,.RAMSC,MAGVUSR,MAGSITEP)
  1. I MAGERR D Q
  1. . S RETURN(0)="-1"_SEPSTAT_$P(MAGERR,U,2)
  1. . Q
  1. ;
  1. ;--- Set flag to suppress HL7 message to dictation systems.
  1. D OUTPUT("FLAGS^^FS",.RAMSC)
  1. ;--- Call code underlying RPC: RAMAG EXAMINED (Private IA #5071).
  1. D EXAMINED^RAMAGRP2(.RARESULT,RAEXAM,.RAMSC)
  1. I $G(RARESULT(1))="-11^2" D ; add the OUTSIDE STUDY and try the RPC again
  1. . N INFO
  1. . D ADDROOM(.INFO,RAEXAM)
  1. . K RARESULT
  1. . I INFO(1)<0 M RARESULT=INFO Q
  1. . D EXAMINED^RAMAGRP2(.RARESULT,RAEXAM,.RAMSC)
  1. . Q
  1. ;
  1. ;--- Re-format error output or return 0.
  1. I RARESULT(0)<0 D
  1. . ;
  1. . S RETURN(0)=-1_SEPSTAT_$O(RARESULT("A"),-1)_" error lines returned."
  1. . N X S X=0
  1. . F S X=$O(RARESULT(X)) Q:X="" D
  1. . . S RETURN(X)=$P(RARESULT(X),U,1)_SEPSTAT_$P(RARESULT(X),U,2,999)
  1. . . Q
  1. E D
  1. . S RETURN(0)=0_SEPSTAT_RARESULT(0)
  1. . N X S X=0
  1. . F S X=$O(RARESULT(X)) Q:X="" D
  1. . . S RETURN(X)=$TR(RARESULT(X),U,SEPOUTP)
  1. . . Q
  1. . Q
  1. Q
  1. ;+++++ Wrap calls to RPC: RAMAG EXAM ORDER & re-format output.
  1. ;
  1. ; RPC: MAGV RAD EXAM ORDER Private IA #5068
  1. ;
  1. ; Inputs:
  1. ; =======
  1. ;
  1. ; RETURN
  1. ; DFN
  1. ; RAMLC
  1. ; RADPROC
  1. ; STUDYDAT
  1. ; RACAT
  1. ; REQLOC
  1. ; REQPHYS
  1. ; REASON
  1. ; MISC
  1. ;
  1. ; Notes:
  1. ; ======
  1. ;
  1. ; The parameters are the same as those of the underlying call.
  1. ;
  1. XMORDER(RETURN,DFN,RAMLC,RADPROC,STUDYDAT,RACAT,REQLOC,REQPHYS,REASON,MISC) ;
  1. ;
  1. K RETURN
  1. N SEPSTAT,SEPOUTP,I,FMDAY,MAXORDER,RAOIEN,REVERSEDAY,PROC1 D ZRUSEPIN
  1. ;
  1. ; maximum number of same procedures for same date for patient - P194 PMK/DAC 8/14/2018
  1. S MAXORDER=$P($G(^MAG(2006.1,1,"IMPORTER")),U,6)
  1. I MAXORDER="" S MAXORDER=10
  1. ;
  1. S FMDAY=$$HL7TFM^XLFDT($G(STUDYDAT))
  1. I FMDAY'>0 D Q
  1. . S RETURN(0)=-1_SEPSTAT_"1 error line returned."
  1. . S RETURN(1)=-1001_SEPSTAT_"Illegal or non-existent STUDYDAT="""_$G(STUDYDAT)_""""
  1. . Q
  1. S REVERSEDAY=9999999.9999-(FMDAY\1) ; strip the time and reverse the date
  1. S PROC1=$P(RADPROC,U,1) ; P278 DAC - RADPROC may contain optional modifiers - Set PROC1 to the procedure IEN without modifiers
  1. ;
  1. S RAOIEN=0
  1. ; P278 DAC - Use PROC1 (procedure) instead of RADPROC (procudure + optional modifiers)
  1. F I=1:1:MAXORDER S RAOIEN=$O(^RAO(75.1,"AP",DFN,PROC1,REVERSEDAY,RAOIEN)) Q:'RAOIEN
  1. I RAOIEN D Q
  1. . S RETURN(0)=-1_SEPSTAT_"1 error line returned."
  1. . S RETURN(1)=-1000_SEPSTAT_"Order already on file with IEN="_RAOIEN
  1. . Q
  1. ;
  1. ;--- Private IA #5068.
  1. D ORDER^RAMAGRP1(.ORDINFO,DFN,RAMLC,RADPROC,STUDYDAT,RACAT,REQLOC,REQPHYS,REASON,.MISC)
  1. ;
  1. ;--- Re-format error output or return new IEN in RAD/NUC MED ORDERS File (#75.1)
  1. I ORDINFO(0)<0 D K ORDINFO
  1. . ;
  1. . S RETURN(0)=-1_SEPSTAT_$O(ORDINFO("A"),-1)_" error lines returned."
  1. . N X S X=0 F S X=$O(ORDINFO(X)) Q:X="" D
  1. . . ;
  1. . . S RETURN(X)=$P(ORDINFO(X),U,1)_SEPSTAT_$P(ORDINFO(X),U,2,999)
  1. . . Q
  1. . Q
  1. E S RETURN(0)=ORDINFO(0)
  1. K ORDINFO
  1. Q
  1. ;
  1. ;+++++ Wrap calls to RPC: RAMAG EXAM REGISTER & re-format output.
  1. ;
  1. ; RPC: MAGV RAD EXAM REGISTER Private IA #5069.
  1. ;
  1. ; Inputs:
  1. ; =======
  1. ;
  1. ; RETURN
  1. ; RAOIFN
  1. ; EXMDTE
  1. ; RAMSC
  1. ;
  1. ; Notes:
  1. ; ======
  1. ;
  1. ; The parameters are the same as those of the underlying call.
  1. ;
  1. XMREGSTR(RETURN,RAOIFN,EXMDTE,RAMSC) ;
  1. ;
  1. K RETURN
  1. N SEPSTAT,SEPOUTP,IMAGLOC D ZRUSEPIN
  1. N DIV S DIV=$$GETDIV()
  1. ;
  1. ; Check if imaging location is present - if not find outside imaging location for procedure and division
  1. N RODATA S RODATA=$G(^RAO(75.1,RAOIFN,0))
  1. D:$P(RODATA,U,20)=""
  1. . N LOCINFO,PROCIEN,RAMLC S PROCIEN=$P(RODATA,U,2)
  1. . D IMAGELOC(.RAMLC,PROCIEN,DIV)
  1. . S:$P(RAMLC,SEPSTAT)<0 RETURN(0)=RAMLC
  1. . Q:$G(RETURN(0))
  1. . S RAMLC=$P(RAMLC,SEPSTAT,2)
  1. . ; call the RPC to update the radiology imaging location in the radiology order file (#75.1).
  1. . D IMAGELOC^MAGDRPCB(.LOCINFO,RAOIFN,RAMLC)
  1. . I $G(LOCINFO)<0 S RETURN(0)=LOCINFO ;"-1"_SEPSTAT_"Error in rpc MAG DICOM SET IMAGING LOCATION"
  1. . Q
  1. ;
  1. ;Get imaging location IEN (#79.1)
  1. K RAMLC,PROCIEN
  1. S PROCIEN=$P(RODATA,U,2)
  1. D IMAGELOC(.RAMLC,PROCIEN,DIV)
  1. S:$P(RAMLC,SEPSTAT)<0 RETURN(0)=RAMLC
  1. Q:$G(RETURN(0))
  1. S RAMLC=$P(RAMLC,SEPSTAT,2)
  1. ;Get corresponding hospital location IEN (#44)
  1. S IMAGLOC=$$GET1^DIQ(79.1,.RAMLC,.01,"I")
  1. K RAMSC
  1. S RAMSC(1)="PRINCLIN^^"_$G(IMAGLOC)
  1. S RAMSC(2)="FLAGS^^D"
  1. ;
  1. Q:$G(RETURN(0))
  1. ;--- Private IA #5069.
  1. D REGISTER^RAMAGRP1(.RARESULT,RAOIFN,EXMDTE,.RAMSC)
  1. ;
  1. I RARESULT(0)<0 D
  1. . ;
  1. . S RETURN(0)=-1_SEPSTAT_$O(RARESULT("A"),-1)_" error lines returned."
  1. . N X S X=0 F S X=$O(RARESULT(X)) Q:X="" D
  1. . . ;
  1. . . S RETURN(X)=$P(RARESULT(X),U,1)_SEPSTAT_$P(RARESULT(X),U,2,999)
  1. . . Q
  1. E D
  1. . S RETURN(0)=0_SEPSTAT_RARESULT(0)
  1. . N X S X=0 F S X=$O(RARESULT(X)) Q:X="" D
  1. . . ;
  1. . . S RETURN(X)=$TR(RARESULT(X),U,SEPOUTP)
  1. . . Q
  1. . Q
  1. Q
  1. ;+++ Routine Utility: Initialize Separators
  1. ZRUSEPIN ;
  1. S SEPOUTP=$$OUTSEP^MAGVIM01
  1. S SEPSTAT=$$STATSEP^MAGVIM01
  1. Q
  1. ;+++ Use Alternate Division if it's available otherwise use site#
  1. GETDIV() ;
  1. N DIV
  1. S DIV=$$GET^XPAR("SYS","MAG ALTERNATE DIVISION",,"I") ; IA# 2263
  1. I DIV="" Q DUZ(2)
  1. Q DIV
  1. ;
  1. MAKELIST(RACTION,RAIMGTYP,RAMSC,MAGVUSR,MAGSITEP) ; output required fields
  1. ; Load required flags
  1. N INFO
  1. D EXMSTREQ^RAMAGRP2(.INFO,RACTION,RAIMGTYP)
  1. I INFO(0)<0 Q INFO(1)
  1. ;
  1. N TODAYHL7
  1. S TODAYHL7=$$NOW^XLFDT()\1,$E(TODAYHL7)=$E(TODAYHL7)+17
  1. ;
  1. N REQ,RADPVAL
  1. ;REQ001 - technologist
  1. S REQ(1)="TECH^1^"_MAGVUSR
  1. ;
  1. ;REQ002 - resident or staff
  1. ;REQ003 - detailed procedure - taken care of already
  1. ;
  1. ;REQ004 - film entry
  1. S RADPVAL=$$GET1^DIQ(2006.1,MAGSITEP,"RAD FILM SIZE","I")
  1. S REQ(4)="FILMSIZE^1^"_RADPVAL_U_"0"
  1. ;
  1. ;REQ005 - diagnostic code default, if not supplied by user.
  1. D:$G(RADXPRIM)=""
  1. . S RADPVAL=$$GET1^DIQ(2006.1,MAGSITEP,"RAD PRIMARY DIAGNOSTIC CODE","I")
  1. . S REQ(5)="PRIMDXCODE^^"_RADPVAL
  1. . Q
  1. ;
  1. ;REQ006 - camera / equipment / room
  1. S RADPVAL=$$GET1^DIQ(2006.1,MAGSITEP,"RAD PRIMARY CAMERA/EQUIP/RM","I")
  1. S REQ(6)="PRIMCAM^^"_RADPVAL
  1. ;
  1. ;REQ007 - reserved
  1. ;REQ008 - reserved
  1. ;REQ009 - reserved
  1. ;REQ010 - reserved
  1. ;
  1. ;REQ011 - report entered
  1. S REQ(11)="RPTDTE^^"_TODAYHL7
  1. I $G(RAMAN)=1 D MANRPRT(.RARPTXT,"R",1) ;--- Add manually entered REPORT text to the RAMSC array.
  1. I $G(RAMAN)'=1 D
  1. . I $G(RASTDRPT)="" S REQ(11,1)="REPORT^1^Electronically generated report for outside study."
  1. . I $G(RASTDRPT)'="" D STNDRPRT(RASTDRPT,"R",1) ; Add the REPORT text of a selected STANDARD REPORT to the RAMSC array.
  1. . Q
  1. ;
  1. ;--- Report can't be blank
  1. N NOREPORT S NOREPORT=0
  1. I '$D(RARPTXT),$G(RASTDRPT)="" S NOREPORT=1
  1. I '$D(RARPTXT),$G(RASTDRPT)'="",'$D(^RA(74.1,RASTDRPT,"R")) S NOREPORT=1
  1. I $D(RARPTXT),$G(RARPTXT)="",$G(RASTDRPT)="" S NOREPORT=1
  1. I NOREPORT,$G(REQ(11,1))="" S REQ(11,1)="REPORT^1^No report text"
  1. ;
  1. ;REQ012 - verified report
  1. S REQ(12)="VERDTE^^"_TODAYHL7
  1. S REQ(12,1)="RPTSTATUS^^EF"
  1. ;
  1. ;REQ013 - procedure modifiers required - previously done
  1. ;
  1. ;REQ014 - cpt modifiers
  1. S RADPVAL=$$GET1^DIQ(2006.1,MAGSITEP,"RAD CPT MODIFIERS","I")
  1. S:RADPVAL REQ(14)="CPTMODS^1^"_RADPVAL
  1. ;
  1. ;REQ015 - reserved
  1. ;
  1. ;REQ016 - impression
  1. I $G(RAMAN)=1 D MANRPRT(.RAIMPRS,"I",1) ;--- Add manually entered impression text to the RAMSC array.
  1. I $G(RAMAN)'=1 D
  1. . I $G(RASTDRPT)="" S REQ(16)="IMPRESSION^1^Electronically generated report for outside study."
  1. . I $G(RASTDRPT)'="" D STNDRPRT(RASTDRPT,"I",1) ; Add the IMPRESSION text of a selected STANDARD REPORT to the RAMSC array.
  1. . Q
  1. ;
  1. ;--- Impression can't be blank
  1. N NOIMPR S NOIMPR=0
  1. I '$D(RAIMPRS),$G(RASTDRPT)="" S NOIMPR=1
  1. I '$D(RAIMPRS),$G(RASTDRPT)'="",'$D(^RA(74.1,RASTDRPT,"I")) S NOIMPR=1
  1. I $D(RAIMPRS),$G(RAIMPRS)="",$G(RASTDRPT)="" S NOIMPR=1
  1. I NOIMPR,$G(REQ(16))="" S REQ(16)="IMPRESSION^1^No impression text"
  1. ;
  1. N INDEX
  1. F INDEX=1:1:16 I $P(INFO(0),"^",INDEX) D
  1. . D:$D(REQ(INDEX)) OUTPUT(REQ(INDEX),.RAMSC)
  1. . D:$D(REQ(INDEX,1)) OUTPUT(REQ(INDEX,1),.RAMSC)
  1. . Q
  1. ;
  1. Q 0
  1. ;
  1. ;+++++ Add selected STANDARD REPORT text to the Miscellaneous Parameters array.
  1. ;
  1. STNDRPRT(RASTDRPT,SSCR,INDEX1) ;
  1. ;
  1. N PREFIX S PREFIX=$S(SSCR="R":"REPORT",SSCR="I":"IMPRESSION")
  1. ;
  1. N CT
  1. S CT=0 F S CT=$O(^RA(74.1,RASTDRPT,SSCR,CT)) Q:CT="" D
  1. . N RPTXT
  1. . S RPTXT=PREFIX_U_(CT+INDEX1)_U_$G(^RA(74.1,RASTDRPT,SSCR,CT,0)) D OUTPUT(RPTXT,.RAMSC)
  1. . Q
  1. Q
  1. ;
  1. ;+++++ Add manually entered REPORT/IMPRESSION text to the Miscellaneous Parameters array.
  1. ;
  1. MANRPRT(TXTLST,SSCR,INDEX1) ;
  1. ;
  1. N PREFIX S PREFIX=$S(SSCR="R":"REPORT",SSCR="I":"IMPRESSION")
  1. N CT S CT=""
  1. F S CT=$O(TXTLST(CT)) Q:CT="" D
  1. . N RPTXT
  1. . S RPTXT=PREFIX_U_(CT+INDEX1)_U_TXTLST(CT) D OUTPUT(RPTXT,.RAMSC)
  1. . Q
  1. Q
  1. ;
  1. OUTPUT(TEXT,ARRAY) ;
  1. N I
  1. S I=$O(ARRAY(""),-1)+1
  1. S ARRAY(I)=TEXT
  1. Q
  1. ;
  1. ; MAGV OUTSIDE IMAGE LOCATION
  1. ;
  1. ; Inputs:
  1. ; =======
  1. ;
  1. ; PROCIEN -- IEN of procedure in RAD/NUC MED PROCEDURES (file #71)
  1. ; DIVISION - IEN of division in INSTITUTION (file #4)
  1. ;
  1. ; Output:
  1. ; ========
  1. ;
  1. ; <0 Error message
  1. ; 0 IEN of the Outside Image Location in the IMAGE LOCATIONS (file #79.1)
  1. ;
  1. IMAGELOC(RESULT,PROCIEN,DIVISION) ;
  1. ; return the outside imaging location for a given radiology procedure and division
  1. N IEN,IMAGETYPE,SEPSTAT,SEPOUTP D ZRUSEPIN
  1. K RESULT
  1. S PROCIEN=$G(PROCIEN)
  1. I (PROCIEN'>0)!(PROCIEN'=+PROCIEN) D Q
  1. . S RESULT="-1"_SEPSTAT_"Invalid or missing Radiology Procedure pointer: """_PROCIEN_"""."
  1. . Q
  1. ;
  1. S DIVISION=$G(DIVISION)
  1. I (DIVISION'>0)!(DIVISION'=+DIVISION) D Q
  1. . S RESULT="-2"_SEPSTAT_"Invalid or missing Division pointer:"""_DIVISION_"""."
  1. . Q
  1. ;
  1. S IMAGETYPE=$$GET1^DIQ(71,PROCIEN,12,"I")
  1. I 'IMAGETYPE D Q
  1. . S RESULT="-3"_SEPSTAT_"Image Type could not be determined for Radiology Procedure pointer: """_PROCIEN_"""."
  1. . Q
  1. ;
  1. I $$GET1^DIQ(4,DIVISION,.01)="" D Q
  1. . S RESULT="-4"_SEPSTAT_"Invalid Division (Institution) pointer:"""_DIVISION_"""."
  1. . Q
  1. S IEN=$O(^MAGD(2006.5759,"D",DIVISION,IMAGETYPE,""))
  1. I IEN="" D Q
  1. . S RESULT="-5"_SEPSTAT_"Outside Imaging Location could not be determined for Division: "_DIVISION_" & Procedure: """_PROCIEN_"""."
  1. . Q
  1. S RESULT=0_SEPSTAT_$$GET1^DIQ(2006.5759,IEN,.01,"I")
  1. Q
  1. ADDROOM(INFO,RAEXAM) ; add the OUTSIDE STUDY camera equipment room to the IMAGING LOCATION
  1. ;S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM ADD CAMERA EQUIP RM","M",.INFO,RAEXAM)
  1. D ADDROOM^MAGDRPCB(.INFO,RAEXAM)
  1. Q
  1. ;