129 lines
3.2 KiB
Mathematica
129 lines
3.2 KiB
Mathematica
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
|