source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL071.m@ 1094

Last change on this file since 1094 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1RORHL071 ;HOIFO/BH - HL7 IV PHARMACY: ORC,RXE ; 5/30/06 8:37am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10039 Read access to file #42 (supported)
7 ; #10060 Read access to file #200 (supported)
8 ;
9 Q
10 ;
11 ;***** IV PHARMACY ORC SEGMENT BUILDER
12 ;
13 ; NODE Closed root of a subtree that stores the output of
14 ; the PSS436^PSS55 Pharmacy API
15 ;
16 ; .RORORC Array with info (from OEL^PSOORRL)
17 ;
18 ; Return Values:
19 ; <0 Error Code
20 ; 0 Ok
21 ; >0 Non-fatal error(s)
22 ;
23ORC(NODE,RORORC) ;
24 N BUF,CS,ERRCNT,IEN42,IEN44,RC,RORMSG,RORSEG,TMP
25 S (ERRCNT,RC)=0
26 D ECH^RORHL7(.CS)
27 ;
28 ;--- Initialize the segment
29 S RORSEG(0)="ORC"
30 ;
31 ;--- ORC-1 - Order Control
32 S RORSEG(1)="NW"
33 ;
34 ;--- ORC-2 - Placer Order Number
35 S RORSEG(2)=RORDFN_"V"_$P($G(@NODE@(.01)),U)_CS_"IP"
36 ;
37 ;--- ORC-12 - Provider
38 S BUF=+$P($G(RORORC("P",0)),U)
39 I BUF>0 D
40 . S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
41 . I $G(DIERR) D S ERRCNT=ERRCNT+1
42 . . D DBS^RORERR("RORMSG",-99,,,200,+BUF_",")
43 . S RORSEG(12)=BUF
44 ;
45 ;--- ORC-15 - Order Date/Time
46 S TMP=$$FMTHL7^XLFDT($P($G(RORORC(0)),U,5))
47 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No order date","OEL^PSOORRL")
48 S RORSEG(15)=TMP
49 ;
50 ;--- ORC-16 - Control Code Reason
51 S RORSEG(16)=CS_CS_CS_CS_"NEW"
52 ;
53 ;--- ORC-17 - Division
54 S IEN42=+$P($G(@NODE@(9)),U)
55 I IEN42>0 D
56 . S IEN44=+$$GET1^DIQ(42,IEN42_",",44,"I",,"RORMSG")
57 . I $G(DIERR) D S ERRCNT=ERRCNT+1
58 . . D DBS^RORERR("RORMSG",-99,,,42,IEN42_",")
59 E S IEN44=0
60 S RORSEG(17)=$$DIV44^RORHLUT1(IEN44,CS)
61 ;
62 ;--- Store the segment
63 D ADDSEG^RORHL7(.RORSEG)
64 Q ERRCNT
65 ;
66 ;***** IV PHARMACY RXE SEGMENT BUILDER
67 ;
68 ; NODE Closed root of a subtree that stores the output of
69 ; the PSS436^PSS55 Pharmacy API
70 ;
71 ; .RORRXE Array containing info (from OEL^PSJORRL)
72 ;
73 ; Return Values:
74 ; <0 Error Code
75 ; 0 Ok
76 ; >0 Non-fatal error(s)
77 ;
78RXE(NODE,RORRXE) ;
79 N BUF,CS,ERRCNT,IDGN,II,INDF,RC,RORMSG,RORMR,ROROUT,RORQT,RORSEG,TMP
80 Q:$P($G(RORRXE(0)),U)="" 0
81 S (ERRCNT,RC)=0
82 D ECH^RORHL7(.CS)
83 ;
84 ;--- Load the data
85 S RORMR=$$ESCAPE^RORHL7($P($G(@NODE@(132)),U,2))
86 S TMP=$P($G(@NODE@(.09)),U),RORQT=""
87 S:TMP'="" $P(RORQT,CS,8)=$$ESCAPE^RORHL7(TMP)
88 ;
89 S II=0
90 F S II=$O(RORRXE("DD",II)) Q:II="" D Q:RC<0
91 . K ROROUT,RORSEG
92 . ;--- Initialize the segment
93 . S RORSEG(0)="RXE"
94 . ;
95 . ;--- RXE-1 - Quantity/Timing
96 . S RORSEG(1)=RORQT
97 . ;
98 . ;--- RXE-2 - Give Code
99 . S IDGN=+$P($G(RORRXE("DD",II,0)),U)
100 . S:IDGN'>0 IDGN=+$P($G(RORRXE("DD",II,0)),U,3) Q:IDGN'>0
101 . S BUF="",TMP=$$RXE2^RORHL031(IDGN,CS,.BUF,.INDF)
102 . I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
103 . Q:BUF=""
104 . S RORSEG(2)=BUF
105 . ;
106 . ;--- RXE-3 - Give Amount (Min)
107 . S RORSEG(3)=""""""
108 . ;
109 . ;--- RXE-5 - Give Units
110 . S TMP=$$RXE5^RORHL031(+$G(INDF),CS,.BUF)
111 . S:TMP ERRCNT=ERRCNT+1
112 . S:BUF'="" RORSEG(5)=BUF
113 . ;
114 . ;--- RXE-18 - Stop Date/Time
115 . S TMP=$P($G(RORRXE(0)),U,3)
116 . S RORSEG(18)=$$FM2HL^RORHL7(TMP)
117 . ;
118 . ;--- RXE-21 - Medication Route
119 . S:RORMR'="" RORSEG(21)=RORMR
120 . ;
121 . ;--- RXE-24 - Units per dose
122 . S TMP=$P($G(RORRXE("DD",II,0)),U,2)
123 . S:TMP'="" RORSEG(24)=+TMP
124 . ;
125 . ;--- Store the segment
126 . D ADDSEG^RORHL7(.RORSEG)
127 ;
128 Q ERRCNT
Note: See TracBrowser for help on using the repository browser.