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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJHLERR 2433 printed Nov 22, 2024@17:17:09 Page 2
PSJHLERR ;BIR/LDT-PATIENT ID AND VISIT SEGMENTS FOR ERRORS ; 20 Apr 98 / 9:58 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**1,42**;16 DEC 97
+2 ;
+3 ;Only used for error messages to OE/RR where the Pharmacy order
+4 ;number is invalid.
EN1(PSJHLDFN,PSOC,RXORDER,PSREASON) ; start here
+1 ; passed in are PSJHLDFN (patient ien)
+2 ; RXORDER (order number from OE/RR)
+3 ; PSOC (order control code)
+4 ; PSREASON (text reason)
START ;
+1 KILL ^TMP("PSJHLS",$JOB,"PS")
+2 NEW WARD,ROOMBED,FIELD,PSJI,CLERK,LIMIT,PSJHLSDT,PSJHINST,PSJHLMTN
+3 DO INIT
DO PID
DO PV1
DO ORC
+4 DO CALL^PSJHLU(PSJI)
+5 KILL PSJI,PSOC,PSJCLEAR,PSREASON,J,NEXT,RXORDER
+6 QUIT
+7 ;
INIT ; initialize HL7 variables, set master file identification segment
+1 ; PSJHLMTN = message type - ORR for messages sent as a response to
+2 ; an OE/RR event; ORM for "unsolicited" messages.
+3 SET PSJI=0
SET PSJHLMTN="ORR"
+4 DO INIT^PSJHLU
+5 SET LIMIT=17
XECUTE PSJCLEAR
+6 SET FIELD(0)="MSH"
SET FIELD(1)="^~\&"
SET FIELD(2)="PHARMACY"
SET FIELD(3)=$GET(PSJHINST)
SET FIELD(8)=PSJHLMTN
+7 DO NOW^%DTC
SET FIELD(4)="ORDER ENTRY"
SET FIELD(5)=FIELD(3)
SET FIELD(6)=$$HLDATE^HLFNC(%)
+8 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+9 QUIT
+10 ;
PID ; get patient data, format PID SEGMENT
+1 SET LIMIT=22
XECUTE PSJCLEAR
+2 SET FIELD(0)="PID"
+3 SET FIELD(3)=PSJHLDFN
+4 NEW DFN
SET DFN=PSJHLDFN
DO ^VADPT
SET FIELD(5)=VADM(1)
+5 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+6 QUIT
+7 ;
PV1 ; get patient visit information, format PV1 segment
+1 SET LIMIT=50
XECUTE PSJCLEAR
+2 SET FIELD(0)="PV1"
+3 IF PSJHLMTN="ORR"
SET FIELD(3)=LOC
+4 IF PSJHLMTN="ORM"
Begin DoDot:1
+5 SET LOC=""
SET WARD=$GET(^DPT(PSJHLDFN,.1))
SET LOC=$SELECT($GET(WARD)]"":$ORDER(^SC("B",WARD,LOC)),1:LOC)
+6 IF $GET(LOC)]""
SET ROOMBED=$GET(^DPT(PSJHLDFN,.101))
SET LOC=LOC_"^"_ROOMBED
+7 SET FIELD(3)=LOC
End DoDot:1
+8 SET FIELD(2)=$SELECT($GET(CLASS)]"":CLASS,1:"I")
+9 IF FIELD(2)="I"
NEW DFN
SET DFN=PSJHLDFN
DO INP^VADPT
SET FIELD(19)=VAIN(1)
+10 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+11 QUIT
+12 ;
ORC ; order control segment - modified for use with error messages.
+1 SET LIMIT=18
XECUTE PSJCLEAR
+2 if '$DATA(RXORDER)!'$DATA(PSOC)
QUIT
+3 SET FIELD(0)="ORC"
+4 SET FIELD(1)=PSOC
+5 SET FIELD(2)=RXORDER_"^OR"
+6 SET FIELD(3)=$SELECT(PSOC="ZR":$GET(RXON),1:"")_"^PS"
+7 SET CLERK=$PIECE($GET(^VA(200,DUZ,0)),"^")
+8 SET FIELD(10)=DUZ_"^"_CLERK_"^"_"99NP"
+9 ;Nature of Order is X - Rejected on error messages,unless the message
+10 ;is in response to a purge message.
+11 SET FIELD(16)=$SELECT(PSOC="ZR":U_U,1:"X"_U_"Rejected")_U_"99ORN"_U_U_$GET(PSREASON)_U
+12 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+13 QUIT
+14 ;
DISPLAY ; just for testing
+1 ;W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|"
+2 QUIT
