- GMVVDEF1 ;BPOIFO/JG,HIOFO/FT - BUILD HL7 ORU^R01 MESSAGE FOR VITALS ; 20 Sep 2005 4:36 PM
- ;;5.0;GEN. MED. REC. - VITALS;**5,8,12,17,11**;Oct 31, 2002
- ;11/30/2005 KAM/BAY Remedy Calls 121661 and 122742 changes for HL7 message
- VALID ;;VDEF HL7 MESSAGE BUILDER
- ; Creates HL7 V2.4 ORU^R01 message for vitals
- ;
- ; This routine uses the following IAs:
- ; #93 - FILE 44 references (controlled)
- ; #557 - FILE 40.7 references (controlled)
- ; #2432 - FILE 44 references (controlled)
- ; #3630 - VAFCQRY calls (controlled)
- ; #4248 - VDEFEL calls (controlled)
- ; #4571 - VDEFREQ calls (controlled)
- ; #10035 - DPT( references (supported)
- ; #10040 - FILE 44 references (supported)
- ; #10112 - VASITE calls (supported)
- ;
- ; This routine is called at tag EN as a Function by VDEFREQ1
- ;
- Q
- ;
- EN(EVIEN,KEY,VFLAG,OUT,MSHP) ; Entry point
- ;
- ; Inputs: EVIEN = IEN of VDEF Event in file 577
- ; KEY - IEN of file to create message from
- ; VFLAG - "V" for VistA HL7 destination (default)
- ; OUT - target array, passed by reference
- ; MSHP - Piece 4 contains message subtype
- ;
- ; Output: Two part string with parts separated by "^"
- ; Part 1: "LM" - output in local array passed in "OUT" parameter
- ; "GM" - output in ^TMP("HLS",$J)
- ; Part 2: No longer used
- ;
- N DFN,HLFS,HLCM,HLSC,HLRP,HLES,HLQ,VTLDAT,UM,VTLTYP,DTE,DTP
- N VTLERR,VAL,I,S,X,XX,Y,QUALS,HL7RC,PIDSEG,IEN1,SEQ,STOPCD,EIEVUID
- N SEPF,SEPC,SEPR,SEPE,SEPS,VTLNAM,ARRAY,O2SUP,OUTX,ADD,VTLVUID
- ;
- ; Initialize stuff
- K ^TMP("HLS",$J) S S=0,ARRAY="OUT("_"""HLS"""_",S)",TARGET="LM^"
- ;
- ; Set up HL7 delimiters
- S HLCM=$E(VDEFHL("ECH")),HLRP=$E(VDEFHL("ECH"),2),HLSC=$E(VDEFHL("ECH"),4),HLES=$E(VDEFHL("ECH"),3)
- S HLFS=VDEFHL("FS"),HLQ=VDEFHL("Q"),HL7RC=HLES_HLFS_HLCM_HLRP_HLSC
- D SETDLMS^VDEFEL
- ;
- ; Get the vitals measurement record & patient ID
- S VTLDAT=$$EN^GMVHDR(KEY)
- I 'VTLDAT D ERR^VDEFREQ("Invalid data in file GMR(120.5) for IEN "_KEY) S ZTSTOP=1 G EXIT
- S DFN=$P(VTLDAT,U,2),VTLTYP=$P(VTLDAT,U,7)
- S VTLVUID=$$GET^GMVUID(120.51,.01,+VTLTYP_",") ;vital type vuid
- S O2SUP=$P(VTLDAT,U,10),VTLERR=$P(VTLDAT,U,11)
- S X=$P(VTLDAT,U,5) I +X'=X!(X<0) S $P(VTLDAT,U,5)=""
- S STOPCD=""
- I $P(VTLDAT,U,5)'="" D
- . S STOPCD=$P($G(^SC($P(VTLDAT,U,5),0)),U,7) Q:STOPCD=""
- . S STOPCD=$G(^DIC(40.7,STOPCD,0))
- . S STOPCD=$$HL7RC($P(STOPCD,U,2))_";"_$$HL7RC($P(STOPCD,U))
- ;
- ; Build segments for message in OUTX, $P # = HL7 field #
- ;
- ; PID - Use MPI PID builder
- PID K PIDSEG S OUTX="",S=1,SEQ=""
- I $G(^DPT(DFN,0))="" D ERR^VDEFREQ("No entry in file DPT for DFN "_DFN) S ZTSTOP=1 G EXIT
- D BLDPID^VAFCQRY(DFN,1,SEQ,.PIDSEG,.VDEFHL)
- F I=2:1 Q:$G(PIDSEG(I))="" S PIDSEG(1,I-1)=PIDSEG(I) K PIDSEG(I)
- M OUTX=PIDSEG(1) K PIDSEG D SAVE
- ;
- ; ORC
- ORC S S=S+1,OUTX="RE"
- ;
- ; Filler ID
- S X=KEY_HLCM_$$HL7RC($P(SITEPARM,U,6))_"_120.5",$P(OUTX,HLFS,3)=X
- ;
- ; Enterer's location
- I $P(VTLDAT,U,5)'="" D
- . S X=$G(^SC($P(VTLDAT,U,5),0)),VAL=$$HL7RC($P(X,U,2))_HLCM_$P(VTLDAT,U,5)
- . S $P(VAL,HLCM,9)=$$HL7RC($P(X,U)),$P(OUTX,HLFS,13)=VAL
- . I +$P(X,U,15) S X=$$SITE^VASITE($P(VTLDAT,U),$P(X,U,15)) S:X=-1 X=""
- . E S X=""
- . S VAL=$$HL7RC($P(X,U,3))_HLCM_$$HL7RC($P(X,U,2))_HLCM_"L",$P(OUTX,HLFS,17)=VAL
- ; Parent Facility (Added 04/17/2006)
- S $P(OUTX,HLFS,21)=$P($$SITE^VASITE(),"^",2)
- ;
- S VAL=$P(OUTX,HLFS,3),OUTX="ORC"_HLFS_OUTX D SAVE
- ;
- ; OBR
- OBR S S=S+1,OUTX="",VTLNAM=$$HL7RC($P(^GMRD(120.51,VTLTYP,0),U))
- S X=VTLVUID_HLCM_VTLNAM_HLCM_$$HL7RC("99VA120.51")
- ;
- ; Add filler ID from ORC-3 & Procedure name
- S $P(OUTX,HLFS,3)=VAL,$P(OUTX,HLFS,4)=X
- ;
- ; Dates/times vital taken & entered
- S DTP=$$HL7RC($$TS^VDEFEL($P(VTLDAT,U))),$P(OUTX,HLFS,7)=DTP
- S DTE=$$HL7RC($$TS^VDEFEL($P(VTLDAT,U,4))),$P(OUTX,HLFS,8)=DTE
- ;
- ; Use date/time vital entered for results reported
- S $P(OUTX,HLFS,22)=DTE
- ;
- ; Set result status to Final or Error if entered in error
- S $P(OUTX,HLFS,25)=$E("FE",VTLERR'=""+1)
- ;
- ; Technician name
- S XX=$$XCN200^VDEFEL($P(VTLDAT,U,6))
- F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC($P(XX,SEPC,II))
- S $P(OUTX,HLFS,34)=XX
- S OUTX="OBR"_HLFS_OUTX D SAVE
- ;
- ; OBX 1 - Vital name
- OBX1 S S=S+1,OUTX=HLFS_"ST"
- ;
- ; Observation ID - Vital name
- S X=VTLVUID_HLCM_VTLNAM_HLCM_$$HL7RC("99VA120.51"),$P(OUTX,HLFS,3)=X
- ;
- ; Unit of measure
- ; If vital not performed, set units to null
- S UM=$$HL7RC($P(VTLDAT,U,9)) S:$F("Pass Refused Unavailable",$P(VTLDAT,U,8))>0 UM=""
- S UM=UM_HLCM_UM_HLCM_"L"
- ;
- ; Set sub-id if O2 supplements to follow
- S:O2SUP'="" $P(OUTX,HLFS,4)=1
- S $P(OUTX,HLFS,5)=$$HL7RC($P(VTLDAT,U,8)),$P(OUTX,HLFS,6)=UM
- ;
- ; Set result status to Final or Wrong if errors entered
- S $P(OUTX,HLFS,11)=$E("FW",VTLERR'=""+1)
- S XX=$$XCN200^VDEFEL($P(VTLDAT,U,6))
- F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC($P(XX,SEPC,II))
- S $P(OUTX,HLFS,16)=XX
- S OUTX="OBX"_HLFS_OUTX D SAVE
- ;
- ; OBX2 - O2 Supplement
- OBX2 G QUALS:O2SUP="" S (VAL,UM)=""
- S S=S+1,OUTX=HLFS_"ST"_HLFS_"O2 Supplement" D
- . I O2SUP["%",O2SUP'["l/min" S VAL=+O2SUP,UM="%" Q
- . I O2SUP'["%",O2SUP["l/min" S VAL=+O2SUP,UM="l/min"
- . I O2SUP["%",O2SUP["l/min" S $P(VAL,U)=$P(O2SUP," "),$P(UM,U)="l/min",$P(VAL,U,2)=+$P(O2SUP," ",3),$P(UM,U,2)="%"
- S X=$P(UM,U),X=X_HLCM_X_HLCM_"L",$P(UM,U)=X
- I $P(UM,U,2)'="" S X=$P(UM,U,2),X=X_HLCM_X_HLCM_"L",$P(UM,U,2)=X
- S $P(OUTX,HLFS,4)=2,$P(OUTX,HLFS,5)=$P(VAL,U,1),$P(OUTX,HLFS,6)=$P(UM,U)
- ;
- ; Set result status to Final or Wrong if errors entered
- S $P(OUTX,HLFS,11)=$E("FW",VTLERR'=""+1)
- S OUTX="OBX"_HLFS_OUTX,X=OUTX D SAVE
- ; If more than one O2 supplement, add another OBX
- ; Field offset in OUT is now +1 because OBX has been added
- S OUTX=X I $P(VAL,U,2)'="" D
- . S S=S+1,$P(OUTX,HLFS,5)=3,$P(OUTX,HLFS,6)=$P(VAL,U,2),$P(OUTX,HLFS,7)=$P(UM,U,2)
- . D SAVE
- ;
- ; Qualifiers
- QUALS S QUALS="",X=$O(^GMR(120.5,KEY,5,0)) G ERRS:X=""
- S S=S+1,OUTX=HLFS_"CE"_HLFS_"Qualifiers"_HLFS_HLFS
- ;
- ; Get qualifiers
- S IEN1=0 F S IEN1=$O(^GMR(120.5,KEY,5,IEN1)) Q:'+IEN1 D
- . S X=^GMR(120.5,KEY,5,IEN1,0),VAL=$$HL7RC($P(^GMRD(120.52,X,0),U))
- . S X=$$GET^GMVUID(120.52,.01,+X_",") ;qualifier vuid
- . S VAL=X_HLCM_VAL_HLCM_$$HL7RC("99VA120.52"),QUALS=QUALS_VAL_HLRP
- ;
- ; Set result
- S $P(OUTX,HLFS,5)=$E(QUALS,1,$L(QUALS)-1)
- ;
- ; Set result status to Final or Wrong if errors entered
- S $P(OUTX,HLFS,11)=$E("FW",VTLERR'=""+1)
- S OUTX="OBX"_HLFS_OUTX D SAVE
- ;
- ; Entered in Error
- ERRS G ZSC:VTLERR="" S S=S+1,OUTX=HLFS_"CE"_HLFS_"Error Reasons"_HLFS_HLFS
- ;
- ; Error data reason(s)
- S X=$P(VTLDAT,U,13),VAL=""
- F I=1:1:$L(X,"~") D
- .S Y=$P(X,"~",I)
- .S EIEVUID=$$GET^GMVUID(120.506,.01,$P(Y,"-",1)) ;error vuid
- .S VAL=VAL_$$HL7RC(EIEVUID)_HLCM_$$HL7RC($P(Y,"-",2))_HLCM_$$HL7RC("99VA8985.1")_HLRP
- S VAL=$E(VAL,1,$L(VAL)-1),$P(OUTX,HLFS,5)=VAL
- ;
- ; Set result status to Final or Wrong if errors entered
- S $P(OUTX,HLFS,11)=$E("FW",VTLERR'=""+1)
- ;
- ; Entered in error by technician
- S XX=$$XCN200^VDEFEL($P(VTLDAT,U,12))
- F II=2:1:7 S $P(XX,SEPC,II)=$$HL7RC($P(XX,SEPC,II))
- S $P(OUTX,HLFS,16)=XX
- S OUTX="OBX"_HLFS_OUTX D SAVE
- ;
- ; Stop Code & Name
- ZSC G EXIT:STOPCD=""
- S S=S+1,OUTX=HLFS_$P(STOPCD,";")_HLFS_$P(STOPCD,";",2)
- S OUTX="ZSC"_HLFS_OUTX D SAVE
- ;
- ; Done building segments
- EXIT Q TARGET
- ;
- ;
- ; Place current string into message array.
- ; Turn string into array if length >245.
- ; Move local array to global if needed.
- SAVE N I
- I $P(OUTX,HLFS)'="PID",$L(OUTX)>245 D
- . K ADD S ADD=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX))
- . F I=1:1 S ADD(I)=$E(OUTX,1,245),OUTX=$E(OUTX,246,$L(OUTX)) Q:OUTX=""
- . K OUTX M OUTX=ADD
- M @ARRAY=OUTX
- ;
- ; Move local array to global if it's getting big.
- I $P(TARGET,U)="LM",$S<16000 D
- . K ^TMP("HLS",$J) M ^TMP("HLS",$J)=OUT("HLS") K OUT("HLS")
- . S $P(TARGET,U)="GM",ARRAY="^TMP("_"""HLS"""_",$J,S)"
- K OUTX,ADD
- Q
- ;
- ; Replace any HL7 coding chars. in strings with HL7 escape sequence
- ; Input: X = data string
- HL7RC(X) N OCHR,RCHR,RCHRI,TYPE,I F TYPE="E","F","C","R","S" D
- . S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
- . S OCHR=$E(HL7RC,RCHRI),RCHR=$E("EFSRT",RCHRI)
- . Q:'$F(X,OCHR)
- . F I=1:1 Q:$E(X,I)="" I $E(X,I)=OCHR S X=$E(X,1,I-1)_HLES_RCHR_HLES_$E(X,I+1,999),I=I+2
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVVDEF1 8362 printed Feb 18, 2025@23:26:30 Page 2
- GMVVDEF1 ;BPOIFO/JG,HIOFO/FT - BUILD HL7 ORU^R01 MESSAGE FOR VITALS ; 20 Sep 2005 4:36 PM
- +1 ;;5.0;GEN. MED. REC. - VITALS;**5,8,12,17,11**;Oct 31, 2002
- +2 ;11/30/2005 KAM/BAY Remedy Calls 121661 and 122742 changes for HL7 message
- VALID ;;VDEF HL7 MESSAGE BUILDER
- +1 ; Creates HL7 V2.4 ORU^R01 message for vitals
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ; #93 - FILE 44 references (controlled)
- +5 ; #557 - FILE 40.7 references (controlled)
- +6 ; #2432 - FILE 44 references (controlled)
- +7 ; #3630 - VAFCQRY calls (controlled)
- +8 ; #4248 - VDEFEL calls (controlled)
- +9 ; #4571 - VDEFREQ calls (controlled)
- +10 ; #10035 - DPT( references (supported)
- +11 ; #10040 - FILE 44 references (supported)
- +12 ; #10112 - VASITE calls (supported)
- +13 ;
- +14 ; This routine is called at tag EN as a Function by VDEFREQ1
- +15 ;
- +16 QUIT
- +17 ;
- EN(EVIEN,KEY,VFLAG,OUT,MSHP) ; Entry point
- +1 ;
- +2 ; Inputs: EVIEN = IEN of VDEF Event in file 577
- +3 ; KEY - IEN of file to create message from
- +4 ; VFLAG - "V" for VistA HL7 destination (default)
- +5 ; OUT - target array, passed by reference
- +6 ; MSHP - Piece 4 contains message subtype
- +7 ;
- +8 ; Output: Two part string with parts separated by "^"
- +9 ; Part 1: "LM" - output in local array passed in "OUT" parameter
- +10 ; "GM" - output in ^TMP("HLS",$J)
- +11 ; Part 2: No longer used
- +12 ;
- +13 NEW DFN,HLFS,HLCM,HLSC,HLRP,HLES,HLQ,VTLDAT,UM,VTLTYP,DTE,DTP
- +14 NEW VTLERR,VAL,I,S,X,XX,Y,QUALS,HL7RC,PIDSEG,IEN1,SEQ,STOPCD,EIEVUID
- +15 NEW SEPF,SEPC,SEPR,SEPE,SEPS,VTLNAM,ARRAY,O2SUP,OUTX,ADD,VTLVUID
- +16 ;
- +17 ; Initialize stuff
- +18 KILL ^TMP("HLS",$JOB)
- SET S=0
- SET ARRAY="OUT("_"""HLS"""_",S)"
- SET TARGET="LM^"
- +19 ;
- +20 ; Set up HL7 delimiters
- +21 SET HLCM=$EXTRACT(VDEFHL("ECH"))
- SET HLRP=$EXTRACT(VDEFHL("ECH"),2)
- SET HLSC=$EXTRACT(VDEFHL("ECH"),4)
- SET HLES=$EXTRACT(VDEFHL("ECH"),3)
- +22 SET HLFS=VDEFHL("FS")
- SET HLQ=VDEFHL("Q")
- SET HL7RC=HLES_HLFS_HLCM_HLRP_HLSC
- +23 DO SETDLMS^VDEFEL
- +24 ;
- +25 ; Get the vitals measurement record & patient ID
- +26 SET VTLDAT=$$EN^GMVHDR(KEY)
- +27 IF 'VTLDAT
- DO ERR^VDEFREQ("Invalid data in file GMR(120.5) for IEN "_KEY)
- SET ZTSTOP=1
- GOTO EXIT
- +28 SET DFN=$PIECE(VTLDAT,U,2)
- SET VTLTYP=$PIECE(VTLDAT,U,7)
- +29 ;vital type vuid
- SET VTLVUID=$$GET^GMVUID(120.51,.01,+VTLTYP_",")
- +30 SET O2SUP=$PIECE(VTLDAT,U,10)
- SET VTLERR=$PIECE(VTLDAT,U,11)
- +31 SET X=$PIECE(VTLDAT,U,5)
- IF +X'=X!(X<0)
- SET $PIECE(VTLDAT,U,5)=""
- +32 SET STOPCD=""
- +33 IF $PIECE(VTLDAT,U,5)'=""
- Begin DoDot:1
- +34 SET STOPCD=$PIECE($GET(^SC($PIECE(VTLDAT,U,5),0)),U,7)
- if STOPCD=""
- QUIT
- +35 SET STOPCD=$GET(^DIC(40.7,STOPCD,0))
- +36 SET STOPCD=$$HL7RC($PIECE(STOPCD,U,2))_";"_$$HL7RC($PIECE(STOPCD,U))
- End DoDot:1
- +37 ;
- +38 ; Build segments for message in OUTX, $P # = HL7 field #
- +39 ;
- +40 ; PID - Use MPI PID builder
- PID KILL PIDSEG
- SET OUTX=""
- SET S=1
- SET SEQ=""
- +1 IF $GET(^DPT(DFN,0))=""
- DO ERR^VDEFREQ("No entry in file DPT for DFN "_DFN)
- SET ZTSTOP=1
- GOTO EXIT
- +2 DO BLDPID^VAFCQRY(DFN,1,SEQ,.PIDSEG,.VDEFHL)
- +3 FOR I=2:1
- if $GET(PIDSEG(I))=""
- QUIT
- SET PIDSEG(1,I-1)=PIDSEG(I)
- KILL PIDSEG(I)
- +4 MERGE OUTX=PIDSEG(1)
- KILL PIDSEG
- DO SAVE
- +5 ;
- +6 ; ORC
- ORC SET S=S+1
- SET OUTX="RE"
- +1 ;
- +2 ; Filler ID
- +3 SET X=KEY_HLCM_$$HL7RC($PIECE(SITEPARM,U,6))_"_120.5"
- SET $PIECE(OUTX,HLFS,3)=X
- +4 ;
- +5 ; Enterer's location
- +6 IF $PIECE(VTLDAT,U,5)'=""
- Begin DoDot:1
- +7 SET X=$GET(^SC($PIECE(VTLDAT,U,5),0))
- SET VAL=$$HL7RC($PIECE(X,U,2))_HLCM_$PIECE(VTLDAT,U,5)
- +8 SET $PIECE(VAL,HLCM,9)=$$HL7RC($PIECE(X,U))
- SET $PIECE(OUTX,HLFS,13)=VAL
- +9 IF +$PIECE(X,U,15)
- SET X=$$SITE^VASITE($PIECE(VTLDAT,U),$PIECE(X,U,15))
- if X=-1
- SET X=""
- +10 IF '$TEST
- SET X=""
- +11 SET VAL=$$HL7RC($PIECE(X,U,3))_HLCM_$$HL7RC($PIECE(X,U,2))_HLCM_"L"
- SET $PIECE(OUTX,HLFS,17)=VAL
- End DoDot:1
- +12 ; Parent Facility (Added 04/17/2006)
- +13 SET $PIECE(OUTX,HLFS,21)=$PIECE($$SITE^VASITE(),"^",2)
- +14 ;
- +15 SET VAL=$PIECE(OUTX,HLFS,3)
- SET OUTX="ORC"_HLFS_OUTX
- DO SAVE
- +16 ;
- +17 ; OBR
- OBR SET S=S+1
- SET OUTX=""
- SET VTLNAM=$$HL7RC($PIECE(^GMRD(120.51,VTLTYP,0),U))
- +1 SET X=VTLVUID_HLCM_VTLNAM_HLCM_$$HL7RC("99VA120.51")
- +2 ;
- +3 ; Add filler ID from ORC-3 & Procedure name
- +4 SET $PIECE(OUTX,HLFS,3)=VAL
- SET $PIECE(OUTX,HLFS,4)=X
- +5 ;
- +6 ; Dates/times vital taken & entered
- +7 SET DTP=$$HL7RC($$TS^VDEFEL($PIECE(VTLDAT,U)))
- SET $PIECE(OUTX,HLFS,7)=DTP
- +8 SET DTE=$$HL7RC($$TS^VDEFEL($PIECE(VTLDAT,U,4)))
- SET $PIECE(OUTX,HLFS,8)=DTE
- +9 ;
- +10 ; Use date/time vital entered for results reported
- +11 SET $PIECE(OUTX,HLFS,22)=DTE
- +12 ;
- +13 ; Set result status to Final or Error if entered in error
- +14 SET $PIECE(OUTX,HLFS,25)=$EXTRACT("FE",VTLERR'=""+1)
- +15 ;
- +16 ; Technician name
- +17 SET XX=$$XCN200^VDEFEL($PIECE(VTLDAT,U,6))
- +18 FOR II=2:1:7
- SET $PIECE(XX,SEPC,II)=$$HL7RC($PIECE(XX,SEPC,II))
- +19 SET $PIECE(OUTX,HLFS,34)=XX
- +20 SET OUTX="OBR"_HLFS_OUTX
- DO SAVE
- +21 ;
- +22 ; OBX 1 - Vital name
- OBX1 SET S=S+1
- SET OUTX=HLFS_"ST"
- +1 ;
- +2 ; Observation ID - Vital name
- +3 SET X=VTLVUID_HLCM_VTLNAM_HLCM_$$HL7RC("99VA120.51")
- SET $PIECE(OUTX,HLFS,3)=X
- +4 ;
- +5 ; Unit of measure
- +6 ; If vital not performed, set units to null
- +7 SET UM=$$HL7RC($PIECE(VTLDAT,U,9))
- if $FIND("Pass Refused Unavailable",$PIECE(VTLDAT,U,8))>0
- SET UM=""
- +8 SET UM=UM_HLCM_UM_HLCM_"L"
- +9 ;
- +10 ; Set sub-id if O2 supplements to follow
- +11 if O2SUP'=""
- SET $PIECE(OUTX,HLFS,4)=1
- +12 SET $PIECE(OUTX,HLFS,5)=$$HL7RC($PIECE(VTLDAT,U,8))
- SET $PIECE(OUTX,HLFS,6)=UM
- +13 ;
- +14 ; Set result status to Final or Wrong if errors entered
- +15 SET $PIECE(OUTX,HLFS,11)=$EXTRACT("FW",VTLERR'=""+1)
- +16 SET XX=$$XCN200^VDEFEL($PIECE(VTLDAT,U,6))
- +17 FOR II=2:1:7
- SET $PIECE(XX,SEPC,II)=$$HL7RC($PIECE(XX,SEPC,II))
- +18 SET $PIECE(OUTX,HLFS,16)=XX
- +19 SET OUTX="OBX"_HLFS_OUTX
- DO SAVE
- +20 ;
- +21 ; OBX2 - O2 Supplement
- OBX2 if O2SUP=""
- GOTO QUALS
- SET (VAL,UM)=""
- +1 SET S=S+1
- SET OUTX=HLFS_"ST"_HLFS_"O2 Supplement"
- Begin DoDot:1
- +2 IF O2SUP["%"
- IF O2SUP'["l/min"
- SET VAL=+O2SUP
- SET UM="%"
- QUIT
- +3 IF O2SUP'["%"
- IF O2SUP["l/min"
- SET VAL=+O2SUP
- SET UM="l/min"
- +4 IF O2SUP["%"
- IF O2SUP["l/min"
- SET $PIECE(VAL,U)=$PIECE(O2SUP," ")
- SET $PIECE(UM,U)="l/min"
- SET $PIECE(VAL,U,2)=+$PIECE(O2SUP," ",3)
- SET $PIECE(UM,U,2)="%"
- End DoDot:1
- +5 SET X=$PIECE(UM,U)
- SET X=X_HLCM_X_HLCM_"L"
- SET $PIECE(UM,U)=X
- +6 IF $PIECE(UM,U,2)'=""
- SET X=$PIECE(UM,U,2)
- SET X=X_HLCM_X_HLCM_"L"
- SET $PIECE(UM,U,2)=X
- +7 SET $PIECE(OUTX,HLFS,4)=2
- SET $PIECE(OUTX,HLFS,5)=$PIECE(VAL,U,1)
- SET $PIECE(OUTX,HLFS,6)=$PIECE(UM,U)
- +8 ;
- +9 ; Set result status to Final or Wrong if errors entered
- +10 SET $PIECE(OUTX,HLFS,11)=$EXTRACT("FW",VTLERR'=""+1)
- +11 SET OUTX="OBX"_HLFS_OUTX
- SET X=OUTX
- DO SAVE
- +12 ; If more than one O2 supplement, add another OBX
- +13 ; Field offset in OUT is now +1 because OBX has been added
- +14 SET OUTX=X
- IF $PIECE(VAL,U,2)'=""
- Begin DoDot:1
- +15 SET S=S+1
- SET $PIECE(OUTX,HLFS,5)=3
- SET $PIECE(OUTX,HLFS,6)=$PIECE(VAL,U,2)
- SET $PIECE(OUTX,HLFS,7)=$PIECE(UM,U,2)
- +16 DO SAVE
- End DoDot:1
- +17 ;
- +18 ; Qualifiers
- QUALS SET QUALS=""
- SET X=$ORDER(^GMR(120.5,KEY,5,0))
- if X=""
- GOTO ERRS
- +1 SET S=S+1
- SET OUTX=HLFS_"CE"_HLFS_"Qualifiers"_HLFS_HLFS
- +2 ;
- +3 ; Get qualifiers
- +4 SET IEN1=0
- FOR
- SET IEN1=$ORDER(^GMR(120.5,KEY,5,IEN1))
- if '+IEN1
- QUIT
- Begin DoDot:1
- +5 SET X=^GMR(120.5,KEY,5,IEN1,0)
- SET VAL=$$HL7RC($PIECE(^GMRD(120.52,X,0),U))
- +6 ;qualifier vuid
- SET X=$$GET^GMVUID(120.52,.01,+X_",")
- +7 SET VAL=X_HLCM_VAL_HLCM_$$HL7RC("99VA120.52")
- SET QUALS=QUALS_VAL_HLRP
- End DoDot:1
- +8 ;
- +9 ; Set result
- +10 SET $PIECE(OUTX,HLFS,5)=$EXTRACT(QUALS,1,$LENGTH(QUALS)-1)
- +11 ;
- +12 ; Set result status to Final or Wrong if errors entered
- +13 SET $PIECE(OUTX,HLFS,11)=$EXTRACT("FW",VTLERR'=""+1)
- +14 SET OUTX="OBX"_HLFS_OUTX
- DO SAVE
- +15 ;
- +16 ; Entered in Error
- ERRS if VTLERR=""
- GOTO ZSC
- SET S=S+1
- SET OUTX=HLFS_"CE"_HLFS_"Error Reasons"_HLFS_HLFS
- +1 ;
- +2 ; Error data reason(s)
- +3 SET X=$PIECE(VTLDAT,U,13)
- SET VAL=""
- +4 FOR I=1:1:$LENGTH(X,"~")
- Begin DoDot:1
- +5 SET Y=$PIECE(X,"~",I)
- +6 ;error vuid
- SET EIEVUID=$$GET^GMVUID(120.506,.01,$PIECE(Y,"-",1))
- +7 SET VAL=VAL_$$HL7RC(EIEVUID)_HLCM_$$HL7RC($PIECE(Y,"-",2))_HLCM_$$HL7RC("99VA8985.1")_HLRP
- End DoDot:1
- +8 SET VAL=$EXTRACT(VAL,1,$LENGTH(VAL)-1)
- SET $PIECE(OUTX,HLFS,5)=VAL
- +9 ;
- +10 ; Set result status to Final or Wrong if errors entered
- +11 SET $PIECE(OUTX,HLFS,11)=$EXTRACT("FW",VTLERR'=""+1)
- +12 ;
- +13 ; Entered in error by technician
- +14 SET XX=$$XCN200^VDEFEL($PIECE(VTLDAT,U,12))
- +15 FOR II=2:1:7
- SET $PIECE(XX,SEPC,II)=$$HL7RC($PIECE(XX,SEPC,II))
- +16 SET $PIECE(OUTX,HLFS,16)=XX
- +17 SET OUTX="OBX"_HLFS_OUTX
- DO SAVE
- +18 ;
- +19 ; Stop Code & Name
- ZSC if STOPCD=""
- GOTO EXIT
- +1 SET S=S+1
- SET OUTX=HLFS_$PIECE(STOPCD,";")_HLFS_$PIECE(STOPCD,";",2)
- +2 SET OUTX="ZSC"_HLFS_OUTX
- DO SAVE
- +3 ;
- +4 ; Done building segments
- EXIT QUIT TARGET
- +1 ;
- +2 ;
- +3 ; Place current string into message array.
- +4 ; Turn string into array if length >245.
- +5 ; Move local array to global if needed.
- SAVE NEW I
- +1 IF $PIECE(OUTX,HLFS)'="PID"
- IF $LENGTH(OUTX)>245
- Begin DoDot:1
- +2 KILL ADD
- SET ADD=$EXTRACT(OUTX,1,245)
- SET OUTX=$EXTRACT(OUTX,246,$LENGTH(OUTX))
- +3 FOR I=1:1
- SET ADD(I)=$EXTRACT(OUTX,1,245)
- SET OUTX=$EXTRACT(OUTX,246,$LENGTH(OUTX))
- if OUTX=""
- QUIT
- +4 KILL OUTX
- MERGE OUTX=ADD
- End DoDot:1
- +5 MERGE @ARRAY=OUTX
- +6 ;
- +7 ; Move local array to global if it's getting big.
- +8 IF $PIECE(TARGET,U)="LM"
- IF $STORAGE<16000
- Begin DoDot:1
- +9 KILL ^TMP("HLS",$JOB)
- MERGE ^TMP("HLS",$JOB)=OUT("HLS")
- KILL OUT("HLS")
- +10 SET $PIECE(TARGET,U)="GM"
- SET ARRAY="^TMP("_"""HLS"""_",$J,S)"
- End DoDot:1
- +11 KILL OUTX,ADD
- +12 QUIT
- +13 ;
- +14 ; Replace any HL7 coding chars. in strings with HL7 escape sequence
- +15 ; Input: X = data string
- HL7RC(X) NEW OCHR,RCHR,RCHRI,TYPE,I
- FOR TYPE="E","F","C","R","S"
- Begin DoDot:1
- +1 SET RCHRI=$SELECT(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
- +2 SET OCHR=$EXTRACT(HL7RC,RCHRI)
- SET RCHR=$EXTRACT("EFSRT",RCHRI)
- +3 if '$FIND(X,OCHR)
- QUIT
- +4 FOR I=1:1
- if $EXTRACT(X,I)=""
- QUIT
- IF $EXTRACT(X,I)=OCHR
- SET X=$EXTRACT(X,1,I-1)_HLES_RCHR_HLES_$EXTRACT(X,I+1,999)
- SET I=I+2
- End DoDot:1
- +5 QUIT X