- 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
- 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
