source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL2.m@ 701

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

revised back to 6/30/08 version

File size: 5.7 KB
Line 
1PSJHL2 ;BIR/RLW-PATIENT ID AND VISIT SEGMENTS ;22 Nov 1999 9:27 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**1,18,16,23,28,42,50,70,58,100,102,110,111,112,144,141**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191.
5 ; Reference to ^ORERR is supported by DBIA# 2187.
6 ;
7EN1(PSJHLDFN,PSOC,PSJORDER,PSREASON) ; start here
8 ; passed in are PSJHLDFN (patient ien)
9 ; PSJORDER* (order_file (N,P,V, etc))
10 ; PSOC* (order control code - NW for new order, OK to return filler number to OE/RR, OC for order canceled, SC for status change)
11 ; PSREASON* (text reason)
12 ; *=optional, only required if an order segment is also to be generated
13START ;
14 K ^TMP("PSJHLS",$J,"PS")
15 N CLERK,J,LIMIT,NAME,NEXT,NODE1,NODE2,NODE4,NOO,PSJCLEAR,PSJHINST,PSJHLSDT,PROVIDER,PSJI,ROOMBED,RXORDER,STATUS,UNDO,VERIFY,WARD
16 S RXORDER=PSJORDER,PSJORDER=$S((PSJORDER["N")!(PSJORDER["P"):"^PS(53.1,"_+PSJORDER,PSJORDER["V":"^PS(55,"_PSJHLDFN_",""IV"","_+PSJORDER,1:"^PS(55,"_PSJHLDFN_",5,"_+PSJORDER)_","
17 I RXORDER["P",$P($G(@(PSJORDER_"0)")),U,15)'=PSJHLDFN S ORDCON="Patient does not match/PSJHL2" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON) Q
18 S UNDO=$S("OC^CR"[PSOC:1,1:0)
19 D INIT,PID,PV1,ORC
20 D @$S("SN^SC^OC^OD^DR^CR^OH^OR^XX^ZC^XR"[PSOC:"EN1^PSJHL3(PSJHLDFN,PSOC,PSJORDER)",1:"CALL^PSJHLU(PSJI)")
21 I UNDO D UNDO
22 K ^TMP("PSJHLS",$J,"PS"),FIELD
23 Q
24 ;
25INIT ; initialize HL7 variables, set master file identification segment
26 ; PSJHLMTN = message type - ORR for messages sent as a response to an OE/RR event; ORM for "unsolicited" messages.
27 S PSJI=0,PSJHLMTN=$S($G(PSJHLMTN)]"":PSJHLMTN,1:"ORM")
28 D INIT^PSJHLU
29 S LIMIT=17 X PSJCLEAR
30 S FIELD(0)="MSH",FIELD(1)="^~\&",FIELD(2)="PHARMACY",FIELD(3)=$G(PSJHINST),FIELD(8)=PSJHLMTN
31 D SEGMENT^PSJHLU(LIMIT),DISPLAY
32 Q
33 ;
34PID ; get patient data, format PID SEGMENT
35 S LIMIT=22 X PSJCLEAR
36 S FIELD(0)="PID"
37 S FIELD(3)=PSJHLDFN
38 N DFN S DFN=PSJHLDFN D DEM^VADPT S FIELD(5)=VADM(1)
39 D SEGMENT^PSJHLU(LIMIT),DISPLAY
40 Q
41 ;
42PV1 ; get patient visit information, format PV1 segment
43 N PSJAPPT
44 S LIMIT=50 X PSJCLEAR
45 S FIELD(0)="PV1"
46 I PSJHLMTN="ORR" S FIELD(3)=LOC
47 I PSJHLMTN="ORM" D
48 .S LOC="",WARD=$G(^DPT(PSJHLDFN,.1)),LOC=$S($G(WARD)]"":$O(^SC("B",WARD,LOC)),1:LOC)
49 .I $G(LOC)="" D
50 .. N A
51 .. I RXORDER["P",($G(^PS(53.1,+RXORDER,"DSS"))) S A=^("DSS"),LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2)
52 .. I RXORDER["V",($G(^PS(55,PSJHLDFN,"IV",+RXORDER,"DSS"))) S A=^("DSS"),LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2)
53 .. I RXORDER["U",$G(^PS(55,PSJHLDFN,5,+RXORDER,8)) S A=^(8),LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2)
54 .I $G(LOC)]"" S ROOMBED=$G(^DPT(PSJHLDFN,.101)),LOC=LOC_"^"_ROOMBED
55 .S FIELD(3)=LOC I $G(PSJAPPT)]"" S FIELD(44)=$$FMTHL7^XLFDT(PSJAPPT)
56 S FIELD(2)=$S($G(CLASS)="O":CLASS,1:"I")
57 I FIELD(2)="I" N DFN S DFN=PSJHLDFN D INP^VADPT S FIELD(19)=VAIN(1)
58 D SEGMENT^PSJHLU(LIMIT),DISPLAY
59 Q
60 ;
61ORC ; order control segment
62 S LIMIT=18 X PSJCLEAR
63 Q:'$D(PSJORDER)!'$D(PSOC)
64 S NODE1=$G(@(PSJORDER_"0)")),NODE2=$G(@(PSJORDER_"2)"))
65 S NODE4=$G(@(PSJORDER_"4)"))
66 S FIELD(0)="ORC"
67 S FIELD(1)=PSOC
68 S FIELD(2)=$S(PSOC="SN":"",1:$P(NODE1,"^",21))_"^OR" I $P(FIELD(2),"^")=0 S $P(FIELD(2),"^")="" ; IV orders are created with a zero in the oerr order number, for some reason
69 S FIELD(3)=RXORDER_"^PS"
70 ; translate Pharmacy status code to HL7 status code, set in FIELD(5)
71 S STATUS=$S($G(PSJEXPOE):"E",(($P(NODE1,"^",17)]"")&(RXORDER["V")):($P(NODE1,"^",17)),($P(NODE1,"^",9)]""):$P(NODE1,"^",9),$G(PSIVCOPY):"DE",1:"")
72 ;BHW;Remedy HD0000000086717;If the order has a pending number, send pending status even if current status is Active.
73 I STATUS="A",RXORDER["P" S STATUS="N" D @STATUS S STATUS="A"
74 E D @STATUS
75 I STATUS="U",RXORDER["P" S FIELD(3)="^PS"
76 S FIELD(9)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE2,"^")),1:$$FMTHL7^XLFDT($P(NODE1,"^",16)))
77 S CLERK=$S(RXORDER["V":$P(NODE2,"^",11),1:$P(NODE4,"^",7))
78 S NAME=$P($G(^VA(200,+CLERK,0)),"^")
79 S FIELD(10)=CLERK_"^"_NAME
80 I PSOC="ZV"!($G(PSJBCBU)) S VERIFY=$P($G(NODE4),"^"),FIELD(11)=VERIFY_"^"_$P($G(^VA(200,+VERIFY,0)),"^"),FIELD(9)=$$FMTHL7^XLFDT($P(NODE4,"^",2))
81 S PROVIDER=$S($G(PSJDCPRV)]"":$G(PSJDCPRV),RXORDER["V":$P(NODE1,"^",6),1:$P(NODE1,"^",2)) K PSJDCPRV
82 S NAME=$P($G(^VA(200,+PROVIDER,0)),"^")
83 S FIELD(12)=PROVIDER_"^"_NAME
84 S FIELD(15)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE1,"^",2)),1:$$FMTHL7^XLFDT($P(NODE2,"^",2)))
85 I $S(RXORDER["V":$P(NODE2,"^",8)="R",1:$P(NODE1,"^",24)="R")
86 ; PSJ*5*141 - If this is a renewal order, update FIELD(10) with the person who entered the renewal order.
87 N FIELD9 S FIELD9=$$FMTHL7^XLFDT($$LASTREN^PSJLMPRI(PSJHLDFN,RXORDER)) I FIELD9>FIELD(9) S FIELD(9)=FIELD9,FIELD(15)=FIELD9,FIELD(10)=$$LASTRNBY^PSJLMPRI(PSJHLDFN,RXORDER)
88 S NOO=$S(PSJORDER["IV":$G(P("NAT")),(($G(PSJNOO)="")&($G(P("NAT"))]"")):$G(P("NAT")),1:$G(PSJNOO)),PSREASON=$S(NOO="D":"",1:$G(PSREASON))
89 S FIELD(16)=NOO_U_$S(NOO="P":"Telephoned",NOO="D":"Duplicate",NOO="X":"Rejected",NOO="A":"Auto",NOO="S":"Service Correction",NOO="W":"Written",NOO="V":"Verbal",NOO="E":"Physician Entered",NOO="I":"Policy",1:"")_U_"99ORN"_U_U_$G(PSREASON)_U
90 D SEGMENT^PSJHLU(LIMIT),DISPLAY
91 Q
92 ;
93DISPLAY ; just for testing
94 I $G(MSGTEST) W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|"
95 Q
96UNDO ;Undo Renew if Pending Renewal is dc'd
97 I RXORDER["P",(STATUS="D"),($G(PSJNOO)'="A"),($P(NODE1,U,24)="R") D ENBKOUT^PSJOREN(PSJHLDFN,RXORDER)
98 Q
99 ;
100A S FIELD(5)="CM" Q ; active
101D S FIELD(5)="DC" Q ; discontinued
102I S FIELD(5)="IP" Q ; incomplete
103N S FIELD(5)="IP" Q ; non-verified
104U S FIELD(5)="ZX" Q ; unreleased
105P S FIELD(5)="IP" Q ; pending
106DE S FIELD(5)="RP" Q ; discontinued (edit)
107E S FIELD(5)="ZE" Q ; expired
108H S FIELD(5)="HD" Q ; hold
109R S FIELD(5)="ZZ" Q ; renewed
110RE S FIELD(5)="CM" Q ; reinstated
111DR S FIELD(5)="DC" Q ; discontinued (renewal)
112O S FIELD(5)="HD" Q ; on call (is this kind of like HOLD?)
Note: See TracBrowser for help on using the repository browser.