RORHL071 ;HOIFO/BH - HL7 IV PHARMACY: ORC,RXE ; 5/30/06 8:37am
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #10039 Read access to file #42 (supported)
; #10060 Read access to file #200 (supported)
;
Q
;
;***** IV PHARMACY ORC SEGMENT BUILDER
;
; NODE Closed root of a subtree that stores the output of
; the PSS436^PSS55 Pharmacy API
;
; .RORORC Array with info (from OEL^PSOORRL)
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
ORC(NODE,RORORC) ;
N BUF,CS,ERRCNT,IEN42,IEN44,RC,RORMSG,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="ORC"
;
;--- ORC-1 - Order Control
S RORSEG(1)="NW"
;
;--- ORC-2 - Placer Order Number
S RORSEG(2)=RORDFN_"V"_$P($G(@NODE@(.01)),U)_CS_"IP"
;
;--- ORC-12 - Provider
S BUF=+$P($G(RORORC("P",0)),U)
I BUF>0 D
. S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1
. . D DBS^RORERR("RORMSG",-99,,,200,+BUF_",")
. S RORSEG(12)=BUF
;
;--- ORC-15 - Order Date/Time
S TMP=$$FMTHL7^XLFDT($P($G(RORORC(0)),U,5))
Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No order date","OEL^PSOORRL")
S RORSEG(15)=TMP
;
;--- ORC-16 - Control Code Reason
S RORSEG(16)=CS_CS_CS_CS_"NEW"
;
;--- ORC-17 - Division
S IEN42=+$P($G(@NODE@(9)),U)
I IEN42>0 D
. S IEN44=+$$GET1^DIQ(42,IEN42_",",44,"I",,"RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1
. . D DBS^RORERR("RORMSG",-99,,,42,IEN42_",")
E S IEN44=0
S RORSEG(17)=$$DIV44^RORHLUT1(IEN44,CS)
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
;
;***** IV PHARMACY RXE SEGMENT BUILDER
;
; NODE Closed root of a subtree that stores the output of
; the PSS436^PSS55 Pharmacy API
;
; .RORRXE Array containing info (from OEL^PSJORRL)
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
RXE(NODE,RORRXE) ;
N BUF,CS,ERRCNT,IDGN,II,INDF,RC,RORMSG,RORMR,ROROUT,RORQT,RORSEG,TMP
Q:$P($G(RORRXE(0)),U)="" 0
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Load the data
S RORMR=$$ESCAPE^RORHL7($P($G(@NODE@(132)),U,2))
S TMP=$P($G(@NODE@(.09)),U),RORQT=""
S:TMP'="" $P(RORQT,CS,8)=$$ESCAPE^RORHL7(TMP)
;
S II=0
F S II=$O(RORRXE("DD",II)) Q:II="" D Q:RC<0
. K ROROUT,RORSEG
. ;--- Initialize the segment
. S RORSEG(0)="RXE"
. ;
. ;--- RXE-1 - Quantity/Timing
. S RORSEG(1)=RORQT
. ;
. ;--- RXE-2 - Give Code
. S IDGN=+$P($G(RORRXE("DD",II,0)),U)
. S:IDGN'>0 IDGN=+$P($G(RORRXE("DD",II,0)),U,3) Q:IDGN'>0
. S BUF="",TMP=$$RXE2^RORHL031(IDGN,CS,.BUF,.INDF)
. I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
. Q:BUF=""
. S RORSEG(2)=BUF
. ;
. ;--- RXE-3 - Give Amount (Min)
. S RORSEG(3)=""""""
. ;
. ;--- RXE-5 - Give Units
. S TMP=$$RXE5^RORHL031(+$G(INDF),CS,.BUF)
. S:TMP ERRCNT=ERRCNT+1
. S:BUF'="" RORSEG(5)=BUF
. ;
. ;--- RXE-18 - Stop Date/Time
. S TMP=$P($G(RORRXE(0)),U,3)
. S RORSEG(18)=$$FM2HL^RORHL7(TMP)
. ;
. ;--- RXE-21 - Medication Route
. S:RORMR'="" RORSEG(21)=RORMR
. ;
. ;--- RXE-24 - Units per dose
. S TMP=$P($G(RORRXE("DD",II,0)),U,2)
. S:TMP'="" RORSEG(24)=+TMP
. ;
. ;--- Store the segment
. D ADDSEG^RORHL7(.RORSEG)
;
Q ERRCNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL071 3423 printed Nov 22, 2024@16:52:03 Page 2
RORHL071 ;HOIFO/BH - HL7 IV PHARMACY: ORC,RXE ; 5/30/06 8:37am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10039 Read access to file #42 (supported)
+6 ; #10060 Read access to file #200 (supported)
+7 ;
+8 QUIT
+9 ;
+10 ;***** IV PHARMACY ORC SEGMENT BUILDER
+11 ;
+12 ; NODE Closed root of a subtree that stores the output of
+13 ; the PSS436^PSS55 Pharmacy API
+14 ;
+15 ; .RORORC Array with info (from OEL^PSOORRL)
+16 ;
+17 ; Return Values:
+18 ; <0 Error Code
+19 ; 0 Ok
+20 ; >0 Non-fatal error(s)
+21 ;
ORC(NODE,RORORC) ;
+1 NEW BUF,CS,ERRCNT,IEN42,IEN44,RC,RORMSG,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Initialize the segment
+6 SET RORSEG(0)="ORC"
+7 ;
+8 ;--- ORC-1 - Order Control
+9 SET RORSEG(1)="NW"
+10 ;
+11 ;--- ORC-2 - Placer Order Number
+12 SET RORSEG(2)=RORDFN_"V"_$PIECE($GET(@NODE@(.01)),U)_CS_"IP"
+13 ;
+14 ;--- ORC-12 - Provider
+15 SET BUF=+$PIECE($GET(RORORC("P",0)),U)
+16 IF BUF>0
Begin DoDot:1
+17 SET $PIECE(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
+18 IF $GET(DIERR)
Begin DoDot:2
+19 DO DBS^RORERR("RORMSG",-99,,,200,+BUF_",")
End DoDot:2
SET ERRCNT=ERRCNT+1
+20 SET RORSEG(12)=BUF
End DoDot:1
+21 ;
+22 ;--- ORC-15 - Order Date/Time
+23 SET TMP=$$FMTHL7^XLFDT($PIECE($GET(RORORC(0)),U,5))
+24 if TMP'>0
QUIT $$ERROR^RORERR(-100,,,,"No order date","OEL^PSOORRL")
+25 SET RORSEG(15)=TMP
+26 ;
+27 ;--- ORC-16 - Control Code Reason
+28 SET RORSEG(16)=CS_CS_CS_CS_"NEW"
+29 ;
+30 ;--- ORC-17 - Division
+31 SET IEN42=+$PIECE($GET(@NODE@(9)),U)
+32 IF IEN42>0
Begin DoDot:1
+33 SET IEN44=+$$GET1^DIQ(42,IEN42_",",44,"I",,"RORMSG")
+34 IF $GET(DIERR)
Begin DoDot:2
+35 DO DBS^RORERR("RORMSG",-99,,,42,IEN42_",")
End DoDot:2
SET ERRCNT=ERRCNT+1
End DoDot:1
+36 IF '$TEST
SET IEN44=0
+37 SET RORSEG(17)=$$DIV44^RORHLUT1(IEN44,CS)
+38 ;
+39 ;--- Store the segment
+40 DO ADDSEG^RORHL7(.RORSEG)
+41 QUIT ERRCNT
+42 ;
+43 ;***** IV PHARMACY RXE SEGMENT BUILDER
+44 ;
+45 ; NODE Closed root of a subtree that stores the output of
+46 ; the PSS436^PSS55 Pharmacy API
+47 ;
+48 ; .RORRXE Array containing info (from OEL^PSJORRL)
+49 ;
+50 ; Return Values:
+51 ; <0 Error Code
+52 ; 0 Ok
+53 ; >0 Non-fatal error(s)
+54 ;
RXE(NODE,RORRXE) ;
+1 NEW BUF,CS,ERRCNT,IDGN,II,INDF,RC,RORMSG,RORMR,ROROUT,RORQT,RORSEG,TMP
+2 if $PIECE($GET(RORRXE(0)),U)=""
QUIT 0
+3 SET (ERRCNT,RC)=0
+4 DO ECH^RORHL7(.CS)
+5 ;
+6 ;--- Load the data
+7 SET RORMR=$$ESCAPE^RORHL7($PIECE($GET(@NODE@(132)),U,2))
+8 SET TMP=$PIECE($GET(@NODE@(.09)),U)
SET RORQT=""
+9 if TMP'=""
SET $PIECE(RORQT,CS,8)=$$ESCAPE^RORHL7(TMP)
+10 ;
+11 SET II=0
+12 FOR
SET II=$ORDER(RORRXE("DD",II))
if II=""
QUIT
Begin DoDot:1
+13 KILL ROROUT,RORSEG
+14 ;--- Initialize the segment
+15 SET RORSEG(0)="RXE"
+16 ;
+17 ;--- RXE-1 - Quantity/Timing
+18 SET RORSEG(1)=RORQT
+19 ;
+20 ;--- RXE-2 - Give Code
+21 SET IDGN=+$PIECE($GET(RORRXE("DD",II,0)),U)
+22 if IDGN'>0
SET IDGN=+$PIECE($GET(RORRXE("DD",II,0)),U,3)
if IDGN'>0
QUIT
+23 SET BUF=""
SET TMP=$$RXE2^RORHL031(IDGN,CS,.BUF,.INDF)
+24 IF TMP
SET ERRCNT=ERRCNT+1
if TMP<0
QUIT
+25 if BUF=""
QUIT
+26 SET RORSEG(2)=BUF
+27 ;
+28 ;--- RXE-3 - Give Amount (Min)
+29 SET RORSEG(3)=""""""
+30 ;
+31 ;--- RXE-5 - Give Units
+32 SET TMP=$$RXE5^RORHL031(+$GET(INDF),CS,.BUF)
+33 if TMP
SET ERRCNT=ERRCNT+1
+34 if BUF'=""
SET RORSEG(5)=BUF
+35 ;
+36 ;--- RXE-18 - Stop Date/Time
+37 SET TMP=$PIECE($GET(RORRXE(0)),U,3)
+38 SET RORSEG(18)=$$FM2HL^RORHL7(TMP)
+39 ;
+40 ;--- RXE-21 - Medication Route
+41 if RORMR'=""
SET RORSEG(21)=RORMR
+42 ;
+43 ;--- RXE-24 - Units per dose
+44 SET TMP=$PIECE($GET(RORRXE("DD",II,0)),U,2)
+45 if TMP'=""
SET RORSEG(24)=+TMP
+46 ;
+47 ;--- Store the segment
+48 DO ADDSEG^RORHL7(.RORSEG)
End DoDot:1
if RC<0
QUIT
+49 ;
+50 QUIT ERRCNT
