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

MAGDHOW2.m

Go to the documentation of this file. 
  1. MAGDHOW2 ;WOIFO/PMK,DAC,JSL - Capture Consult/GMRC data ;22 Jul 2021 10:13 AM
  1.  ;;3.0;IMAGING;**138,156,183,208,301**;Mar 19, 2002;Build 6;Nov 16, 2014
  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 #2056 reference $$GET1^DIQ function call
  1.  ; Supported IA #4716 reference ^HLOAPI function calls
  1.  ; Supported IA #4717 reference ^HLOAPI1 function calls
  1.  ; Supported IA #5886 reference ^HLOPBLD1 function calls
  1.  ; Supported IA #6103 reference for reading ^HLA
  1.  ; Supported IA #6925 to read HLO SUBSCRIPTION REGISTRY (#779.4)
  1.  ; Supported IA #10103 reference $$DT^XLFDT function call
  1.  ; Supported IA #10103 reference $$NOW^XLFDT function call
  1.  ;
  1.  ;
  1. MESSAGE(SERVICE) ; invoked from ^MAGDHOW1
  1.  N CONSULT,ERROR,HL7IEN,HLMSTATE,I,MESSAGES,MSG,NEXT,OBXSEGNO
  1.  N PRIORITY,SAVEORCSEG,SUCCESS,TIUDOC,X,Y
  1.  ;
  1.  ; P156 DAC - Support for HL7 result messages
  1.  I MSGTYPE="ORM" D  ; order entry message
  1.  . D INIT(MSGTYPE,"O01") ; start building a new HL7 order entry message
  1.  . Q
  1.  E  D  ; result message
  1.  . D INIT(MSGTYPE,"R01") ; start building a new HL7 result message
  1.  . Q
  1.  ;
  1.  D PIDPV1^MAGDHOW2(.HLMSTATE,DFN)
  1.  D ORC^MAGDHOW3(.HLMSTATE,GMRCIEN,.SAVEORCSEG)
  1.  D OBR^MAGDHOW4(.HLMSTATE,GMRCIEN,.SAVEORCSEG,SERVICE)
  1.  D ZDS^MAGDHOW5(.HLMSTATE,GMRCIEN)
  1.  D OBX^MAGDHOW5(.HLMSTATE,GMRCIEN)
  1.  ;
  1.  ; send the message via subscription list
  1.  S PARMS("SENDING APPLICATION")="MAGD SENDER"
  1.  S PARMS("SUBSCRIPTION IEN")=HL7SUBLIST
  1.  ; the HLO private queue name is the name of the subscription list
  1.  S PARMS("QUEUE")=$$GET1^DIQ(779.4,HL7SUBLIST,.01) ; private queue
  1.  S SUCCESS=$$SENDSUB^HLOAPI1(.HLMSTATE,.PARMS,.MESSAGES)
  1.  I 'SUCCESS D
  1.  . N MSG,SUBJECT,VARIABLES
  1.  . S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
  1.  . S MSG(1)="An error occurred in "_$T(+0)_" where the SENDSUB^HLOAPI1"
  1.  . S MSG(2)="invocation failed.  The error message is as follows:"
  1.  . S MSG(3)=""""_SUCCESS_""""
  1.  . S VARIABLES("HLMSTATE")=""
  1.  . S VARIABLES("PARMS")=""
  1.  . S VARIABLES("MESSAGES")=""
  1.  . D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
  1.  . Q
  1.  D OUTPUT ; send to DICOM Gateway
  1.  ;
  1.  Q
  1.  ;
  1. INIT(MSGTYPE,EVENT) ; start building a new HL7 message
  1.  N ERROR,PARMS,SUCCESS
  1.  S PARMS("COUNTRY")="USA"
  1.  S PARMS("CONTINUATION POINTER")=0
  1.  S PARMS("EVENT")=EVENT
  1.  S PARMS("FIELD SEPARATOR")="|"
  1.  S PARMS("ENCODING CHARACTERS")="^~\&"
  1.  S PARMS("MESSAGE STRUCTURE")=MSGTYPE_"_"_EVENT
  1.  S PARMS("MESSAGE TYPE")=MSGTYPE
  1.  S PARMS("PROCESSING MODE")="T"
  1.  S PARMS("VERSION")=2.4
  1.  S SUCCESS=$$NEWMSG^HLOAPI(.PARMS,.HLMSTATE,.ERROR)
  1.  I 'SUCCESS D
  1.  . N MSG,SUBJECT,VARIABLES
  1.  . S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
  1.  . S MSG(1)="An error occurred in INIT^"_$T(+0)_" where the NEWMSG^HLOAPI"
  1.  . S MSG(2)="invocation failed.  The error message is as follows:"
  1.  . S MSG(3)=""""_SUCCESS_""""
  1.  . S VARIABLES("PARMS")=""
  1.  . S VARIABLES("HLMSTATE")=""
  1.  . S VARIABLES("ERROR")=""
  1.  . D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
  1.  . Q
  1.  Q
  1.  ;
  1. PIDPV1(HLMSTATE,DFN) ; build the PID and PV1 segments
  1.  ; Also invoked by ^MAGT7S to build these segments for Anatomic Pathology - P183 PMK 3/7/17
  1.  N HL,HL7ARRAY,HL7SEG,HLECH,HLFS,HLQ,NUL,PID,PV1,SUCCESS
  1.  S HLECH=HLMSTATE("HDR","ENCODING CHARACTERS")
  1.  S HLFS=HLMSTATE("HDR","FIELD SEPARATOR")
  1.  S HLQ="""""" ; null fields are set as "", as opposed to being empty
  1.  S HL7ARRAY(1,9,1,1,1)=""
  1.  S HL7ARRAY(1,0)="MSH"
  1.  S HL7ARRAY(1,1,1,1,1)=HLFS
  1.  S HL7ARRAY(1,2,1,1,1)=HLECH
  1.  D PID^MAGDHLS(DFN,"HL7ARRAY")
  1.  D PV1^MAGDHLS(DFN,"",DT,"HL7ARRAY")
  1.  ;
  1.  S NUL=$$MAKE^MAG7UM("HL7ARRAY","HL7SEG")
  1.  S PID=HL7SEG(2)
  1.  S PV1=HL7SEG(3)
  1.  S SUCCESS=$S($T(MOVESEG^HLOAPI)'="":$$MOVESEG^HLOAPI(.HLMSTATE,PID,.ERROR),1:$$MOVESEG(.HLMSTATE,PID,.ERROR))  ;In case missing HL7 patch
  1.  I 'SUCCESS D
  1.  . N MSG,SUBJECT,VARIABLES
  1.  . S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
  1.  . S MSG(1)="An error occurred in PIDPV1^"_$T(+0)_" where the MOVESEG^HLOAPI invocation"
  1.  . S MSG(2)="for the PID segment failed.  The error message is as follows:"
  1.  . S MSG(3)=""""_SUCCESS_""""
  1.  . S VARIABLES("HLMSTATE")=""
  1.  . S VARIABLES("PID")=""
  1.  . S VARIABLES("ERROR")=""
  1.  . D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
  1.  . Q
  1.  S SUCCESS=$S($T(MOVESEG^HLOAPI)'="":$$MOVESEG^HLOAPI(.HLMSTATE,PV1,.ERROR),1:$$MOVESEG(.HLMSTATE,PV1,.ERROR))  ;In case missing HL7 patch
  1.  I 'SUCCESS D
  1.  . N MSG,SUBJECT,VARIABLES
  1.  . S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
  1.  . S MSG(1)="An error occurred in PIDPV1^"_$T(+0)_" where the MOVESEG^HLOAPI invocation"
  1.  . S MSG(2)="for the PV1 segment failed.  The error message is as follows:"
  1.  . S MSG(3)=""""_SUCCESS_""""
  1.  . S VARIABLES("HLMSTATE")=""
  1.  . S VARIABLES("PID")=""
  1.  . S VARIABLES("ERROR")=""
  1.  . D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
  1.  . Q
  1.  Q
  1.  ;
  1. OUTPUT ; output the messages to ^MAGDHL7
  1.  N D0,DEL,FMDATE,FMDATETIME,HLAIEN,HDR,HL7,HL7MSH,I,I1,I2,J,K,MSG,N,X,Y,Z
  1.  S HLAIEN=HLMSTATE("BODY")
  1.  S HLMSTATE("HDR","RECEIVING APPLICATION")=$G(HLMSTATE("HDR","RECEIVING APPLICATION"))  ;IHS
  1.  F I=1,2,3 S HLMSTATE("HDR","RECEIVING FACILITY",I)=$G(HLMSTATE("HDR","RECEIVING FACILITY",I))  ;IHS
  1.  ;
  1.  ; build the MSH segment
  1.  D BUILDHDR^HLOPBLD1(.HLMSTATE,"MSH",.HL7MSH)
  1.  ;
  1.  ; copy the two lines of the MSH segment to the HL7 array
  1.  S HL7MSH=HL7MSH(1)_HL7MSH(2) ; MSH segment
  1.  S DEL=HLMSTATE("HDR","FIELD SEPARATOR")
  1.  S $P(HL7MSH,DEL,5)="MAGD-CONSULT" ; receiving application
  1.  S $P(HL7MSH,DEL,6)="" ; receiving facility
  1.  S J=1,HL7(J)=HL7MSH
  1.  ;
  1.  ; copy the body of the message to the HL7 array
  1.  ; some of the message may be in ^HLA(HLAIEN) - if so, get it first
  1.  ;
  1.  I HLAIEN D  ; get the segments that are saved in ^HLA(HLAIEN)
  1.  . ; note: segments are separated by a blank line
  1.  . S I=0 F  S I=$O(^HLA(HLAIEN,1,I)) Q:I=""  D
  1.  . . S X=$G(^HLA(HLAIEN,1,I,0))
  1.  . . I X'="" S J=J+1,HL7(J)=X
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ; get the remainder of the messages from memory
  1.  ; note: segments are separated by a blank line
  1.  S I1=0 F  S I1=$O(HLMSTATE("UNSTORED LINES",1,I1)) Q:I1=""  D
  1.  . S I2=0 F  S I2=$O(HLMSTATE("UNSTORED LINES",1,I1,I2)) Q:I2=""  D
  1.  . . S X=HLMSTATE("UNSTORED LINES",1,I1,I2)
  1.  . . I X'="" S J=J+1,HL7(J)=X
  1.  . . Q
  1.  . Q
  1.  ;
  1.  S N=J ; number of HL7 record lines
  1.  S DEL=$E(HL7(1),4) ; field separator
  1.  S $P(HL7(1),DEL,5,6)="MAGD-CONSULT"_DEL ; receiving application
  1.  ;
  1.  ; get the next node in the ^MAGDHL7 global
  1.  S FMDATETIME=$$NOW^XLFDT,FMDATE=$$DT^XLFDT
  1.  L +^MAGDHL7(2006.5,0):1E9 ; Background process MUST wait
  1.  S D0=$O(^MAGDHL7(2006.5," "),-1)+1
  1.  S ^MAGDHL7(2006.5,D0,0)=FMDATE
  1.  S:FMDATE'="" ^MAGDHL7(2006.5,"B",FMDATE,D0)=""
  1.  S HDR=$G(^MAGDHL7(2006.5,0))
  1.  S ^MAGDHL7(2006.5,0)="PACS MESSAGE^2006.5D^"_D0_"^"_($P(HDR,"^",4)+1)
  1.  L -^MAGDHL7(2006.5,0)
  1.  ;
  1.  ; copy the message to the ^MAGDHL7 global, field by field
  1.  S ^MAGDHL7(2006.5,D0,0)=FMDATE_"^"_MSGTYPE_"^"_FMDATETIME
  1.  S (I,J)=0  F I=1:1:N S X=HL7(I) D
  1.  . S Y=$P(X,DEL)
  1.  . F K=2:1:$L(X,DEL) D  ; copy the lines to the ^MAGDHL7 global
  1.  . . S Z=$P(X,DEL,K)
  1.  . . I ($L(Y)+$L(Z))>200 D  ; keep lines short for the global
  1.  . . . ; output one line of a spanned record
  1.  . . . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y,Y=""
  1.  . . . Q
  1.  . . S Y=Y_DEL_$P(X,DEL,K)
  1.  . . Q
  1.  . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y
  1.  . Q
  1.  S:FMDATETIME'="" ^MAGDHL7(2006.5,"C",FMDATETIME,D0)="" ; P183 PMK 3/6/17
  1.  ; The next line must be last, since WAIT^MAGDHRS1
  1.  ; uses this node to determine that the entry is complete.
  1.  S ^MAGDHL7(2006.5,D0,1,0)="^^"_J_"^"_J_"^"_FMDATETIME
  1.  ;
  1.  I $G(CPINVOCATION) D OUTPUT^MAGDHOWP(N) ; copy HL7 message for clinical procedures - P208 PMK 4/12/18
  1.  Q
  1.  ;
  1.  ;**HL7 P146 routine: HLOAPI
  1. MOVESEG(HLMSTATE,SEG,ERROR) ;Adds a segment built in the 'traditional' way as an array of lines into the message.
  1.  ;;Input:
  1.  ;;  HLMSTATE() - (pass by reference, required) This array is a workspace for HLO. 
  1.  ;;  SEG() - (pass-by-reference, required) Contains the segment.  The segement.  If the segment is short enough it should consist of only SEG or SEG(1).  If longer, additional lines can be added as SEG(<n>). 
  1.  ;;
  1.  ;;Note#1:  The message control segments, including the MSH, BHS & FTS segments, are added automatically, so may not be added by MOVESEG.
  1.  ;;
  1.  ;;Output:
  1.  ;;   HLMSTATE() - (pass-by-reference, required) This array is the workspace used by HLO.
  1.  ;;  FUNCTION - returns 1 on success, 0 on failure
  1.  ;;
  1.  ;;  ERROR (optional, pass by reference) - returns an error message on failure
  1.  ;;
  1.  ;
  1.  K ERROR
  1.  N TYPE,NEWCOUNT,OLDCOUNT,TOARY
  1.  ;
  1.  S NEWCOUNT=1
  1.  I $L($G(SEG)) S TOARY(1)=SEG,NEWCOUNT=2
  1.  S OLDCOUNT=0
  1.  F  S OLDCOUNT=$O(SEG(OLDCOUNT)) Q:'OLDCOUNT  S TOARY(NEWCOUNT)=SEG(OLDCOUNT),NEWCOUNT=NEWCOUNT+1
  1.  S TYPE=$P($G(TOARY(1)),HLMSTATE("HDR","FIELD SEPARATOR")) ;segment type
  1.  ;
  1.  ;if a 'generic' app ack MSA was built, add it as the first segment before this one
  1.  I $D(HLMSTATE("MSA")) D
  1.  .I TYPE'="MSA" N TOARY S TOARY(1)=HLMSTATE("MSA") D ADDSEG^HLOMSG(.HLMSTATE,.TOARY)
  1.  .K HLMSTATE("MSA")
  1.  ;
  1.  I ($L(TYPE)'=3) S ERROR="INVALID SEGMENT TYPE" Q 0
  1.  I (TYPE="MSH")!(TYPE="BHS")!(TYPE="BTS")!(TYPE="FHS")!(TYPE="FTS") S ERROR="INVALID SEGMENT TYPE" Q 0
  1.  I HLMSTATE("BATCH"),'HLMSTATE("BATCH","CURRENT MESSAGE") S ERROR="NO MESSAGES IN BATCH, SO SEGMENTS NOT ALLOWED" Q 0
  1.  D ADDSEG^HLOMSG(.HLMSTATE,.TOARY)
  1.  Q 1
  1.  ;