RORHL15 ;HOIFO/BH - HL7 IV DATA: OBR, OBX ; 5/30/06 9:40am
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #2400 OCL^PSOORRL and OEL^PSOORRL (controlled)
; #4549 ZERO^PSS52P6 (supported)
; #4550 ZERO^PSS52P7 (supported)
; #4826 PSS436^PSS55 (supported)
;
Q
;
;***** SEARCHES FOR IV 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 ^TMP("PS",$J) global node is used by this function.
;
EN1(RORDFN,DXDTS) ;
N ERRCNT,IDX,IEN55,II,NODE,RC,ROR55,ROR55SUB,RORENDT,RORII,RORORD,RORSTDT,RORTMP
S (ERRCNT,RC)=0
;
S RORTMP=$$ALLOC^RORTMP()
S ROR55=$$ALLOC^RORTMP(.ROR55SUB)
;
S IDX=0
F S IDX=$O(DXDTS(14,IDX)) Q:IDX'>0 D Q:RC<0
. S RORSTDT=$P(DXDTS(14,IDX),U),RORENDT=$P(DXDTS(14,IDX),U,2)
. ;--- Load the list of prescriptions
. K ^TMP("PS",$J),@RORTMP
. D OCL^PSOORRL(RORDFN,RORSTDT,RORENDT)
. Q:$D(^TMP("PS",$J))<10
. ;
. ;--- Select the prescriptions
. S RORII=0
. F S RORII=$O(^TMP("PS",$J,RORII)) Q:'RORII D
. . S RORORD=$P(^TMP("PS",$J,RORII,0),U)
. . Q:RORORD'>0
. . S II=$P(RORORD,";"),II=$E(II,$L(II))
. . Q:II'="V"
. . ;---
. . M @RORTMP@(RORII)=^TMP("PS",$J,RORII)
. ;
. ;--- Browse through the list and generate the HL7 segments
. S RORII=0
. F S RORII=$O(@RORTMP@(RORII)) Q:'RORII D
. . S RORORD=$P(@RORTMP@(RORII,0),U),IEN55=+$P(RORORD,";")
. . D PSS436^PSS55(RORDFN,IEN55,ROR55SUB)
. . S NODE=$NA(@ROR55@(IEN55))
. . ;---
. . S TMP=$$OBR(NODE,RORDFN)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
. . ;---
. . S TMP=$$OBX(NODE,RORDFN)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
;
D FREE^RORTMP(ROR55),FREE^RORTMP(RORTMP)
K ^TMP("PS",$J)
Q $S(RC<0:RC,1:ERRCNT)
;
;***** IV OBR SEGMENT BUILDER
;
; NODE Closed root of a subtree that stores the output of
; the PSS436^PSS55 Pharmacy API
;
; RORDFN IEN of the patient in the PATIENT file (#2)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBR(NODE,RORDFN) ;
N CS,ERRCNT,IEN,RC,RORMSG,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-3 - Order Number
S RORSEG(3)=$P($G(@NODE@(.01)),U)
;
;--- OBR-4 - IV CPT Code
S RORSEG(4)="90780"_CS_"IV"_CS_"C4"
;
;--- OBR-7 - Start Date
S TMP=$$FMTHL7^XLFDT($P($G(@NODE@(.02)),U))
Q:TMP'>0 $$ERROR^RORERR(-100,,,RORDFN,"No start date","PSS436^PSS55")
S RORSEG(7)=TMP
;
;--- OBR-8 - Stop Date
S RORSEG(8)=$$FM2HL^RORHL7($P($G(@NODE@(.03)),U))
;
;--- OBR-13 - Schedule
S RORSEG(13)=$$ESCAPE^RORHL7($P($G(@NODE@(.09)),U))
;
;--- OBR-20 - Infusion Rate
S RORSEG(20)=$$ESCAPE^RORHL7($P($G(@NODE@(.08)),U))
;
;--- OBR-24 - Diagnostic Service ID
S RORSEG(24)="IMM"
;
;--- OBR-40 - Type
S TMP=$P($G(@NODE@(.04)),U)
I TMP'="" D S RORSEG(40)=TMP
. S $P(TMP,CS,2)=$P($G(@NODE@(.04)),U,2)
. S $P(TMP,CS,3)="VA"
;
;--- OBR-44 - Division
S IEN=+$P($G(@NODE@(9)),U)
I IEN>0 D
. S IEN=+$$GET1^DIQ(42,IEN_",",44,"I",,"RORMSG")
. D:$G(DIERR) DBS^RORERR("RORMSG",-99,,,42,IEN_",")
S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
;
;***** IV OBX SEGMENT(S) BUILDER
;
; NODE Closed root of a subtree that stores the output of
; the PSS436^PSS55 Pharmacy API
;
; RORDFN IEN of the patient in the PATIENT file (#2)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(NODE,RORDFN) ;
N ADD,CS,ERRCNT,I,ID,RC,SOL,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;=== Other print info
S TMP=$P($G(@NODE@(31)),U)
D:TMP'="" SETOBX(TMP,"OTPR"_CS_"Other Print info."_CS_"VA080")
;
;=== Additive data
I $G(@NODE@("ADD",0))>0 D
. S ID="ADD"_CS_"Additive"_CS_"VA080"
. S I=0
. F S I=$O(@NODE@("ADD",I)) Q:I'>0 D
. . S ADD=$P($G(@NODE@("ADD",I,.01)),U,2)
. . D:ADD'="" SETOBX(ADD,ID,$P($G(@NODE@("ADD",I,.02)),U))
;
;=== Solution Data
I $G(@NODE@("SOL",0))>0 D
. S ID="SOL"_CS_"Solution"_CS_"VA080"
. S I=0
. F S I=$O(@NODE@("SOL",I)) Q:I'>0 D
. . S SOL=$P($G(@NODE@("SOL",I,.01)),U,2)
. . D:SOL'="" SETOBX(SOL,ID,$P($G(@NODE@("SOL",I,1)),U))
;
Q ERRCNT
;
;***** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX5,OBX3,OBX7) ;
N RORSEG
;--- Initialize the segment
S RORSEG(0)="OBX"
;--- OBX-2 - Value Type
S RORSEG(2)="FT"
;--- OBX-3 - Obervation Identifier
S RORSEG(3)=OBX3
;--- OBX-5 - Observation Value
S RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
;--- OBX-7 - Strength (additives) or volume (solutions)
S:$G(OBX7)'="" RORSEG(7)=OBX7
;--- OBX-11 - Observation Result Status
S RORSEG(11)="F"
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL15 5116 printed Apr 09, 2024@20:48:21 Page 2
RORHL15 ;HOIFO/BH - HL7 IV DATA: OBR, OBX ; 5/30/06 9:40am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2400 OCL^PSOORRL and OEL^PSOORRL (controlled)
+6 ; #4549 ZERO^PSS52P6 (supported)
+7 ; #4550 ZERO^PSS52P7 (supported)
+8 ; #4826 PSS436^PSS55 (supported)
+9 ;
+10 QUIT
+11 ;
+12 ;***** SEARCHES FOR IV DATA
+13 ;
+14 ; RORDFN IEN of the patient in the PATIENT file (#2)
+15 ;
+16 ; .DXDTS Reference to a local variable where the
+17 ; data extraction time frames are stored.
+18 ;
+19 ; Return Values:
+20 ; <0 Error code
+21 ; 0 Ok
+22 ; >0 Non-fatal error(s)
+23 ;
+24 ; The ^TMP("PS",$J) global node is used by this function.
+25 ;
EN1(RORDFN,DXDTS) ;
+1 NEW ERRCNT,IDX,IEN55,II,NODE,RC,ROR55,ROR55SUB,RORENDT,RORII,RORORD,RORSTDT,RORTMP
+2 SET (ERRCNT,RC)=0
+3 ;
+4 SET RORTMP=$$ALLOC^RORTMP()
+5 SET ROR55=$$ALLOC^RORTMP(.ROR55SUB)
+6 ;
+7 SET IDX=0
+8 FOR
SET IDX=$ORDER(DXDTS(14,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+9 SET RORSTDT=$PIECE(DXDTS(14,IDX),U)
SET RORENDT=$PIECE(DXDTS(14,IDX),U,2)
+10 ;--- Load the list of prescriptions
+11 KILL ^TMP("PS",$JOB),@RORTMP
+12 DO OCL^PSOORRL(RORDFN,RORSTDT,RORENDT)
+13 if $DATA(^TMP("PS",$JOB))<10
QUIT
+14 ;
+15 ;--- Select the prescriptions
+16 SET RORII=0
+17 FOR
SET RORII=$ORDER(^TMP("PS",$JOB,RORII))
if 'RORII
QUIT
Begin DoDot:2
+18 SET RORORD=$PIECE(^TMP("PS",$JOB,RORII,0),U)
+19 if RORORD'>0
QUIT
+20 SET II=$PIECE(RORORD,";")
SET II=$EXTRACT(II,$LENGTH(II))
+21 if II'="V"
QUIT
+22 ;---
+23 MERGE @RORTMP@(RORII)=^TMP("PS",$JOB,RORII)
End DoDot:2
+24 ;
+25 ;--- Browse through the list and generate the HL7 segments
+26 SET RORII=0
+27 FOR
SET RORII=$ORDER(@RORTMP@(RORII))
if 'RORII
QUIT
Begin DoDot:2
+28 SET RORORD=$PIECE(@RORTMP@(RORII,0),U)
SET IEN55=+$PIECE(RORORD,";")
+29 DO PSS436^PSS55(RORDFN,IEN55,ROR55SUB)
+30 SET NODE=$NAME(@ROR55@(IEN55))
+31 ;---
+32 SET TMP=$$OBR(NODE,RORDFN)
+33 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+34 ;---
+35 SET TMP=$$OBX(NODE,RORDFN)
+36 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
End DoDot:2
End DoDot:1
if RC<0
QUIT
+37 ;
+38 DO FREE^RORTMP(ROR55)
DO FREE^RORTMP(RORTMP)
+39 KILL ^TMP("PS",$JOB)
+40 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+41 ;
+42 ;***** IV OBR SEGMENT BUILDER
+43 ;
+44 ; NODE Closed root of a subtree that stores the output of
+45 ; the PSS436^PSS55 Pharmacy API
+46 ;
+47 ; RORDFN IEN of the patient in the PATIENT file (#2)
+48 ;
+49 ; Return Values:
+50 ; <0 Error code
+51 ; 0 Ok
+52 ; >0 Non-fatal error(s)
+53 ;
OBR(NODE,RORDFN) ;
+1 NEW CS,ERRCNT,IEN,RC,RORMSG,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Initialize the segment
+6 SET RORSEG(0)="OBR"
+7 ;
+8 ;--- OBR-3 - Order Number
+9 SET RORSEG(3)=$PIECE($GET(@NODE@(.01)),U)
+10 ;
+11 ;--- OBR-4 - IV CPT Code
+12 SET RORSEG(4)="90780"_CS_"IV"_CS_"C4"
+13 ;
+14 ;--- OBR-7 - Start Date
+15 SET TMP=$$FMTHL7^XLFDT($PIECE($GET(@NODE@(.02)),U))
+16 if TMP'>0
QUIT $$ERROR^RORERR(-100,,,RORDFN,"No start date","PSS436^PSS55")
+17 SET RORSEG(7)=TMP
+18 ;
+19 ;--- OBR-8 - Stop Date
+20 SET RORSEG(8)=$$FM2HL^RORHL7($PIECE($GET(@NODE@(.03)),U))
+21 ;
+22 ;--- OBR-13 - Schedule
+23 SET RORSEG(13)=$$ESCAPE^RORHL7($PIECE($GET(@NODE@(.09)),U))
+24 ;
+25 ;--- OBR-20 - Infusion Rate
+26 SET RORSEG(20)=$$ESCAPE^RORHL7($PIECE($GET(@NODE@(.08)),U))
+27 ;
+28 ;--- OBR-24 - Diagnostic Service ID
+29 SET RORSEG(24)="IMM"
+30 ;
+31 ;--- OBR-40 - Type
+32 SET TMP=$PIECE($GET(@NODE@(.04)),U)
+33 IF TMP'=""
Begin DoDot:1
+34 SET $PIECE(TMP,CS,2)=$PIECE($GET(@NODE@(.04)),U,2)
+35 SET $PIECE(TMP,CS,3)="VA"
End DoDot:1
SET RORSEG(40)=TMP
+36 ;
+37 ;--- OBR-44 - Division
+38 SET IEN=+$PIECE($GET(@NODE@(9)),U)
+39 IF IEN>0
Begin DoDot:1
+40 SET IEN=+$$GET1^DIQ(42,IEN_",",44,"I",,"RORMSG")
+41 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-99,,,42,IEN_",")
End DoDot:1
+42 SET RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
+43 ;
+44 ;--- Store the segment
+45 DO ADDSEG^RORHL7(.RORSEG)
+46 QUIT ERRCNT
+47 ;
+48 ;***** IV OBX SEGMENT(S) BUILDER
+49 ;
+50 ; NODE Closed root of a subtree that stores the output of
+51 ; the PSS436^PSS55 Pharmacy API
+52 ;
+53 ; RORDFN IEN of the patient in the PATIENT file (#2)
+54 ;
+55 ; Return Values:
+56 ; <0 Error code
+57 ; 0 Ok
+58 ; >0 Non-fatal error(s)
+59 ;
OBX(NODE,RORDFN) ;
+1 NEW ADD,CS,ERRCNT,I,ID,RC,SOL,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;=== Other print info
+6 SET TMP=$PIECE($GET(@NODE@(31)),U)
+7 if TMP'=""
DO SETOBX(TMP,"OTPR"_CS_"Other Print info."_CS_"VA080")
+8 ;
+9 ;=== Additive data
+10 IF $GET(@NODE@("ADD",0))>0
Begin DoDot:1
+11 SET ID="ADD"_CS_"Additive"_CS_"VA080"
+12 SET I=0
+13 FOR
SET I=$ORDER(@NODE@("ADD",I))
if I'>0
QUIT
Begin DoDot:2
+14 SET ADD=$PIECE($GET(@NODE@("ADD",I,.01)),U,2)
+15 if ADD'=""
DO SETOBX(ADD,ID,$PIECE($GET(@NODE@("ADD",I,.02)),U))
End DoDot:2
End DoDot:1
+16 ;
+17 ;=== Solution Data
+18 IF $GET(@NODE@("SOL",0))>0
Begin DoDot:1
+19 SET ID="SOL"_CS_"Solution"_CS_"VA080"
+20 SET I=0
+21 FOR
SET I=$ORDER(@NODE@("SOL",I))
if I'>0
QUIT
Begin DoDot:2
+22 SET SOL=$PIECE($GET(@NODE@("SOL",I,.01)),U,2)
+23 if SOL'=""
DO SETOBX(SOL,ID,$PIECE($GET(@NODE@("SOL",I,1)),U))
End DoDot:2
End DoDot:1
+24 ;
+25 QUIT ERRCNT
+26 ;
+27 ;***** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX5,OBX3,OBX7) ;
+1 NEW RORSEG
+2 ;--- Initialize the segment
+3 SET RORSEG(0)="OBX"
+4 ;--- OBX-2 - Value Type
+5 SET RORSEG(2)="FT"
+6 ;--- OBX-3 - Obervation Identifier
+7 SET RORSEG(3)=OBX3
+8 ;--- OBX-5 - Observation Value
+9 SET RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
+10 ;--- OBX-7 - Strength (additives) or volume (solutions)
+11 if $GET(OBX7)'=""
SET RORSEG(7)=OBX7
+12 ;--- OBX-11 - Observation Result Status
+13 SET RORSEG(11)="F"
+14 ;--- Store the segment
+15 DO ADDSEG^RORHL7(.RORSEG)
+16 QUIT
