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. 
MAGVIM05 ;WOIFO/MAT,BT,JL,DAC,PMK - Utilities for RPC calls for DICOM file processing ;09 Sep 2021 3:13 PM

 ;;3.0;IMAGING;**118,138,164,166,194,278**;Mar 19, 2002;Build 138

 ;; 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)

 ;           ---- Next two are IEN(s) of entries in the DIAGNOSTIC CODES file(#78.3)

 ; [RADXPRIM]  .. Primary Diagnostic Code --> RAMISC Param PRIMDXCODE

 ; [RADXSCND] ... List of Secondary Diagnostic Codes --> RAMISC Param SECDXCODE

 ;  

 ; 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

 ;

 ;--- 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

 ; 

 ;--- 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

 ;

 ; 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,DUZ(2))

 . 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,DUZ(2))

 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

 ;

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(RASTDRPT)="" D

 . S REQ(11,1)="REPORT^1^Electronically generated report for outside study."

 . Q

 ;--- Add the REPORT text of a selected STANDARD REPORT to the RAMSC array.

 E  D STNDRPRT(RASTDRPT,"R",1)

 ;

 ;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(RASTDRPT)="" D

 . S REQ(16)="IMPRESSION^1^Electronically generated report for outside study."

 . Q

 ;--- Add the IMPRESSION text of a selected STANDARD REPORT to the RAMSC array.

 E  D STNDRPRT(RASTDRPT,"I",1)

 ;

 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

 ;

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