PSJHL2 ;BIR/RLW-PATIENT ID AND VISIT SEGMENTS ; 9/24/12 3:17pm
;;5.0;INPATIENT MEDICATIONS;**1,18,16,23,28,42,50,70,58,100,102,110,111,112,144,141,134,279,391**;16 DEC 97;Build 2
;
; Reference to ^PS(55 is supported by DBIA# 2191.
; Reference to ^ORERR is supported by DBIA# 2187.
; Reference to ^ORHLESC IS supported by DBIA# 4922.
;
;*279 Add Clinic name to ORC.21 (Ordering institution) used to send
; to the BCBU contingent system.
;
EN1(PSJHLDFN,PSOC,PSJORDER,PSREASON) ; start here
; passed in are PSJHLDFN (patient ien)
; PSJORDER* (order_file (N,P,V, etc))
; PSOC* (order control code - NW for new order, OK to return filler number to OE/RR, OC for order canceled, SC for status change)
; PSREASON* (text reason)
; *=optional, only required if an order segment is also to be generated
START ;
K ^TMP("PSJHLS",$J,"PS")
N CLERK,J,LIMIT,NAME,NEXT,NODE1,NODE2,NODE4,NOO,PSJCLEAR,PSJHINST,PSJHLSDT,PROVIDER,PSJI,ROOMBED,RXORDER,STATUS,UNDO,VERIFY,WARD,PSGST,DUR
N NODE8,NODEDSS ;*279
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)_","
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
S UNDO=$S("OC^CR"[PSOC:1,1:0)
D INIT,PID,PV1,ORC
D @$S("SN^SC^OC^OD^DR^CR^OH^OR^XX^ZC^XR"[PSOC:"EN1^PSJHL3(PSJHLDFN,PSOC,PSJORDER)",1:"CALL^PSJHLU(PSJI)")
I UNDO D UNDO
K ^TMP("PSJHLS",$J,"PS"),FIELD
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=$S($G(PSJHLMTN)]"":PSJHLMTN,1:"ORM")
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 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 DEM^VADPT S FIELD(5)=VADM(1)
I '$G(PSJBCBU) S FIELD(5)=$$ESC^ORHLESC(FIELD(5))
D SEGMENT^PSJHLU(LIMIT),DISPLAY
Q
;
PV1 ; get patient visit information, format PV1 segment
N PSJAPPT
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)="" D
.N A
.I RXORDER["P",($G(^PS(53.1,+RXORDER,"DSS"))) S A=^("DSS") I (LOC="")!($P(A,"^",2)) S LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2)
.I RXORDER["V",($G(^PS(55,PSJHLDFN,"IV",+RXORDER,"DSS"))) S A=^("DSS") I (LOC="")!($P(A,"^",2)) S LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2)
.I RXORDER["U",$G(^PS(55,PSJHLDFN,5,+RXORDER,8)) S A=^(8) I (LOC="")!($P(A,"^",2)) S LOC=$P(A,"^"),PSJAPPT=$P(A,"^",2)
.I $G(LOC)]"" S ROOMBED=$G(^DPT(PSJHLDFN,.101)) S LOC=LOC_"^"_$S($G(PSJBCBU):ROOMBED,1:$$ESC^ORHLESC(ROOMBED))
.S FIELD(3)=LOC I $G(PSJAPPT)]"" S FIELD(44)=$$FMTHL7^XLFDT(PSJAPPT)
S FIELD(2)=$S($G(CLASS)="O":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
S LIMIT=21 X PSJCLEAR ;*279 mod from 18 to 21
Q:'$D(PSJORDER)!'$D(PSOC)
S NODE1=$G(@(PSJORDER_"0)")),NODE2=$G(@(PSJORDER_"2)"))
S NODE4=$G(@(PSJORDER_"4)"))
;*270 add clinic appt node
I RXORDER["U" S NODE8=$G(@(PSJORDER_"8)"))
I (RXORDER["V")!(RXORDER["P") S NODEDSS=$G(@(PSJORDER_"""DSS"")"))
;
I $G(PSGST)="" N PSGST D
.S PSGST=$P($G(NODE1),"^",7)
S FIELD(0)="ORC"
S FIELD(1)=PSOC
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
S FIELD(3)=RXORDER_"^PS"
; translate Pharmacy status code to HL7 status code, set in FIELD(5)
S STATUS=$S($G(PSJEXPOE):"E",(($P(NODE1,"^",17)]"")&(RXORDER["V")):($P(NODE1,"^",17)),($P(NODE1,"^",9)]""):$P(NODE1,"^",9),$G(PSIVCOPY):"DE",1:"")
;BHW;Remedy HD0000000086717;If the order has a pending number, send pending status even if current status is Active.
I STATUS="A",RXORDER["P" S STATUS="N" D @STATUS S STATUS="A"
E D @STATUS
I STATUS="U",RXORDER["P" S FIELD(3)="^PS"
S FIELD(7)="^"_$S(RXORDER["V":$P(NODE1,"^",9)_"&"_$P(NODE1,"^",11),1:$P(NODE2,"^")_"&"_$P(NODE2,"^",5))_"^^^^^"_$G(PSGST)
S FIELD(9)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE2,"^")),1:$$FMTHL7^XLFDT($P(NODE1,"^",16)))
S CLERK=$S(RXORDER["V":$P(NODE2,"^",11),1:$P(NODE4,"^",7))
S NAME=$P($G(^VA(200,+CLERK,0)),"^")
S FIELD(10)=CLERK_"^"_$S($G(PSJBCBU):NAME,1:$$ESC^ORHLESC(NAME))
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))
S PROVIDER=$S($G(PSJDCPRV)]"":$G(PSJDCPRV),RXORDER["V":$P(NODE1,"^",6),1:$P(NODE1,"^",2)) K PSJDCPRV
S NAME=$P($G(^VA(200,+PROVIDER,0)),"^")
S FIELD(12)=PROVIDER_"^"_NAME
S FIELD(15)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE1,"^",2)),1:$$FMTHL7^XLFDT($P(NODE2,"^",2)))
I $S(RXORDER["V":$P(NODE2,"^",8)="R",1:$P(NODE1,"^",24)="R")
; PSJ*5*141 - If this is a renewal order, update FIELD(10) with the person who entered the renewal order.
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)
; PSJ*5*391 - Modified the following 2 lines to correct Nature of Order mismatch between IPMEDS and CPRS for IVs
I ((RXORDER["P")!(RXORDER["N")) S NOO=$S(($P(NODE1,U,4)["F")!($P(NODE1,U,4)["H"):$G(P("NAT")),(($G(PSJNOO)="")&($G(P("NAT"))]"")):$G(P("NAT")),1:$G(PSJNOO)),PSREASON=$S(NOO="D":"",1:$G(PSREASON))
E 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))
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
;*279 is clinic order? if so save clinic name
I $D(NODE8),$P(NODE8,U)]"",$P(NODE8,U,2) D
.S FIELD(21)=$S($D(^SC($P(NODE8,U),0)):$P(^(0),"^"),1:"")
I $D(NODEDSS),$P(NODEDSS,U)]"",$P(NODEDSS,U,2) D
.S FIELD(21)=$S($D(^SC($P(NODEDSS,U),0)):$P(^(0),"^"),1:"")
;
D SEGMENT^PSJHLU(LIMIT),DISPLAY
Q
;
DISPLAY ; just for testing
I $G(MSGTEST) W ! F NEXT=0:1:LIMIT W FIELD(NEXT)_"|"
Q
UNDO ;Undo Renew if Pending Renewal is dc'd
I RXORDER["P",(STATUS="D"),($G(PSJNOO)'="A"),($P(NODE1,U,24)="R") D ENBKOUT^PSJOREN(PSJHLDFN,RXORDER)
Q
;
A S FIELD(5)="CM" Q ; active
D S FIELD(5)="DC" Q ; discontinued
I S FIELD(5)="IP" Q ; incomplete
N S FIELD(5)="IP" Q ; non-verified
U S FIELD(5)="ZX" Q ; unreleased
P S FIELD(5)="IP" Q ; pending
DE S FIELD(5)="RP" Q ; discontinued (edit)
E S FIELD(5)="ZE" Q ; expired
H S FIELD(5)="HD" Q ; hold
R S FIELD(5)="ZZ" Q ; renewed
RE S FIELD(5)="CM" Q ; reinstated
DR S FIELD(5)="DC" Q ; discontinued (renewal)
O S FIELD(5)="HD" Q ; on call (is this kind of like HOLD?)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJHL2 7370 printed Sep 23, 2025@19:43:03 Page 2
PSJHL2 ;BIR/RLW-PATIENT ID AND VISIT SEGMENTS ; 9/24/12 3:17pm
+1 ;;5.0;INPATIENT MEDICATIONS;**1,18,16,23,28,42,50,70,58,100,102,110,111,112,144,141,134,279,391**;16 DEC 97;Build 2
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191.
+4 ; Reference to ^ORERR is supported by DBIA# 2187.
+5 ; Reference to ^ORHLESC IS supported by DBIA# 4922.
+6 ;
+7 ;*279 Add Clinic name to ORC.21 (Ordering institution) used to send
+8 ; to the BCBU contingent system.
+9 ;
EN1(PSJHLDFN,PSOC,PSJORDER,PSREASON) ; start here
+1 ; passed in are PSJHLDFN (patient ien)
+2 ; PSJORDER* (order_file (N,P,V, etc))
+3 ; PSOC* (order control code - NW for new order, OK to return filler number to OE/RR, OC for order canceled, SC for status change)
+4 ; PSREASON* (text reason)
+5 ; *=optional, only required if an order segment is also to be generated
START ;
+1 KILL ^TMP("PSJHLS",$JOB,"PS")
+2 NEW CLERK,J,LIMIT,NAME,NEXT,NODE1,NODE2,NODE4,NOO,PSJCLEAR,PSJHINST,PSJHLSDT,PROVIDER,PSJI,ROOMBED,RXORDER,STATUS,UNDO,VERIFY,WARD,PSGST,DUR
+3 ;*279
NEW NODE8,NODEDSS
+4 SET RXORDER=PSJORDER
SET PSJORDER=$SELECT((PSJORDER["N")!(PSJORDER["P"):"^PS(53.1,"_+PSJORDER,PSJORDER["V":"^PS(55,"_PSJHLDFN_",""IV"","_+PSJORDER,1:"^PS(55,"_PSJHLDFN_",5,"_+PSJORDER)_","
+5 IF RXORDER["P"
IF $PIECE($GET(@(PSJORDER_"0)")),U,15)'=PSJHLDFN
SET ORDCON="Patient does not match/PSJHL2"
SET X="ORERR"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^ORERR(ORDCON)
QUIT
+6 SET UNDO=$SELECT("OC^CR"[PSOC:1,1:0)
+7 DO INIT
DO PID
DO PV1
DO ORC
+8 DO @$SELECT("SN^SC^OC^OD^DR^CR^OH^OR^XX^ZC^XR"[PSOC:"EN1^PSJHL3(PSJHLDFN,PSOC,PSJORDER)",1:"CALL^PSJHLU(PSJI)")
+9 IF UNDO
DO UNDO
+10 KILL ^TMP("PSJHLS",$JOB,"PS"),FIELD
+11 QUIT
+12 ;
INIT ; initialize HL7 variables, set master file identification segment
+1 ; PSJHLMTN = message type - ORR for messages sent as a response to an OE/RR event; ORM for "unsolicited" messages.
+2 SET PSJI=0
SET PSJHLMTN=$SELECT($GET(PSJHLMTN)]"":PSJHLMTN,1:"ORM")
+3 DO INIT^PSJHLU
+4 SET LIMIT=17
XECUTE PSJCLEAR
+5 SET FIELD(0)="MSH"
SET FIELD(1)="^~\&"
SET FIELD(2)="PHARMACY"
SET FIELD(3)=$GET(PSJHINST)
SET FIELD(8)=PSJHLMTN
+6 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+7 QUIT
+8 ;
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 DEM^VADPT
SET FIELD(5)=VADM(1)
+5 IF '$GET(PSJBCBU)
SET FIELD(5)=$$ESC^ORHLESC(FIELD(5))
+6 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+7 QUIT
+8 ;
PV1 ; get patient visit information, format PV1 segment
+1 NEW PSJAPPT
+2 SET LIMIT=50
XECUTE PSJCLEAR
+3 SET FIELD(0)="PV1"
+4 IF PSJHLMTN="ORR"
SET FIELD(3)=LOC
+5 IF PSJHLMTN="ORM"
Begin DoDot:1
+6 SET LOC=""
SET WARD=$GET(^DPT(PSJHLDFN,.1))
SET LOC=$SELECT($GET(WARD)]"":$ORDER(^SC("B",WARD,LOC)),1:LOC)
+7 ;I $G(LOC)="" D
+8 NEW A
+9 IF RXORDER["P"
IF ($GET(^PS(53.1,+RXORDER,"DSS")))
SET A=^("DSS")
IF (LOC="")!($PIECE(A,"^",2))
SET LOC=$PIECE(A,"^")
SET PSJAPPT=$PIECE(A,"^",2)
+10 IF RXORDER["V"
IF ($GET(^PS(55,PSJHLDFN,"IV",+RXORDER,"DSS")))
SET A=^("DSS")
IF (LOC="")!($PIECE(A,"^",2))
SET LOC=$PIECE(A,"^")
SET PSJAPPT=$PIECE(A,"^",2)
+11 IF RXORDER["U"
IF $GET(^PS(55,PSJHLDFN,5,+RXORDER,8))
SET A=^(8)
IF (LOC="")!($PIECE(A,"^",2))
SET LOC=$PIECE(A,"^")
SET PSJAPPT=$PIECE(A,"^",2)
+12 IF $GET(LOC)]""
SET ROOMBED=$GET(^DPT(PSJHLDFN,.101))
SET LOC=LOC_"^"_$SELECT($GET(PSJBCBU):ROOMBED,1:$$ESC^ORHLESC(ROOMBED))
+13 SET FIELD(3)=LOC
IF $GET(PSJAPPT)]""
SET FIELD(44)=$$FMTHL7^XLFDT(PSJAPPT)
End DoDot:1
+14 SET FIELD(2)=$SELECT($GET(CLASS)="O":CLASS,1:"I")
+15 IF FIELD(2)="I"
NEW DFN
SET DFN=PSJHLDFN
DO INP^VADPT
SET FIELD(19)=VAIN(1)
+16 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+17 QUIT
+18 ;
ORC ; order control segment
+1 ;*279 mod from 18 to 21
SET LIMIT=21
XECUTE PSJCLEAR
+2 if '$DATA(PSJORDER)!'$DATA(PSOC)
QUIT
+3 SET NODE1=$GET(@(PSJORDER_"0)"))
SET NODE2=$GET(@(PSJORDER_"2)"))
+4 SET NODE4=$GET(@(PSJORDER_"4)"))
+5 ;*270 add clinic appt node
+6 IF RXORDER["U"
SET NODE8=$GET(@(PSJORDER_"8)"))
+7 IF (RXORDER["V")!(RXORDER["P")
SET NODEDSS=$GET(@(PSJORDER_"""DSS"")"))
+8 ;
+9 IF $GET(PSGST)=""
NEW PSGST
Begin DoDot:1
+10 SET PSGST=$PIECE($GET(NODE1),"^",7)
End DoDot:1
+11 SET FIELD(0)="ORC"
+12 SET FIELD(1)=PSOC
+13 ; IV orders are created with a zero in the oerr order number, for some reason
SET FIELD(2)=$SELECT(PSOC="SN":"",1:$PIECE(NODE1,"^",21))_"^OR"
IF $PIECE(FIELD(2),"^")=0
SET $PIECE(FIELD(2),"^")=""
+14 SET FIELD(3)=RXORDER_"^PS"
+15 ; translate Pharmacy status code to HL7 status code, set in FIELD(5)
+16 SET STATUS=$SELECT($GET(PSJEXPOE):"E",(($PIECE(NODE1,"^",17)]"")&(RXORDER["V")):($PIECE(NODE1,"^",17)),($PIECE(NODE1,"^",9)]""):$PIECE(NODE1,"^",9),$GET(PSIVCOPY):"DE",1:"")
+17 ;BHW;Remedy HD0000000086717;If the order has a pending number, send pending status even if current status is Active.
+18 IF STATUS="A"
IF RXORDER["P"
SET STATUS="N"
DO @STATUS
SET STATUS="A"
+19 IF '$TEST
DO @STATUS
+20 IF STATUS="U"
IF RXORDER["P"
SET FIELD(3)="^PS"
+21 SET FIELD(7)="^"_$SELECT(RXORDER["V":$PIECE(NODE1,"^",9)_"&"_$PIECE(NODE1,"^",11),1:$PIECE(NODE2,"^")_"&"_$PIECE(NODE2,"^",5))_"^^^^^"_$GET(PSGST)
+22 SET FIELD(9)=$SELECT(RXORDER["V":$$FMTHL7^XLFDT($PIECE(NODE2,"^")),1:$$FMTHL7^XLFDT($PIECE(NODE1,"^",16)))
+23 SET CLERK=$SELECT(RXORDER["V":$PIECE(NODE2,"^",11),1:$PIECE(NODE4,"^",7))
+24 SET NAME=$PIECE($GET(^VA(200,+CLERK,0)),"^")
+25 SET FIELD(10)=CLERK_"^"_$SELECT($GET(PSJBCBU):NAME,1:$$ESC^ORHLESC(NAME))
+26 IF PSOC="ZV"!($GET(PSJBCBU))
SET VERIFY=$PIECE($GET(NODE4),"^")
SET FIELD(11)=VERIFY_"^"_$SELECT($GET(PSJBCBU):$PIECE($GET(^VA(200,+VERIFY,0)),"^"),1:$$ESC^ORHLESC($PIECE($GET(^VA(200,+VERIFY,0)),"^")))
SET FIELD(9)=$$FMTHL7^XLFDT($PIECE(NODE4,"^",2))
+27 SET PROVIDER=$SELECT($GET(PSJDCPRV)]"":$GET(PSJDCPRV),RXORDER["V":$PIECE(NODE1,"^",6),1:$PIECE(NODE1,"^",2))
KILL PSJDCPRV
+28 SET NAME=$PIECE($GET(^VA(200,+PROVIDER,0)),"^")
+29 SET FIELD(12)=PROVIDER_"^"_NAME
+30 SET FIELD(15)=$SELECT(RXORDER["V":$$FMTHL7^XLFDT($PIECE(NODE1,"^",2)),1:$$FMTHL7^XLFDT($PIECE(NODE2,"^",2)))
+31 IF $SELECT(RXORDER["V":$PIECE(NODE2,"^",8)="R",1:$PIECE(NODE1,"^",24)="R")
+32 ; PSJ*5*141 - If this is a renewal order, update FIELD(10) with the person who entered the renewal order.
+33 NEW FIELD9
SET FIELD9=$$FMTHL7^XLFDT($$LASTREN^PSJLMPRI(PSJHLDFN,RXORDER))
IF FIELD9>FIELD(9)
SET FIELD(9)=FIELD9
SET FIELD(15)=FIELD9
SET FIELD(10)=$$LASTRNBY^PSJLMPRI(PSJHLDFN,RXORDER)
+34 ; PSJ*5*391 - Modified the following 2 lines to correct Nature of Order mismatch between IPMEDS and CPRS for IVs
+35 IF ((RXORDER["P")!(RXORDER["N"))
SET NOO=$SELECT(($PIECE(NODE1,U,4)["F")!($PIECE(NODE1,U,4)["H"):$GET(P("NAT")),(($GET(PSJNOO)="")&($GET(P("NAT"))]"")):$GET(P("NAT")),1:$GET(PSJNOO))
SET PSREASON=$SELECT(NOO="D":"",1:$GET(PSREASON))
+36 IF '$TEST
SET NOO=$SELECT(PSJORDER["IV":$GET(P("NAT")),(($GET(PSJNOO)="")&($GET(P("NAT"))]"")):$GET(P("NAT")),1:$GET(PSJNOO))
SET PSREASON=$SELECT(NOO="D":"",1:$GET(PSREASON))
+37 SET FIELD(16)=NOO_U_$SELECT(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_$GET(PSREASO
N)_U
+38 ;*279 is clinic order? if so save clinic name
+39 IF $DATA(NODE8)
IF $PIECE(NODE8,U)]""
IF $PIECE(NODE8,U,2)
Begin DoDot:1
+40 SET FIELD(21)=$SELECT($DATA(^SC($PIECE(NODE8,U),0)):$PIECE(^(0),"^"),1:"")
End DoDot:1
+41 IF $DATA(NODEDSS)
IF $PIECE(NODEDSS,U)]""
IF $PIECE(NODEDSS,U,2)
Begin DoDot:1
+42 SET FIELD(21)=$SELECT($DATA(^SC($PIECE(NODEDSS,U),0)):$PIECE(^(0),"^"),1:"")
End DoDot:1
+43 ;
+44 DO SEGMENT^PSJHLU(LIMIT)
DO DISPLAY
+45 QUIT
+46 ;
DISPLAY ; just for testing
+1 IF $GET(MSGTEST)
WRITE !
FOR NEXT=0:1:LIMIT
WRITE FIELD(NEXT)_"|"
+2 QUIT
UNDO ;Undo Renew if Pending Renewal is dc'd
+1 IF RXORDER["P"
IF (STATUS="D")
IF ($GET(PSJNOO)'="A")
IF ($PIECE(NODE1,U,24)="R")
DO ENBKOUT^PSJOREN(PSJHLDFN,RXORDER)
+2 QUIT
+3 ;
A ; active
SET FIELD(5)="CM"
QUIT
D ; discontinued
SET FIELD(5)="DC"
QUIT
I ; incomplete
SET FIELD(5)="IP"
QUIT
N ; non-verified
SET FIELD(5)="IP"
QUIT
U ; unreleased
SET FIELD(5)="ZX"
QUIT
P ; pending
SET FIELD(5)="IP"
QUIT
DE ; discontinued (edit)
SET FIELD(5)="RP"
QUIT
E ; expired
SET FIELD(5)="ZE"
QUIT
H ; hold
SET FIELD(5)="HD"
QUIT
R ; renewed
SET FIELD(5)="ZZ"
QUIT
RE ; reinstated
SET FIELD(5)="CM"
QUIT
DR ; discontinued (renewal)
SET FIELD(5)="DC"
QUIT
O ; on call (is this kind of like HOLD?)
SET FIELD(5)="HD"
QUIT
