source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHLERR.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1PSJHLERR ;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.
6EN1(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)
11START ;
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 ;
19INIT ; 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 ;
30PID ; 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 ;
38PV1 ; 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 ;
51ORC ; 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 ;
66DISPLAY ; just for testing
67 ;W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|"
68 Q
Note: See TracBrowser for help on using the repository browser.