[613] | 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
|
---|