RORHL16 ;HOIFO/BH,SG - HL7 VITALS DATA: OBR,OBX ; 8/31/05 2:16pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #1446 EN1^GMRVUT0 (controlled)
;
Q
;
;***** SEARCHES FOR VITALS DATA
;
; RORDFN IEN of the patient in the PATIENT file (#2)
;
; .DXDTS Reference to a local variable where the
; data extraction time frames are stored.
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
; The function uses ^UTILITY($J,"GMRVD") global node.
;
EN1(RORDFN,DXDTS) ;
N DFN,GMRVSTR,IDX,PAT,RC,RORENDT,RORSTDT
S (ERRCNT,RC)=0
;
S IDX=0
F S IDX=$O(DXDTS(15,IDX)) Q:IDX'>0 D Q:RC<0
. S RORSTDT=$P(DXDTS(15,IDX),U),RORENDT=$P(DXDTS(15,IDX),U,2)
. ;--- Check to see if the patient has any Vitals data
. K ^UTILITY($J,"GMRVD")
. S DFN=RORDFN,GMRVSTR="BP;T;R;P;HT;WT;PN"
. S GMRVSTR(0)=RORSTDT_"^"_RORENDT_"^999999^0"
. D EN1^GMRVUT0
. Q:$D(^UTILITY($J,"GMRVD"))<10
. ;--- Process the data
. S TMP=$$OBR()
. I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
. S TMP=$$OBX()
. I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
;
K ^UTILITY($J,"GMRVD")
Q $S(RC<0:RC,1:ERRCNT)
;
;***** VITALS OBR SEGMENT BUILDER
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBR() ;
N CS,ERRCNT,RC,RORSEG
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-4 - Vitals CPT Code
S RORSEG(4)="94150"_CS_"VITAL CAPACITY TEST"_CS_"C4"
;
;--- OBR-24 - Diagnostic Service ID
S RORSEG(24)="EC"
;
;--- OBR-44 - Division
S RORSEG(44)=$$SITE^RORUTL03(CS)
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
;
;***** VITALS OBX SEGMENT(S) BUILDER
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX() ;
N CS,ERRCNT,RC,OBID
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
F OBID="BP^Blood Pressue^VA080","T^Temperature^VA080","R^Respiration^VA080","P^Pulse^VA080","HT^Height^VA080","WT^Weight^VA080","PN^Pain^VA080" D
. D VITALTYP($TR(OBID,"^",CS),CS)
;
Q ERRCNT
;
;***** LOOPS THROUGH THE UTILITY GLOBAL FOR VITAL TYPE
VITALTYP(OBID,CS) ;
N BODYMASS,DATA,DTE,IEN,MEASDATE,OBX5,TYPE,UNITS
S TYPE=$P(OBID,CS)
Q:'$D(^UTILITY($J,"GMRVD",TYPE))
;---
S DTE=""
F S DTE=$O(^UTILITY($J,"GMRVD",TYPE,DTE)) Q:'DTE D
. S IEN=""
. F S IEN=$O(^UTILITY($J,"GMRVD",TYPE,DTE,IEN)) Q:'IEN D
. . S DATA=^UTILITY($J,"GMRVD",TYPE,DTE,IEN)
. . ;
. . S MEASDATE=$P(DATA,U) ;??? Temporary fix for Vitals API bug
. . I $L(MEASDATE)=8 S:$E(MEASDATE,8)="0" MEASDATE=$E(MEASDATE,1,7)
. . S MEASDATE=$$FM2HL^RORHL7(MEASDATE)
. . S UNITS=$P(DATA,U,13)
. . S BODYMASS=$S(TYPE="WT":$P(DATA,U,14),1:"")
. . ;
. . S OBX5=$P(DATA,U,8)_U_$P(DATA,U,11)_U_$P(DATA,U,17)
. . D SETOBX(OBID,IEN,OBX5,UNITS,BODYMASS,MEASDATE)
;
Q
;
;*** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX3,OBX4,OBX5,OBX6,OBX7,OBX14) ;
N RORSEG
;--- Initialize the segment
S RORSEG(0)="OBX"
;--- OBX-2
S RORSEG(2)="FT"
;---
S RORSEG(3)=OBX3
S RORSEG(4)=OBX4
S RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
S:$G(OBX6)'="" RORSEG(6)=OBX6
S:$G(OBX7)'="" RORSEG(7)=OBX7
S:$G(OBX14)'="" RORSEG(14)=OBX14
;--- OBX-11
S RORSEG(11)="F"
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL16 3432 printed Apr 09, 2024@20:49:30 Page 2
RORHL16 ;HOIFO/BH,SG - HL7 VITALS DATA: OBR,OBX ; 8/31/05 2:16pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #1446 EN1^GMRVUT0 (controlled)
+6 ;
+7 QUIT
+8 ;
+9 ;***** SEARCHES FOR VITALS DATA
+10 ;
+11 ; RORDFN IEN of the patient in the PATIENT file (#2)
+12 ;
+13 ; .DXDTS Reference to a local variable where the
+14 ; data extraction time frames are stored.
+15 ;
+16 ; Return Values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ; >0 Non-fatal error(s)
+20 ;
+21 ; The function uses ^UTILITY($J,"GMRVD") global node.
+22 ;
EN1(RORDFN,DXDTS) ;
+1 NEW DFN,GMRVSTR,IDX,PAT,RC,RORENDT,RORSTDT
+2 SET (ERRCNT,RC)=0
+3 ;
+4 SET IDX=0
+5 FOR
SET IDX=$ORDER(DXDTS(15,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+6 SET RORSTDT=$PIECE(DXDTS(15,IDX),U)
SET RORENDT=$PIECE(DXDTS(15,IDX),U,2)
+7 ;--- Check to see if the patient has any Vitals data
+8 KILL ^UTILITY($JOB,"GMRVD")
+9 SET DFN=RORDFN
SET GMRVSTR="BP;T;R;P;HT;WT;PN"
+10 SET GMRVSTR(0)=RORSTDT_"^"_RORENDT_"^999999^0"
+11 DO EN1^GMRVUT0
+12 if $DATA(^UTILITY($JOB,"GMRVD"))<10
QUIT
+13 ;--- Process the data
+14 SET TMP=$$OBR()
+15 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+16 SET TMP=$$OBX()
+17 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
End DoDot:1
if RC<0
QUIT
+18 ;
+19 KILL ^UTILITY($JOB,"GMRVD")
+20 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+21 ;
+22 ;***** VITALS OBR SEGMENT BUILDER
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; 0 Ok
+27 ; >0 Non-fatal error(s)
+28 ;
OBR() ;
+1 NEW CS,ERRCNT,RC,RORSEG
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Initialize the segment
+6 SET RORSEG(0)="OBR"
+7 ;
+8 ;--- OBR-4 - Vitals CPT Code
+9 SET RORSEG(4)="94150"_CS_"VITAL CAPACITY TEST"_CS_"C4"
+10 ;
+11 ;--- OBR-24 - Diagnostic Service ID
+12 SET RORSEG(24)="EC"
+13 ;
+14 ;--- OBR-44 - Division
+15 SET RORSEG(44)=$$SITE^RORUTL03(CS)
+16 ;
+17 ;--- Store the segment
+18 DO ADDSEG^RORHL7(.RORSEG)
+19 QUIT ERRCNT
+20 ;
+21 ;***** VITALS OBX SEGMENT(S) BUILDER
+22 ;
+23 ; Return Values:
+24 ; <0 Error code
+25 ; 0 Ok
+26 ; >0 Non-fatal error(s)
+27 ;
OBX() ;
+1 NEW CS,ERRCNT,RC,OBID
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 FOR OBID="BP^Blood Pressue^VA080","T^Temperature^VA080","R^Respiration^VA080","P^Pulse^VA080","HT^Height^VA080","WT^Weight^VA080","PN^Pain^VA080"
Begin DoDot:1
+6 DO VITALTYP($TRANSLATE(OBID,"^",CS),CS)
End DoDot:1
+7 ;
+8 QUIT ERRCNT
+9 ;
+10 ;***** LOOPS THROUGH THE UTILITY GLOBAL FOR VITAL TYPE
VITALTYP(OBID,CS) ;
+1 NEW BODYMASS,DATA,DTE,IEN,MEASDATE,OBX5,TYPE,UNITS
+2 SET TYPE=$PIECE(OBID,CS)
+3 if '$DATA(^UTILITY($JOB,"GMRVD",TYPE))
QUIT
+4 ;---
+5 SET DTE=""
+6 FOR
SET DTE=$ORDER(^UTILITY($JOB,"GMRVD",TYPE,DTE))
if 'DTE
QUIT
Begin DoDot:1
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(^UTILITY($JOB,"GMRVD",TYPE,DTE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+9 SET DATA=^UTILITY($JOB,"GMRVD",TYPE,DTE,IEN)
+10 ;
+11 ;??? Temporary fix for Vitals API bug
SET MEASDATE=$PIECE(DATA,U)
+12 IF $LENGTH(MEASDATE)=8
if $EXTRACT(MEASDATE,8)="0"
SET MEASDATE=$EXTRACT(MEASDATE,1,7)
+13 SET MEASDATE=$$FM2HL^RORHL7(MEASDATE)
+14 SET UNITS=$PIECE(DATA,U,13)
+15 SET BODYMASS=$SELECT(TYPE="WT":$PIECE(DATA,U,14),1:"")
+16 ;
+17 SET OBX5=$PIECE(DATA,U,8)_U_$PIECE(DATA,U,11)_U_$PIECE(DATA,U,17)
+18 DO SETOBX(OBID,IEN,OBX5,UNITS,BODYMASS,MEASDATE)
End DoDot:2
End DoDot:1
+19 ;
+20 QUIT
+21 ;
+22 ;*** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX3,OBX4,OBX5,OBX6,OBX7,OBX14) ;
+1 NEW RORSEG
+2 ;--- Initialize the segment
+3 SET RORSEG(0)="OBX"
+4 ;--- OBX-2
+5 SET RORSEG(2)="FT"
+6 ;---
+7 SET RORSEG(3)=OBX3
+8 SET RORSEG(4)=OBX4
+9 SET RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
+10 if $GET(OBX6)'=""
SET RORSEG(6)=OBX6
+11 if $GET(OBX7)'=""
SET RORSEG(7)=OBX7
+12 if $GET(OBX14)'=""
SET RORSEG(14)=OBX14
+13 ;--- OBX-11
+14 SET RORSEG(11)="F"
+15 ;--- Store the segment
+16 DO ADDSEG^RORHL7(.RORSEG)
+17 QUIT
