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

MAGT7MA.m

Go to the documentation of this file.
  1. MAGT7MA ;WOIFO/MLH/PMK/DAC - Telepathology - create HL7 message to DPS ;02 Jan 2018 12:58 PM
  1. ;;3.0;IMAGING;**138,173,166,183**;Mar 19, 2002;Build 11;Sep 03, 2013
  1. ;; Per VHA Directive 2004-038, 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. ; Supported IA #4716 reference ^HLOAPI function calls
  1. ; Supported IA #4717 reference ^HLOAPI1 function calls
  1. ; Supported IA #1947 reference ^LAB(60) global references
  1. ;
  1. Q
  1. ;
  1. EDIT ; main entry point to create HL7 order message for modification
  1. N RETURN
  1. S RETURN=$$BUILDHL7("EDIT")
  1. I RETURN D ERROR^MAGT7MA(RETURN,"EDIT")
  1. Q
  1. ;
  1. NEW ; entry point for to create HL7 order message for a new case
  1. N MAGNEWCASE ; cause MAGNEWCASE to be undefined (it is set to 1 in LRAPLG1)
  1. N RETURN
  1. S RETURN=$$BUILDHL7("NEW")
  1. I RETURN D ERROR^MAGT7MA(RETURN,"NEW")
  1. Q
  1. ;
  1. BUILDHL7(STATE) ; build the segments
  1. ; Input variables from Lab Package
  1. ; LRDFN ----- lab file (#63) patient pointer
  1. ; LRI ------- inverse date in lab file (#63)
  1. ; LRSS ------ anatomic pathology section abbreviation in lab file (#63) - CY, EM, or SP
  1. ;
  1. N ACNUMB ; -- Accession Number (order number, not specimen number)
  1. N COMPLETED ; date the report was completed
  1. N DFN ; ----- local copy of DFN obtained from file #63 using LRDFN
  1. N FILE ; ---- LAB DATA subfile numbers and other info
  1. N MSHELTS ; - HL7 element array for the message header
  1. N ERRMSG ; -- error message returned from called HLO modules
  1. N MSG ; ----- HLO HL7 message pointer
  1. N IENS ; ---- subscripts to lab patient record
  1. N RELEASED ;- date/time the report was released
  1. N SEGNAME ; - segment names to be created
  1. N SEGELTS ; - HL7 element array for a single segment
  1. N SETID ; --- counters used for message segments
  1. N LABDATA ; - array to hold the data for GETS^DIQ call
  1. N ERROR ; --- error variable for GETS^DIQ call
  1. ;
  1. N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
  1. ;
  1. I $$SENDHL7()'="YES" Q ERRSTAT ; don't send the HL7 if switch isn't "YES"
  1. ;
  1. ; is this a new case? MAGNEWCASE set in LRAPLG1 before call to MAGTP005.
  1. I $G(MAGNEWCASE)=1 Q ERRSTAT ; ignore the first call for a new case
  1. ;
  1. I $G(LRDFN)="" Q ERRSTAT ; P173 no/null LRDFN - just quit
  1. I $G(LRI)="" Q ERRSTAT ; P173 no/null LRI - just quit
  1. I $G(LRSS)="AU" Q ERRSTAT ; autopsy (not supported) - just quit
  1. ;
  1. I $$GET1^DIQ(63,LRDFN,.02)'="PATIENT" Q ERRSTAT ; not in PATIENT file (#2)
  1. S DFN=$$GET1^DIQ(63,LRDFN,.03,"I")
  1. I 'DFN Q ERRSTAT ; P173 Patient DFN not defined in LAB DATA (#63) file for LRDFN
  1. ;
  1. S MSHELTS("EVENT")="O21"
  1. S MSHELTS("MESSAGE STRUCTURE")="OML_O21"
  1. S MSHELTS("MESSAGE TYPE")="OML"
  1. S MSHELTS("VERSION")="2.5.1"
  1. S MSHELTS("COUNTRY")="USA"
  1. ;
  1. I '$$NEWMSG^HLOAPI(.MSHELTS,.MSG,.ERRMSG) S ERRSTAT="-2`HLO MESSAGE INITIALIZATION ERROR ("_ERRMSG_")" Q ERRSTAT
  1. ;
  1. ; get FILE information
  1. S ERRSTAT=$$GETFILE^MAGT7MA(LRSS) ; set FILE value
  1. Q:ERRSTAT ERRSTAT ; quit and return the error
  1. ;
  1. S IENS=LRI_","_LRDFN_","
  1. S LABDATA=$NA(^TMP("MAG",$J,"LABDATA"))
  1. K @LABDATA
  1. D GETS^DIQ(FILE(0),IENS,"**","I",LABDATA,"ERROR")
  1. I $D(ERROR) D Q "-1`ERROR IN GETS^DIQ CALL" ; ignore this error
  1. . N VARS
  1. . S VARS="ERROR^FILE(0)^IENS"
  1. . D ERROR^MAGT7MA("-2`ERROR IN GETS^DIQ CALL","BUILDHL7",VARS)
  1. . Q
  1. S ACNUMB=$G(@LABDATA@(FILE(0),IENS,.06,"I"))
  1. I ACNUMB="" Q "-2`Case not defined in LAB DATA (#63) file for """_LRSS_""" for IENS: """_IENS_""""
  1. ;
  1. ; lookup case in MAG PATH CASELIST file(#2005.42) -- PMK P183 5/19/17
  1. I $$TELEPATH^MAGTP005()="YES",'$D(^MAG(2005.42,"B",ACNUMB)) Q 0 ; not an error, just skip the old case
  1. ;
  1. I STATE'="NEW" D
  1. . S COMPLETED=$$GET1^DIQ(FILE(0),IENS,.03,"I") ; date report completed
  1. . I COMPLETED S STATE="COMPLETED"
  1. . ;
  1. . S RELEASED=$$GET1^DIQ(FILE(0),IENS,.11,"I") ; date/time report released
  1. . I RELEASED D ; change status of case in MAG PATH CASELIST (#2005.42)
  1. . . D STATUPDT^MAGTP005(ACNUMB,"READ")
  1. . . Q
  1. . I STATE="CANCELLED" D
  1. . . ; remove the case from the MAG PATH CASELIST (#2005.42) file
  1. . . D CANCEL^MAGTP005(ACNUMB)
  1. . . Q
  1. . Q
  1. ;
  1. D:'ERRSTAT ; build segments if no error from previous call
  1. . F SEGNAME="PID","PV1","ORC","TQ1","OBR","NTE","TXT","SPM","IPC" D Q:ERRSTAT
  1. . . S ERRSTAT=$$SEGADD^MAGT7S(.MSG,.FILE,LABDATA,STATE,SEGNAME,DFN,LRDFN,LRSS,LRI,IENS,ACNUMB) Q:ERRSTAT
  1. . . Q
  1. . Q
  1. D:'ERRSTAT
  1. . N DIC,DO,HL7SUBLIST,MESSAGES,PARMS,SUCCESS,X,Y
  1. . ;
  1. . ; send the message via subscription list - P183 PMK 3/9/17
  1. . S DIC=779.4,DIC(0)="BX",X="MAGD PATHOLOGY" D ^DIC
  1. . S HL7SUBLIST=$P(Y,"^",1) ; Y should equal "<ien>^MAGD PATHOLOGY"
  1. . S PARMS("SENDING APPLICATION")="MAG TELEPATHOLOGY"
  1. . S PARMS("SUBSCRIPTION IEN")=HL7SUBLIST
  1. . ; the HLO private queue name is the name of the subscription list
  1. . S PARMS("QUEUE")=$E($$GET1^DIQ(779.4,HL7SUBLIST,.01),1,20) ; private queue, 20 char max.
  1. . S SUCCESS=$$SENDSUB^HLOAPI1(.MSG,.PARMS,.MESSAGES)
  1. . I 'SUCCESS D
  1. . . S ERRSTAT="-99`HLO MESSAGE QUEUEING ERROR"
  1. . . Q
  1. . E D ; send this to the DICOM Gateway
  1. . . N FMDATE ;-- fileman date
  1. . . N FMDATETM ; fileman date/time
  1. . . N HLMSTATE ; HLO parameters used in OUTPUT^MAGDHOW2
  1. . . N MSGTYPE ;- HL7 message type
  1. . . S FMDATETM=$$NOW^XLFDT(),FMDATE=FMDATETM\1
  1. . . M HLMSTATE=MSG S MSGTYPE="OML"
  1. . . D OUTPUT^MAGDHOW2
  1. . . Q
  1. . Q
  1. K @LABDATA
  1. Q ERRSTAT
  1. ;
  1. GETFILE(LRSS) ; get FILE information
  1. N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
  1. N IEN ; file 60 internal enter number
  1. ;
  1. K FILE
  1. I LRSS="CY" D
  1. . S FILE("NAME")="CYTOPATHOLOGY"
  1. . S FILE(0)=63.09
  1. . S FILE("FIELD")=9
  1. . S FILE("ORDERED TEST")=63.51
  1. . S FILE("SPECIMEN")=63.902
  1. . S FILE("SPECIMEN","SMEAR PREP")=63.9121
  1. . S FILE("SPECIMEN","SMEAR PREP","STAIN/PROCEDURE")=63.9122
  1. . S FILE("SPECIMEN","CELL BLOCK")=63.922
  1. . S FILE("SPECIMEN","CELL BLOCK","CELL BLOCK STAIN")=63.923
  1. . S FILE("SPECIMEN","MEMBRANE FILTER")=63.924
  1. . S FILE("SPECIMEN","MEMBRANE FILTER","MEMBRANE FILTER STAIN")=63.9241
  1. . S FILE("SPECIMEN","PREPARED SLIDES")=63.9024
  1. . S FILE("SPECIMEN","PREPARED SLIDES","PREPARED SLIDES STAIN")=63.90241
  1. . S FILE("SPECIMEN","CYTOSPIN")=63.9025
  1. . S FILE("SPECIMEN","CYTOSPIN","CYTOSPIN STAIN")=63.90251
  1. . S FILE("COMMENT")=63.908
  1. . S FILE("TIU REFERENCE")=63.47
  1. . S FILE("PARENT FILE")=63.09
  1. . S FILE("PROC/EVENT")=$O(^MAG(2005.85,"B","CYTOLOGY",""))
  1. . Q
  1. E I LRSS="EM" D
  1. . S FILE("NAME")="ELECTRON MICROSCOPY"
  1. . S FILE(0)=63.02
  1. . S FILE("FIELD")=2
  1. . S FILE("ORDERED TEST")=63.52
  1. . S FILE("SPECIMEN")=63.202
  1. . S FILE("SPECIMEN","EPON BLOCK")=63.2021
  1. . S FILE("SPECIMEN","EPON BLOCK","EM PROCEDURE")=63.20211
  1. . S FILE("COMMENT")=63.208
  1. . S FILE("TIU REFERENCE")=63.49
  1. . S FILE("PARENT FILE")=63.02
  1. . S FILE("PROC/EVENT")=$O(^MAG(2005.85,"B","ELECTRON MICROSCOPY",""))
  1. . Q
  1. E I LRSS="SP" D
  1. . S FILE("NAME")="SURGICAL PATHOLOGY"
  1. . S FILE(0)=63.08
  1. . S FILE("FIELD")=8
  1. . S FILE("ORDERED TEST")=63.53
  1. . S FILE("SPECIMEN")=63.812
  1. . S FILE("SPECIMEN","PARAFFIN BLOCK")=63.8121
  1. . S FILE("SPECIMEN","PARAFFIN BLOCK","STAIN/PROCEDURE")=63.8122
  1. . S FILE("SPECIMEN","PLASTIC BLOCK")=63.822
  1. . S FILE("SPECIMEN","PLASTIC BLOCK","PLASTIC STAIN/PROCEDURE")=63.823
  1. . S FILE("SPECIMEN","FROZEN TISSUE BLOCK")=63.824
  1. . S FILE("SPECIMEN","FROZEN TISSUE BLOCK","STAIN/PROCEDURE")=63.825
  1. . S FILE("COMMENT")=63.98
  1. . S FILE("TIU REFERENCE")=63.19
  1. . S FILE("PARENT FILE")=63.08
  1. . S FILE("PROC/EVENT")=$O(^MAG(2005.85,"B","SURGICAL PATHOLOGY",""))
  1. . Q
  1. E S ERRSTAT="-1`Illegal AP section abbreviation: """_LRSS_""""
  1. ;
  1. D:'ERRSTAT ; get default procedure name, first one if multiple
  1. . N X
  1. . S IEN=0 F S IEN=$O(^LAB(60,IEN)) Q:'IEN D Q:$D(FILE("PROCEDURE NAME"))
  1. . . S X=$G(^LAB(60,IEN,0))
  1. . . Q:$P(X,"^",4)'=LRSS ; SUBSCRIPT needs to match CY, EM, or SP
  1. . . Q:"IBO"'[$P(X,"^",3) ; TYPE needs to be INPUT, OUTPUT, or BOTH
  1. . . Q:'$P($G(^LAB(60,IEN,64)),"^",1) ; needs to have a VA National Lab Code (file #64)
  1. . . S FILE("PROCEDURE NAME")=$$GET1^DIQ(60,IEN,.01)
  1. . . S FILE("PROCEDURE IEN")=IEN
  1. . . Q
  1. . I '$D(FILE("PROCEDURE NAME")) D
  1. . . S ERRSTAT="-53`No test found in LAB(60) file for LRSS="""_LRSS_""""
  1. . . Q
  1. . Q
  1. ;
  1. Q ERRSTAT
  1. ;
  1. REPORT ; main entry point - create HL7 order message for an electronically signed report
  1. Q:'$G(LRDFN)
  1. N LRI,PARENTFILE,RETURN,X
  1. S LRI=$G(LRDATA(1)) Q:LRI="" ;P173
  1. S PARENTFILE=$G(LRSF) Q:PARENTFILE="" ;P173
  1. S X=$$NEWTIU(LRSS,PARENTFILE,LRDFN,LRI)
  1. S RETURN=$$BUILDHL7^MAGT7MA("COMPLETED")
  1. I RETURN D ERROR^MAGT7MA(RETURN,"REPORT")
  1. Q
  1. ;
  1. CANCEL ; main entry point - create HL7 order message for a cancelled order
  1. N RETURN
  1. S RETURN=$$BUILDHL7^MAGT7MA("CANCELLED")
  1. I RETURN D ERROR^MAGT7MA(RETURN,"CANCEL")
  1. Q
  1. ;
  1. NEWTIU(LRSS,PARENTFILE,LRDFN,LRI) ; check if this is a TIU note to be linked to an image group
  1. ; if so, create the cross-linkages now
  1. N CROSSREF,D0,FILEDATA,HIT,MAGGP,MAGIEN,NIMAGE,TIUIEN
  1. S HIT=0
  1. S D0=""
  1. F S D0=$O(^MAG(2006.5838,"C",PARENTFILE,LRDFN,LRI,D0)) Q:'D0 D
  1. . S MAGGP=$P($G(^MAG(2006.5838,D0,0)),"^",4) Q:'MAGGP
  1. . S TIUIEN=$$TIUIEN(LRSS,LRDFN,LRI) Q:'TIUIEN
  1. . S $P(^MAG(2005,MAGGP,2),"^",6,7)="8925^"_TIUIEN
  1. . D TIUXLINK ; create the cross-linkages to TIU
  1. . ; update the parent file pointers for all the images
  1. . S CROSSREF="8925^"_TIUIEN_"^"_FILEDATA("PARENT FILE PTR")
  1. . S NIMAGE=0 F S NIMAGE=$O(^MAG(2005,MAGGP,1,NIMAGE)) Q:'NIMAGE D
  1. . . S MAGIEN=$P(^MAG(2005,MAGGP,1,NIMAGE,0),"^")
  1. . . S $P(^MAG(2005,MAGIEN,2),"^",6,8)=CROSSREF
  1. . . Q
  1. . ; remove entries from ^MAG(2006.5838) & decrement the counter
  1. . K ^MAG(2006.5838,D0),^MAG(2006.5838,"C",PARENTFILE,LRDFN,LRI,D0)
  1. . L +^MAG(2006.5838):1E9 ; Background process MUST wait
  1. . S $P(^MAG(2006.5838,0),"^",4)=$P(^MAG(2006.5838,0),"^",4)-1
  1. . L -^MAG(2006.5838)
  1. . S HIT=1
  1. . Q
  1. Q HIT
  1. ;
  1. N TIUXDIEN
  1. D PUTIMAGE^TIUSRVPL(.TIUXDIEN,TIUIEN,MAGGP) ; DBIA #3566
  1. I TIUXDIEN D
  1. . S FILEDATA("PARENT FILE PTR")=TIUXDIEN
  1. . S $P(^MAG(2005,MAGGP,2),"^",8)=TIUXDIEN
  1. . Q
  1. E D ; fatal error
  1. . N MSG
  1. . S MSG(1)="ERROR ASSOCIATING WITH TIU EXTERNAL DATA LINK (file 8925.91): "
  1. . S MSG(2)=$P(TIUXDIEN,"^",2,999)
  1. . S MSG(3)=" for lookup in DICOM LAB TEMP LIST (file 2006.5838)." ;P173
  1. . D ERR^MAGGTERR ;P173
  1. . Q
  1. Q
  1. ;
  1. TIUIEN(LRSS,LRDFN,LRI) ; lookup TIU reference
  1. N FILE ; ---- LAB DATA subfile numbers and other info
  1. N LABDATA ;-- array to hold LAB DATA (#63)
  1. N TIUIEN ;--- TIU file 8925 IEN value
  1. N TIUREF ;--- Anatomic Pathology reference file
  1. N ERROR ;---- error return for GETS^DIQ Filename API call
  1. N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to repor
  1. ;
  1. S ERRSTAT=$$GETFILE^MAGT7MA(LRSS)
  1. I ERRSTAT<0 D Q 0
  1. . D ERROR^MAGT7MA(ERRSTAT,"TIUIEN")
  1. . Q
  1. ;
  1. S TIUREF=FILE("TIU REFERENCE")
  1. ; look up TIU note
  1. S IENS="1,"_LRI_","_LRDFN_","
  1. D GETS^DIQ(TIUREF,IENS,"**","I","LABDATA","ERROR")
  1. I $D(ERROR) D Q 0
  1. . N VARS
  1. . S VARS="ERROR^TIUREF^IENS"
  1. . D ERROR^MAGT7MA("-2`ERROR IN GETS^DIQ CALL","TIUIEN",VARS)
  1. . Q
  1. S TIUIEN=$G(LABDATA(TIUREF,IENS,1,"I"))
  1. Q TIUIEN
  1. ;
  1. ERROR(RETURN,TAG,VARS) ; log the error to the user's email
  1. N I,SUBJECT,MSG,VARIABLES
  1. S SUBJECT="Anatomic Pathology HL7 Generation"
  1. S MSG(1)="An error occurred in "_TAG_"^"_$T(+0)_" when trying to create and/or"
  1. S MSG(2)="send an HL7 message. The error message is as follows:"
  1. S MSG(3)=""""_RETURN_""""
  1. S MSG(4)=""
  1. S MSG(5)="Please notify your local IRM Staff."
  1. S VARIABLES("LRDFN")=""
  1. S VARIABLES("LRI")=""
  1. S VARIABLES("LRSS")=""
  1. I $G(VARS)'="" F I=1:1:$L(VARS,"^") S VARIABLES($P(VARS,"^",I))=""
  1. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
  1. Q
  1. ;
  1. SENDHL7() ; P166 DAC - Get value of SEND ANATOMIC PATHOLOGY HL7 switch
  1. N IENS
  1. S IENS=$O(^MAG(2006.1,"B",DUZ(2),""))_","
  1. Q $$GET1^DIQ(2006.1,IENS,204)