- MAG7UM ;WOIFO/MLH - Imaging - HL7 - utilities - make a message from a parse tree; 05/18/2007 11:23
- ;;3.0;IMAGING;**11,54**;03-July-2009;;Build 1424
- ;; 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. |
- ;; +---------------------------------------------------------------+
- ;;
- Q
- ;
- MAKE(XTREE,XMSG) ; make a parse tree into an array of message lines
- ;
- ; INPUT: XTREE The name of the parse tree ($NA format)
- ; Parse tree structure:
- ; @XTREE@(NSEG,0) segment name
- ; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
- ; @XTREE@("B",SEGID,NSEG) null
- ;
- ; XMSG The name of a single-dimensional array to be populated
- ; with message lines ($NA format). This array is
- ; cleared on invocation.
- ;
- ; OUTPUT: XMSG The array after being populated with message lines
- ;
- N UFS,UCS,URS,UEC,USS ;---------------- HL7 delimiters (universal)
- N X,I ; --------------------------------- scratch var
- N ERR ; ------------------------------- error flag
- N ENC ; ------------------------------- encoding characters string
- N NSEG ; ------------------------------ segment number in the parse tree
- N NMSEG ; ----------------------------- segment number in the message
- N IMSG ; ------------------------------ message array index
- N SEG ; ------------------------------- segment data
- N NFLD ; ------------------------------ field number in the segment
- N FLD ; ------------------------------- field data
- ;
- K @XMSG ; refresh target array
- ; process MSH segment
- Q:$D(@XTREE)<10 -1 ; parse tree sent?
- S NSEG=$O(@XTREE@("")),NMSEG=1
- Q:$G(@XTREE@(NSEG,0))'="MSH" -2 ; an HL7 message?
- Q:$D(@XTREE@(NSEG,9,1,1,1))#10=0 -3 ; message type provided?
- ; get delimiters or define defaults
- S UFS=$G(@XTREE@(NSEG,1,1,1,1)) I $L(UFS)-1 S UFS="|"
- S ENC=$G(@XTREE@(NSEG,2,1,1,1)) I $L(ENC)-4 S ENC="^~\&"
- S UCS=$E(ENC),URS=$E(ENC,2),UEC=$E(ENC,3),USS=$E(ENC,4)
- I $D(@XTREE@(NSEG,3,1,1,1))#10=0 S @XTREE@(1,3,1,1,1)="VistA Imaging"
- S @XTREE@(NSEG,7,1,1,1)=$$NOW^XLFDT()+17000000*1000000
- I $D(@XTREE@(NSEG,10,1,1,1))#10=0 D
- . S X=""
- . F I=1:1:16 S X=X_$E("0123456789ABCDEF",$R(16)+1)
- . S @XTREE@(NSEG,10,1,1,1)=X
- . Q
- I $D(@XTREE@(NSEG,11,1,1,1))#10=0 S @XTREE@(NSEG,11,1,1,1)="D"
- I $D(@XTREE@(NSEG,12,1,1,1))#10=0 S @XTREE@(NSEG,12,1,1,1)="2.3.1"
- S SEG="MSH"_UFS_ENC
- S NFLD=2
- F S NFLD=$O(@XTREE@(NSEG,NFLD)) Q:NFLD="" D PROCFLD(XTREE,NSEG,NFLD,.SEG)
- S @XMSG@(NMSEG)=SEG
- F S NSEG=$O(@XTREE@(NSEG)) Q:'NSEG D
- . K SEG
- . S NMSEG=NMSEG+1
- . S NFLD=0
- . F S NFLD=$O(@XTREE@(NSEG,NFLD)) Q:NFLD="" D PROCFLD(XTREE,NSEG,NFLD,.SEG)
- . S @XMSG@(NMSEG)=$G(@XTREE@(NSEG,0))_$S($G(SEG)]"":UFS_SEG,1:"")
- . Q
- Q 0
- ;
- PROCFLD(XTREE,XNSEG,XNFLD,XSEG) ; process a field
- ;
- ; input: XTREE name of MUMPS array for parse tree ($NA format)
- ; XNSEG segment number for parse tree
- ; XNFLD field number for parse tree
- ; .XSEG segment before addition of field
- ;
- ; output: .XSEG segment after addition of field
- ;
- N NREP ; ---- repetition (occurrence) number
- N REP ; ----- repetition data
- N NCMP ; ---- component number
- N CMP ; ----- component data
- N NSCM ; ---- subcomponent number
- N SCM ; ----- subcomponent data
- N FLD ; ----- field data
- ;
- S NREP=""
- F S NREP=$O(@XTREE@(XNSEG,XNFLD,NREP)) Q:NREP="" D
- . K REP
- . S NCMP=""
- . F S NCMP=$O(@XTREE@(XNSEG,XNFLD,NREP,NCMP)) Q:NCMP="" D
- . . K CMP
- . . S NSCM=""
- . . F S NSCM=$O(@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)) Q:NSCM="" D
- . . . S SCM=@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)
- . . . S $P(CMP,USS,NSCM)=$$ESC(.SCM)
- . . . Q
- . . S $P(REP,UCS,NCMP)=CMP
- . . Q
- . S $P(FLD,URS,NREP)=REP
- . Q
- S $P(XSEG,UFS,NFLD)=$G(FLD)
- Q
- ;
- ESC(XDTA) ;apply escape sequence to data
- ; Insert an intermediate token, then expand the intermediate token to
- ; the real escape sequence. (We have to do 2 steps because the escape
- ; sequence uses the escape character.)
- F Q:XDTA'[UFS S XDTA=$P(XDTA,UFS)_$C(1)_$P(XDTA,UFS,2,999)
- F Q:XDTA'[UCS S XDTA=$P(XDTA,UCS)_$C(2)_$P(XDTA,UCS,2,999)
- F Q:XDTA'[URS S XDTA=$P(XDTA,URS)_$C(3)_$P(XDTA,URS,2,999)
- F Q:XDTA'[UEC S XDTA=$P(XDTA,UEC)_$C(4)_$P(XDTA,UEC,2,999)
- F Q:XDTA'[USS S XDTA=$P(XDTA,USS)_$C(5)_$P(XDTA,USS,2,999)
- F Q:XDTA'[$C(1) S XDTA=$P(XDTA,$C(1))_UEC_"F"_UEC_$P(XDTA,$C(1),2,999)
- F Q:XDTA'[$C(2) S XDTA=$P(XDTA,$C(2))_UEC_"S"_UEC_$P(XDTA,$C(2),2,999)
- F Q:XDTA'[$C(3) S XDTA=$P(XDTA,$C(3))_UEC_"R"_UEC_$P(XDTA,$C(3),2,999)
- F Q:XDTA'[$C(4) S XDTA=$P(XDTA,$C(4))_UEC_"E"_UEC_$P(XDTA,$C(4),2,999)
- F Q:XDTA'[$C(5) S XDTA=$P(XDTA,$C(5))_UEC_"T"_UEC_$P(XDTA,$C(5),2,999)
- Q XDTA
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAG7UM 5645 printed Feb 18, 2025@23:25:51 Page 2
- 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
- +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 QUIT
- +18 ;
- MAKE(XTREE,XMSG) ; make a parse tree into an array of message lines
- +1 ;
- +2 ; INPUT: XTREE The name of the parse tree ($NA format)
- +3 ; Parse tree structure:
- +4 ; @XTREE@(NSEG,0) segment name
- +5 ; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
- +6 ; @XTREE@("B",SEGID,NSEG) null
- +7 ;
- +8 ; XMSG The name of a single-dimensional array to be populated
- +9 ; with message lines ($NA format). This array is
- +10 ; cleared on invocation.
- +11 ;
- +12 ; OUTPUT: XMSG The array after being populated with message lines
- +13 ;
- +14 ;---------------- HL7 delimiters (universal)
- NEW UFS,UCS,URS,UEC,USS
- +15 ; --------------------------------- scratch var
- NEW X,I
- +16 ; ------------------------------- error flag
- NEW ERR
- +17 ; ------------------------------- encoding characters string
- NEW ENC
- +18 ; ------------------------------ segment number in the parse tree
- NEW NSEG
- +19 ; ----------------------------- segment number in the message
- NEW NMSEG
- +20 ; ------------------------------ message array index
- NEW IMSG
- +21 ; ------------------------------- segment data
- NEW SEG
- +22 ; ------------------------------ field number in the segment
- NEW NFLD
- +23 ; ------------------------------- field data
- NEW FLD
- +24 ;
- +25 ; refresh target array
- KILL @XMSG
- +26 ; process MSH segment
- +27 ; parse tree sent?
- if $DATA(@XTREE)<10
- QUIT -1
- +28 SET NSEG=$ORDER(@XTREE@(""))
- SET NMSEG=1
- +29 ; an HL7 message?
- if $GET(@XTREE@(NSEG,0))'="MSH"
- QUIT -2
- +30 ; message type provided?
- if $DATA(@XTREE@(NSEG,9,1,1,1))#10=0
- QUIT -3
- +31 ; get delimiters or define defaults
- +32 SET UFS=$GET(@XTREE@(NSEG,1,1,1,1))
- IF $LENGTH(UFS)-1
- SET UFS="|"
- +33 SET ENC=$GET(@XTREE@(NSEG,2,1,1,1))
- IF $LENGTH(ENC)-4
- SET ENC="^~\&"
- +34 SET UCS=$EXTRACT(ENC)
- SET URS=$EXTRACT(ENC,2)
- SET UEC=$EXTRACT(ENC,3)
- SET USS=$EXTRACT(ENC,4)
- +35 IF $DATA(@XTREE@(NSEG,3,1,1,1))#10=0
- SET @XTREE@(1,3,1,1,1)="VistA Imaging"
- +36 SET @XTREE@(NSEG,7,1,1,1)=$$NOW^XLFDT()+17000000*1000000
- +37 IF $DATA(@XTREE@(NSEG,10,1,1,1))#10=0
- Begin DoDot:1
- +38 SET X=""
- +39 FOR I=1:1:16
- SET X=X_$EXTRACT("0123456789ABCDEF",$RANDOM(16)+1)
- +40 SET @XTREE@(NSEG,10,1,1,1)=X
- +41 QUIT
- End DoDot:1
- +42 IF $DATA(@XTREE@(NSEG,11,1,1,1))#10=0
- SET @XTREE@(NSEG,11,1,1,1)="D"
- +43 IF $DATA(@XTREE@(NSEG,12,1,1,1))#10=0
- SET @XTREE@(NSEG,12,1,1,1)="2.3.1"
- +44 SET SEG="MSH"_UFS_ENC
- +45 SET NFLD=2
- +46 FOR
- SET NFLD=$ORDER(@XTREE@(NSEG,NFLD))
- if NFLD=""
- QUIT
- DO PROCFLD(XTREE,NSEG,NFLD,.SEG)
- +47 SET @XMSG@(NMSEG)=SEG
- +48 FOR
- SET NSEG=$ORDER(@XTREE@(NSEG))
- if 'NSEG
- QUIT
- Begin DoDot:1
- +49 KILL SEG
- +50 SET NMSEG=NMSEG+1
- +51 SET NFLD=0
- +52 FOR
- SET NFLD=$ORDER(@XTREE@(NSEG,NFLD))
- if NFLD=""
- QUIT
- DO PROCFLD(XTREE,NSEG,NFLD,.SEG)
- +53 SET @XMSG@(NMSEG)=$GET(@XTREE@(NSEG,0))_$SELECT($GET(SEG)]"":UFS_SEG,1:"")
- +54 QUIT
- End DoDot:1
- +55 QUIT 0
- +56 ;
- PROCFLD(XTREE,XNSEG,XNFLD,XSEG) ; process a field
- +1 ;
- +2 ; input: XTREE name of MUMPS array for parse tree ($NA format)
- +3 ; XNSEG segment number for parse tree
- +4 ; XNFLD field number for parse tree
- +5 ; .XSEG segment before addition of field
- +6 ;
- +7 ; output: .XSEG segment after addition of field
- +8 ;
- +9 ; ---- repetition (occurrence) number
- NEW NREP
- +10 ; ----- repetition data
- NEW REP
- +11 ; ---- component number
- NEW NCMP
- +12 ; ----- component data
- NEW CMP
- +13 ; ---- subcomponent number
- NEW NSCM
- +14 ; ----- subcomponent data
- NEW SCM
- +15 ; ----- field data
- NEW FLD
- +16 ;
- +17 SET NREP=""
- +18 FOR
- SET NREP=$ORDER(@XTREE@(XNSEG,XNFLD,NREP))
- if NREP=""
- QUIT
- Begin DoDot:1
- +19 KILL REP
- +20 SET NCMP=""
- +21 FOR
- SET NCMP=$ORDER(@XTREE@(XNSEG,XNFLD,NREP,NCMP))
- if NCMP=""
- QUIT
- Begin DoDot:2
- +22 KILL CMP
- +23 SET NSCM=""
- +24 FOR
- SET NSCM=$ORDER(@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM))
- if NSCM=""
- QUIT
- Begin DoDot:3
- +25 SET SCM=@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)
- +26 SET $PIECE(CMP,USS,NSCM)=$$ESC(.SCM)
- +27 QUIT
- End DoDot:3
- +28 SET $PIECE(REP,UCS,NCMP)=CMP
- +29 QUIT
- End DoDot:2
- +30 SET $PIECE(FLD,URS,NREP)=REP
- +31 QUIT
- End DoDot:1
- +32 SET $PIECE(XSEG,UFS,NFLD)=$GET(FLD)
- +33 QUIT
- +34 ;
- ESC(XDTA) ;apply escape sequence to data
- +1 ; Insert an intermediate token, then expand the intermediate token to
- +2 ; the real escape sequence. (We have to do 2 steps because the escape
- +3 ; sequence uses the escape character.)
- +4 FOR
- if XDTA'[UFS
- QUIT
- SET XDTA=$PIECE(XDTA,UFS)_$CHAR(1)_$PIECE(XDTA,UFS,2,999)
- +5 FOR
- if XDTA'[UCS
- QUIT
- SET XDTA=$PIECE(XDTA,UCS)_$CHAR(2)_$PIECE(XDTA,UCS,2,999)
- +6 FOR
- if XDTA'[URS
- QUIT
- SET XDTA=$PIECE(XDTA,URS)_$CHAR(3)_$PIECE(XDTA,URS,2,999)
- +7 FOR
- if XDTA'[UEC
- QUIT
- SET XDTA=$PIECE(XDTA,UEC)_$CHAR(4)_$PIECE(XDTA,UEC,2,999)
- +8 FOR
- if XDTA'[USS
- QUIT
- SET XDTA=$PIECE(XDTA,USS)_$CHAR(5)_$PIECE(XDTA,USS,2,999)
- +9 FOR
- if XDTA'[$CHAR(1)
- QUIT
- SET XDTA=$PIECE(XDTA,$CHAR(1))_UEC_"F"_UEC_$PIECE(XDTA,$CHAR(1),2,999)
- +10 FOR
- if XDTA'[$CHAR(2)
- QUIT
- SET XDTA=$PIECE(XDTA,$CHAR(2))_UEC_"S"_UEC_$PIECE(XDTA,$CHAR(2),2,999)
- +11 FOR
- if XDTA'[$CHAR(3)
- QUIT
- SET XDTA=$PIECE(XDTA,$CHAR(3))_UEC_"R"_UEC_$PIECE(XDTA,$CHAR(3),2,999)
- +12 FOR
- if XDTA'[$CHAR(4)
- QUIT
- SET XDTA=$PIECE(XDTA,$CHAR(4))_UEC_"E"_UEC_$PIECE(XDTA,$CHAR(4),2,999)
- +13 FOR
- if XDTA'[$CHAR(5)
- QUIT
- SET XDTA=$PIECE(XDTA,$CHAR(5))_UEC_"T"_UEC_$PIECE(XDTA,$CHAR(5),2,999)
- +14 QUIT XDTA
- +15 ;