1 | PSJHLERR ;BIR/LDT-PATIENT ID AND VISIT SEGMENTS FOR ERRORS ; 20 Apr 98 / 9:58 AM
|
---|
2 | ;;5.0; INPATIENT MEDICATIONS ;**1,42**;16 DEC 97
|
---|
3 | ;
|
---|
4 | ;Only used for error messages to OE/RR where the Pharmacy order
|
---|
5 | ;number is invalid.
|
---|
6 | EN1(PSJHLDFN,PSOC,RXORDER,PSREASON) ; start here
|
---|
7 | ; passed in are PSJHLDFN (patient ien)
|
---|
8 | ; RXORDER (order number from OE/RR)
|
---|
9 | ; PSOC (order control code)
|
---|
10 | ; PSREASON (text reason)
|
---|
11 | START ;
|
---|
12 | K ^TMP("PSJHLS",$J,"PS")
|
---|
13 | N WARD,ROOMBED,FIELD,PSJI,CLERK,LIMIT,PSJHLSDT,PSJHINST,PSJHLMTN
|
---|
14 | D INIT,PID,PV1,ORC
|
---|
15 | D CALL^PSJHLU(PSJI)
|
---|
16 | K PSJI,PSOC,PSJCLEAR,PSREASON,J,NEXT,RXORDER
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | INIT ; initialize HL7 variables, set master file identification segment
|
---|
20 | ; PSJHLMTN = message type - ORR for messages sent as a response to
|
---|
21 | ; an OE/RR event; ORM for "unsolicited" messages.
|
---|
22 | S PSJI=0,PSJHLMTN="ORR"
|
---|
23 | D INIT^PSJHLU
|
---|
24 | S LIMIT=17 X PSJCLEAR
|
---|
25 | S FIELD(0)="MSH",FIELD(1)="^~\&",FIELD(2)="PHARMACY",FIELD(3)=$G(PSJHINST),FIELD(8)=PSJHLMTN
|
---|
26 | D NOW^%DTC S FIELD(4)="ORDER ENTRY",FIELD(5)=FIELD(3),FIELD(6)=$$HLDATE^HLFNC(%)
|
---|
27 | D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
---|
28 | Q
|
---|
29 | ;
|
---|
30 | PID ; get patient data, format PID SEGMENT
|
---|
31 | S LIMIT=22 X PSJCLEAR
|
---|
32 | S FIELD(0)="PID"
|
---|
33 | S FIELD(3)=PSJHLDFN
|
---|
34 | N DFN S DFN=PSJHLDFN D ^VADPT S FIELD(5)=VADM(1)
|
---|
35 | D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | PV1 ; get patient visit information, format PV1 segment
|
---|
39 | S LIMIT=50 X PSJCLEAR
|
---|
40 | S FIELD(0)="PV1"
|
---|
41 | I PSJHLMTN="ORR" S FIELD(3)=LOC
|
---|
42 | I PSJHLMTN="ORM" D
|
---|
43 | .S LOC="",WARD=$G(^DPT(PSJHLDFN,.1)),LOC=$S($G(WARD)]"":$O(^SC("B",WARD,LOC)),1:LOC)
|
---|
44 | .I $G(LOC)]"" S ROOMBED=$G(^DPT(PSJHLDFN,.101)),LOC=LOC_"^"_ROOMBED
|
---|
45 | .S FIELD(3)=LOC
|
---|
46 | S FIELD(2)=$S($G(CLASS)]"":CLASS,1:"I")
|
---|
47 | I FIELD(2)="I" N DFN S DFN=PSJHLDFN D INP^VADPT S FIELD(19)=VAIN(1)
|
---|
48 | D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
---|
49 | Q
|
---|
50 | ;
|
---|
51 | ORC ; order control segment - modified for use with error messages.
|
---|
52 | S LIMIT=18 X PSJCLEAR
|
---|
53 | Q:'$D(RXORDER)!'$D(PSOC)
|
---|
54 | S FIELD(0)="ORC"
|
---|
55 | S FIELD(1)=PSOC
|
---|
56 | S FIELD(2)=RXORDER_"^OR"
|
---|
57 | S FIELD(3)=$S(PSOC="ZR":$G(RXON),1:"")_"^PS"
|
---|
58 | S CLERK=$P($G(^VA(200,DUZ,0)),"^")
|
---|
59 | S FIELD(10)=DUZ_"^"_CLERK_"^"_"99NP"
|
---|
60 | ;Nature of Order is X - Rejected on error messages,unless the message
|
---|
61 | ;is in response to a purge message.
|
---|
62 | S FIELD(16)=$S(PSOC="ZR":U_U,1:"X"_U_"Rejected")_U_"99ORN"_U_U_$G(PSREASON)_U
|
---|
63 | D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
---|
64 | Q
|
---|
65 | ;
|
---|
66 | DISPLAY ; just for testing
|
---|
67 | ;W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|"
|
---|
68 | Q
|
---|