source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL07.m@ 1783

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

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