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