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

MAG7UM.m

Go to the documentation of this file.
  1. MAG7UM ;WOIFO/MLH - Imaging - HL7 - utilities - make a message from a parse tree; 05/18/2007 11:23
  1. ;;3.0;IMAGING;**11,54**;03-July-2009;;Build 1424
  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. Q
  1. ;
  1. MAKE(XTREE,XMSG) ; make a parse tree into an array of message lines
  1. ;
  1. ; INPUT: XTREE The name of the parse tree ($NA format)
  1. ; Parse tree structure:
  1. ; @XTREE@(NSEG,0) segment name
  1. ; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
  1. ; @XTREE@("B",SEGID,NSEG) null
  1. ;
  1. ; XMSG The name of a single-dimensional array to be populated
  1. ; with message lines ($NA format). This array is
  1. ; cleared on invocation.
  1. ;
  1. ; OUTPUT: XMSG The array after being populated with message lines
  1. ;
  1. N UFS,UCS,URS,UEC,USS ;---------------- HL7 delimiters (universal)
  1. N X,I ; --------------------------------- scratch var
  1. N ERR ; ------------------------------- error flag
  1. N ENC ; ------------------------------- encoding characters string
  1. N NSEG ; ------------------------------ segment number in the parse tree
  1. N NMSEG ; ----------------------------- segment number in the message
  1. N IMSG ; ------------------------------ message array index
  1. N SEG ; ------------------------------- segment data
  1. N NFLD ; ------------------------------ field number in the segment
  1. N FLD ; ------------------------------- field data
  1. ;
  1. K @XMSG ; refresh target array
  1. ; process MSH segment
  1. Q:$D(@XTREE)<10 -1 ; parse tree sent?
  1. S NSEG=$O(@XTREE@("")),NMSEG=1
  1. Q:$G(@XTREE@(NSEG,0))'="MSH" -2 ; an HL7 message?
  1. Q:$D(@XTREE@(NSEG,9,1,1,1))#10=0 -3 ; message type provided?
  1. ; get delimiters or define defaults
  1. S UFS=$G(@XTREE@(NSEG,1,1,1,1)) I $L(UFS)-1 S UFS="|"
  1. S ENC=$G(@XTREE@(NSEG,2,1,1,1)) I $L(ENC)-4 S ENC="^~\&"
  1. S UCS=$E(ENC),URS=$E(ENC,2),UEC=$E(ENC,3),USS=$E(ENC,4)
  1. I $D(@XTREE@(NSEG,3,1,1,1))#10=0 S @XTREE@(1,3,1,1,1)="VistA Imaging"
  1. S @XTREE@(NSEG,7,1,1,1)=$$NOW^XLFDT()+17000000*1000000
  1. I $D(@XTREE@(NSEG,10,1,1,1))#10=0 D
  1. . S X=""
  1. . F I=1:1:16 S X=X_$E("0123456789ABCDEF",$R(16)+1)
  1. . S @XTREE@(NSEG,10,1,1,1)=X
  1. . Q
  1. I $D(@XTREE@(NSEG,11,1,1,1))#10=0 S @XTREE@(NSEG,11,1,1,1)="D"
  1. I $D(@XTREE@(NSEG,12,1,1,1))#10=0 S @XTREE@(NSEG,12,1,1,1)="2.3.1"
  1. S SEG="MSH"_UFS_ENC
  1. S NFLD=2
  1. F S NFLD=$O(@XTREE@(NSEG,NFLD)) Q:NFLD="" D PROCFLD(XTREE,NSEG,NFLD,.SEG)
  1. S @XMSG@(NMSEG)=SEG
  1. F S NSEG=$O(@XTREE@(NSEG)) Q:'NSEG D
  1. . K SEG
  1. . S NMSEG=NMSEG+1
  1. . S NFLD=0
  1. . F S NFLD=$O(@XTREE@(NSEG,NFLD)) Q:NFLD="" D PROCFLD(XTREE,NSEG,NFLD,.SEG)
  1. . S @XMSG@(NMSEG)=$G(@XTREE@(NSEG,0))_$S($G(SEG)]"":UFS_SEG,1:"")
  1. . Q
  1. Q 0
  1. ;
  1. PROCFLD(XTREE,XNSEG,XNFLD,XSEG) ; process a field
  1. ;
  1. ; input: XTREE name of MUMPS array for parse tree ($NA format)
  1. ; XNSEG segment number for parse tree
  1. ; XNFLD field number for parse tree
  1. ; .XSEG segment before addition of field
  1. ;
  1. ; output: .XSEG segment after addition of field
  1. ;
  1. N NREP ; ---- repetition (occurrence) number
  1. N REP ; ----- repetition data
  1. N NCMP ; ---- component number
  1. N CMP ; ----- component data
  1. N NSCM ; ---- subcomponent number
  1. N SCM ; ----- subcomponent data
  1. N FLD ; ----- field data
  1. ;
  1. S NREP=""
  1. F S NREP=$O(@XTREE@(XNSEG,XNFLD,NREP)) Q:NREP="" D
  1. . K REP
  1. . S NCMP=""
  1. . F S NCMP=$O(@XTREE@(XNSEG,XNFLD,NREP,NCMP)) Q:NCMP="" D
  1. . . K CMP
  1. . . S NSCM=""
  1. . . F S NSCM=$O(@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)) Q:NSCM="" D
  1. . . . S SCM=@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)
  1. . . . S $P(CMP,USS,NSCM)=$$ESC(.SCM)
  1. . . . Q
  1. . . S $P(REP,UCS,NCMP)=CMP
  1. . . Q
  1. . S $P(FLD,URS,NREP)=REP
  1. . Q
  1. S $P(XSEG,UFS,NFLD)=$G(FLD)
  1. Q
  1. ;
  1. ESC(XDTA) ;apply escape sequence to data
  1. ; Insert an intermediate token, then expand the intermediate token to
  1. ; the real escape sequence. (We have to do 2 steps because the escape
  1. ; sequence uses the escape character.)
  1. F Q:XDTA'[UFS S XDTA=$P(XDTA,UFS)_$C(1)_$P(XDTA,UFS,2,999)
  1. F Q:XDTA'[UCS S XDTA=$P(XDTA,UCS)_$C(2)_$P(XDTA,UCS,2,999)
  1. F Q:XDTA'[URS S XDTA=$P(XDTA,URS)_$C(3)_$P(XDTA,URS,2,999)
  1. F Q:XDTA'[UEC S XDTA=$P(XDTA,UEC)_$C(4)_$P(XDTA,UEC,2,999)
  1. F Q:XDTA'[USS S XDTA=$P(XDTA,USS)_$C(5)_$P(XDTA,USS,2,999)
  1. F Q:XDTA'[$C(1) S XDTA=$P(XDTA,$C(1))_UEC_"F"_UEC_$P(XDTA,$C(1),2,999)
  1. F Q:XDTA'[$C(2) S XDTA=$P(XDTA,$C(2))_UEC_"S"_UEC_$P(XDTA,$C(2),2,999)
  1. F Q:XDTA'[$C(3) S XDTA=$P(XDTA,$C(3))_UEC_"R"_UEC_$P(XDTA,$C(3),2,999)
  1. F Q:XDTA'[$C(4) S XDTA=$P(XDTA,$C(4))_UEC_"E"_UEC_$P(XDTA,$C(4),2,999)
  1. F Q:XDTA'[$C(5) S XDTA=$P(XDTA,$C(5))_UEC_"T"_UEC_$P(XDTA,$C(5),2,999)
  1. Q XDTA
  1. ;