69 lines
2.3 KiB
Mathematica
69 lines
2.3 KiB
Mathematica
|
PSJHLERR ;BIR/LDT-PATIENT ID AND VISIT SEGMENTS FOR ERRORS ; 20 Apr 98 / 9:58 AM
|
||
|
|
;;5.0; INPATIENT MEDICATIONS ;**1,42**;16 DEC 97
|
||
|
|
;
|
||
|
|
;Only used for error messages to OE/RR where the Pharmacy order
|
||
|
|
;number is invalid.
|
||
|
|
EN1(PSJHLDFN,PSOC,RXORDER,PSREASON) ; start here
|
||
|
|
; passed in are PSJHLDFN (patient ien)
|
||
|
|
; RXORDER (order number from OE/RR)
|
||
|
|
; PSOC (order control code)
|
||
|
|
; PSREASON (text reason)
|
||
|
|
START ;
|
||
|
|
K ^TMP("PSJHLS",$J,"PS")
|
||
|
|
N WARD,ROOMBED,FIELD,PSJI,CLERK,LIMIT,PSJHLSDT,PSJHINST,PSJHLMTN
|
||
|
|
D INIT,PID,PV1,ORC
|
||
|
|
D CALL^PSJHLU(PSJI)
|
||
|
|
K PSJI,PSOC,PSJCLEAR,PSREASON,J,NEXT,RXORDER
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
INIT ; initialize HL7 variables, set master file identification segment
|
||
|
|
; PSJHLMTN = message type - ORR for messages sent as a response to
|
||
|
|
; an OE/RR event; ORM for "unsolicited" messages.
|
||
|
|
S PSJI=0,PSJHLMTN="ORR"
|
||
|
|
D INIT^PSJHLU
|
||
|
|
S LIMIT=17 X PSJCLEAR
|
||
|
|
S FIELD(0)="MSH",FIELD(1)="^~\&",FIELD(2)="PHARMACY",FIELD(3)=$G(PSJHINST),FIELD(8)=PSJHLMTN
|
||
|
|
D NOW^%DTC S FIELD(4)="ORDER ENTRY",FIELD(5)=FIELD(3),FIELD(6)=$$HLDATE^HLFNC(%)
|
||
|
|
D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PID ; get patient data, format PID SEGMENT
|
||
|
|
S LIMIT=22 X PSJCLEAR
|
||
|
|
S FIELD(0)="PID"
|
||
|
|
S FIELD(3)=PSJHLDFN
|
||
|
|
N DFN S DFN=PSJHLDFN D ^VADPT S FIELD(5)=VADM(1)
|
||
|
|
D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PV1 ; get patient visit information, format PV1 segment
|
||
|
|
S LIMIT=50 X PSJCLEAR
|
||
|
|
S FIELD(0)="PV1"
|
||
|
|
I PSJHLMTN="ORR" S FIELD(3)=LOC
|
||
|
|
I PSJHLMTN="ORM" D
|
||
|
|
.S LOC="",WARD=$G(^DPT(PSJHLDFN,.1)),LOC=$S($G(WARD)]"":$O(^SC("B",WARD,LOC)),1:LOC)
|
||
|
|
.I $G(LOC)]"" S ROOMBED=$G(^DPT(PSJHLDFN,.101)),LOC=LOC_"^"_ROOMBED
|
||
|
|
.S FIELD(3)=LOC
|
||
|
|
S FIELD(2)=$S($G(CLASS)]"":CLASS,1:"I")
|
||
|
|
I FIELD(2)="I" N DFN S DFN=PSJHLDFN D INP^VADPT S FIELD(19)=VAIN(1)
|
||
|
|
D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
ORC ; order control segment - modified for use with error messages.
|
||
|
|
S LIMIT=18 X PSJCLEAR
|
||
|
|
Q:'$D(RXORDER)!'$D(PSOC)
|
||
|
|
S FIELD(0)="ORC"
|
||
|
|
S FIELD(1)=PSOC
|
||
|
|
S FIELD(2)=RXORDER_"^OR"
|
||
|
|
S FIELD(3)=$S(PSOC="ZR":$G(RXON),1:"")_"^PS"
|
||
|
|
S CLERK=$P($G(^VA(200,DUZ,0)),"^")
|
||
|
|
S FIELD(10)=DUZ_"^"_CLERK_"^"_"99NP"
|
||
|
|
;Nature of Order is X - Rejected on error messages,unless the message
|
||
|
|
;is in response to a purge message.
|
||
|
|
S FIELD(16)=$S(PSOC="ZR":U_U,1:"X"_U_"Rejected")_U_"99ORN"_U_U_$G(PSREASON)_U
|
||
|
|
D SEGMENT^PSJHLU(LIMIT),DISPLAY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DISPLAY ; just for testing
|
||
|
|
;W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|"
|
||
|
|
Q
|