- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL2.m
r613 r623 1 PSJHL2 ;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,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(55 is supported by DBIA# 2191. 5 ; Reference to ^ORERR is supported by DBIA# 2187. 6 ; Reference to ^ORHLESC IS supported by DBIA# 4922. 7 ; 8 EN1(PSJHLDFN,PSOC,PSJORDER,PSREASON) ; start here 9 ; passed in are PSJHLDFN (patient ien) 10 ; PSJORDER* (order_file (N,P,V, etc)) 11 ; PSOC* (order control code - NW for new order, OK to return filler number to OE/RR, OC for order canceled, SC for status change) 12 ; PSREASON* (text reason) 13 ; *=optional, only required if an order segment is also to be generated 14 START ; 15 K ^TMP("PSJHLS",$J,"PS") 16 N CLERK,J,LIMIT,NAME,NEXT,NODE1,NODE2,NODE4,NOO,PSJCLEAR,PSJHINST,PSJHLSDT,PROVIDER,PSJI,ROOMBED,RXORDER,STATUS,UNDO,VERIFY,WARD,PSGST,DUR 17 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)_"," 18 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 19 S UNDO=$S("OC^CR"[PSOC:1,1:0) 20 D INIT,PID,PV1,ORC 21 D @$S("SN^SC^OC^OD^DR^CR^OH^OR^XX^ZC^XR"[PSOC:"EN1^PSJHL3(PSJHLDFN,PSOC,PSJORDER)",1:"CALL^PSJHLU(PSJI)") 22 I UNDO D UNDO 23 K ^TMP("PSJHLS",$J,"PS"),FIELD 24 Q 25 ; 26 INIT ; initialize HL7 variables, set master file identification segment 27 ; PSJHLMTN = message type - ORR for messages sent as a response to an OE/RR event; ORM for "unsolicited" messages. 28 S PSJI=0,PSJHLMTN=$S($G(PSJHLMTN)]"":PSJHLMTN,1:"ORM") 29 D INIT^PSJHLU 30 S LIMIT=17 X PSJCLEAR 31 S FIELD(0)="MSH",FIELD(1)="^~\&",FIELD(2)="PHARMACY",FIELD(3)=$G(PSJHINST),FIELD(8)=PSJHLMTN 32 D SEGMENT^PSJHLU(LIMIT),DISPLAY 33 Q 34 ; 35 PID ; get patient data, format PID SEGMENT 36 S LIMIT=22 X PSJCLEAR 37 S FIELD(0)="PID" 38 S FIELD(3)=PSJHLDFN 39 N DFN S DFN=PSJHLDFN D DEM^VADPT S FIELD(5)=VADM(1) 40 I '$G(PSJBCBU) S FIELD(5)=$$ESC^ORHLESC(FIELD(5)) 41 D SEGMENT^PSJHLU(LIMIT),DISPLAY 42 Q 43 ; 44 PV1 ; get patient visit information, format PV1 segment 45 N PSJAPPT 46 S LIMIT=50 X PSJCLEAR 47 S FIELD(0)="PV1" 48 I PSJHLMTN="ORR" S FIELD(3)=LOC 49 I PSJHLMTN="ORM" D 50 .S LOC="",WARD=$G(^DPT(PSJHLDFN,.1)),LOC=$S($G(WARD)]"":$O(^SC("B",WARD,LOC)),1:LOC) 51 .I $G(LOC)="" D 52 .. N A 53 .. I RXORDER["P",($G(^PS(53.1,+RXORDER,"DSS"))) S A=^("DSS"),LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2) 54 .. I RXORDER["V",($G(^PS(55,PSJHLDFN,"IV",+RXORDER,"DSS"))) S A=^("DSS"),LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2) 55 .. I RXORDER["U",$G(^PS(55,PSJHLDFN,5,+RXORDER,8)) S A=^(8),LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2) 56 .I $G(LOC)]"" S ROOMBED=$G(^DPT(PSJHLDFN,.101)) S LOC=LOC_"^"_$S($G(PSJBCBU):ROOMBED,1:$$ESC^ORHLESC(ROOMBED)) 57 .S FIELD(3)=LOC I $G(PSJAPPT)]"" S FIELD(44)=$$FMTHL7^XLFDT(PSJAPPT) 58 S FIELD(2)=$S($G(CLASS)="O":CLASS,1:"I") 59 I FIELD(2)="I" N DFN S DFN=PSJHLDFN D INP^VADPT S FIELD(19)=VAIN(1) 60 D SEGMENT^PSJHLU(LIMIT),DISPLAY 61 Q 62 ; 63 ORC ; order control segment 64 S LIMIT=18 X PSJCLEAR 65 Q:'$D(PSJORDER)!'$D(PSOC) 66 S NODE1=$G(@(PSJORDER_"0)")),NODE2=$G(@(PSJORDER_"2)")) 67 S NODE4=$G(@(PSJORDER_"4)")) 68 I $G(PSGST)="" N PSGST D 69 .S PSGST=$P($G(NODE1),"^",7) 70 S FIELD(0)="ORC" 71 S FIELD(1)=PSOC 72 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 73 S FIELD(3)=RXORDER_"^PS" 74 ; translate Pharmacy status code to HL7 status code, set in FIELD(5) 75 S STATUS=$S($G(PSJEXPOE):"E",(($P(NODE1,"^",17)]"")&(RXORDER["V")):($P(NODE1,"^",17)),($P(NODE1,"^",9)]""):$P(NODE1,"^",9),$G(PSIVCOPY):"DE",1:"") 76 ;BHW;Remedy HD0000000086717;If the order has a pending number, send pending status even if current status is Active. 77 I STATUS="A",RXORDER["P" S STATUS="N" D @STATUS S STATUS="A" 78 E D @STATUS 79 I STATUS="U",RXORDER["P" S FIELD(3)="^PS" 80 S FIELD(7)="^"_$S(RXORDER["V":$P(NODE1,"^",9)_"&"_$P(NODE1,"^",11),1:$P(NODE2,"^")_"&"_$P(NODE2,"^",5))_"^^^^^"_$G(PSGST) 81 S FIELD(9)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE2,"^")),1:$$FMTHL7^XLFDT($P(NODE1,"^",16))) 82 S CLERK=$S(RXORDER["V":$P(NODE2,"^",11),1:$P(NODE4,"^",7)) 83 S NAME=$P($G(^VA(200,+CLERK,0)),"^") 84 S FIELD(10)=CLERK_"^"_$S($G(PSJBCBU):NAME,1:$$ESC^ORHLESC(NAME)) 85 I PSOC="ZV"!($G(PSJBCBU)) S VERIFY=$P($G(NODE4),"^"),FIELD(11)=VERIFY_"^"_$S($G(PSJBCBU):$P($G(^VA(200,+VERIFY,0)),"^"),1:$$ESC^ORHLESC($P($G(^VA(200,+VERIFY,0)),"^"))),FIELD(9)=$$FMTHL7^XLFDT($P(NODE4,"^",2)) 86 S PROVIDER=$S($G(PSJDCPRV)]"":$G(PSJDCPRV),RXORDER["V":$P(NODE1,"^",6),1:$P(NODE1,"^",2)) K PSJDCPRV 87 S NAME=$P($G(^VA(200,+PROVIDER,0)),"^") 88 S FIELD(12)=PROVIDER_"^"_NAME 89 S FIELD(15)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE1,"^",2)),1:$$FMTHL7^XLFDT($P(NODE2,"^",2))) 90 I $S(RXORDER["V":$P(NODE2,"^",8)="R",1:$P(NODE1,"^",24)="R") 91 ; PSJ*5*141 - If this is a renewal order, update FIELD(10) with the person who entered the renewal order. 92 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) 93 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)) 94 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 95 D SEGMENT^PSJHLU(LIMIT),DISPLAY 96 Q 97 ; 98 DISPLAY ; just for testing 99 I $G(MSGTEST) W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|" 100 Q 101 UNDO ;Undo Renew if Pending Renewal is dc'd 102 I RXORDER["P",(STATUS="D"),($G(PSJNOO)'="A"),($P(NODE1,U,24)="R") D ENBKOUT^PSJOREN(PSJHLDFN,RXORDER) 103 Q 104 ; 105 A S FIELD(5)="CM" Q ; active 106 D S FIELD(5)="DC" Q ; discontinued 107 I S FIELD(5)="IP" Q ; incomplete 108 N S FIELD(5)="IP" Q ; non-verified 109 U S FIELD(5)="ZX" Q ; unreleased 110 P S FIELD(5)="IP" Q ; pending 111 DE S FIELD(5)="RP" Q ; discontinued (edit) 112 E S FIELD(5)="ZE" Q ; expired 113 H S FIELD(5)="HD" Q ; hold 114 R S FIELD(5)="ZZ" Q ; renewed 115 RE S FIELD(5)="CM" Q ; reinstated 116 DR S FIELD(5)="DC" Q ; discontinued (renewal) 117 O S FIELD(5)="HD" Q ; on call (is this kind of like HOLD?) 1 PSJHL2 ;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 ; 7 EN1(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 13 START ; 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 ; 25 INIT ; 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 ; 34 PID ; 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 ; 42 PV1 ; 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 ; 61 ORC ; 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 ; 93 DISPLAY ; just for testing 94 I $G(MSGTEST) W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|" 95 Q 96 UNDO ;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 ; 100 A S FIELD(5)="CM" Q ; active 101 D S FIELD(5)="DC" Q ; discontinued 102 I S FIELD(5)="IP" Q ; incomplete 103 N S FIELD(5)="IP" Q ; non-verified 104 U S FIELD(5)="ZX" Q ; unreleased 105 P S FIELD(5)="IP" Q ; pending 106 DE S FIELD(5)="RP" Q ; discontinued (edit) 107 E S FIELD(5)="ZE" Q ; expired 108 H S FIELD(5)="HD" Q ; hold 109 R S FIELD(5)="ZZ" Q ; renewed 110 RE S FIELD(5)="CM" Q ; reinstated 111 DR S FIELD(5)="DC" Q ; discontinued (renewal) 112 O S FIELD(5)="HD" Q ; on call (is this kind of like HOLD?)
Note:
See TracChangeset
for help on using the changeset viewer.
