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