ORWDXR01 ;SLC/JDL - Utilities for Order Actions ;May 04, 2022@13:28:41
;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215,280,345,311,350,405**;Dec 17, 1997;Build 211
CANCHG(ORY,ORIFN,TXTOD) ;
;If it's an pending or unsigned unreleased renewed order, can edit=True
S ORY=0
Q:'$D(^OR(100,+ORIFN,0))
I TXTOD D TXTCAN(.ORY) Q
N OUTGRP,URELSTS,USIGSTS,RNTYPE,PDSTS
N ODGRP,ODREL,ODSIG,ODTYPE,LSTACT
S OUTGRP=$O(^ORD(100.98,"B","O RX",0))
S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
S PDSTS=$O(^ORD(100.01,"B","PENDING",0))
S USIGSTS=2 ; unsigned order
S RNTYPE=2 ; renew action
;Data from the order entry
S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
S ODGRP=$P($G(^OR(100,+ORIFN,0)),U,11)
S ODREL=$P($G(^OR(100,+ORIFN,3)),U,3)
S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
I (ODGRP=OUTGRP),(ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
Q
;
TXTCAN(ORY) ;
;if it's an unsigned unreleased renewed text order, can change=true
N URELSTS,USIGSTS,RNTYPE
N ODREL,ODSIG,ODTYPE,LSTACT
S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
S USIGSTS=2 ; unsigned order
S RNTYPE=2 ; renew action
;Data from the order entry
S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
S ODREL=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,15)
S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
I (ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
Q
;
SAVCHG(ORY,ORID,PARM1,PARM2,TXTOD,DAYSUP,QTY) ;
;save new changes on the unreleased unsigned renewed order
Q:'$D(^OR(100,+ORID,0))
;Update new start and stop date the text order
I TXTOD D TXTSAV(.ORY,ORID,PARM1,PARM2) Q
;Update new refills and pickup for the med order
N REFID,PICKID,SUPPLYID,QTYID,ACT,IX,TXT,REFPOS,NDQUIT
S (REFID,PICKID,ACT,REFPOS,NDQUIT)=0,ORY=""
S ACT=+$P(ORID,";",2) S:ACT'>0 ACT=1
S REFID=$O(^OR(100,+ORID,4.5,"ID","REFILLS",0))
S PICKID=$O(^OR(100,+ORID,4.5,"ID","PICKUP",0))
S SUPPLYID=$O(^OR(100,+ORID,4.5,"ID","SUPPLY",0))
S QTYID=$O(^OR(100,+ORID,4.5,"ID","QTY",0))
S:$D(^OR(100,+ORID,4.5,REFID,1)) ^(1)=PARM1
S:$D(^OR(100,+ORID,4.5,PICKID,1)) ^(1)=PARM2
S:$D(^OR(100,+ORID,4.5,+SUPPLYID,1)) ^(1)=$G(DAYSUP)
S:$D(^OR(100,+ORID,4.5,+QTYID,1)) ^(1)=$G(QTY)
S IX=0 F S IX=$O(^OR(100,+ORID,8,ACT,.1,IX)) Q:('IX)!(NDQUIT) D
. S TXT=$G(^OR(100,+ORID,8,ACT,.1,IX,0))
. I ($$UP^XLFSTR(TXT)["QUANTITY:"),($$UP^XLFSTR(TXT)["REFILLS:") D
. . ;S REFPOS=$F($$UP^XLFSTR(TXT),"REFILLS")-$L("REFILLS")-1
. . ;S TXT=$E(TXT,1,REFPOS)_"Refills: "_PARM1
. . S TXT=" Quantity: "_$G(QTY)_" Refills: "_$G(PARM1)
. . S ^OR(100,+ORID,8,ACT,.1,IX,0)=TXT,NDQUIT=1 Q
D GETBYIFN^ORWORR(.ORY,+ORID)
Q
;
TXTSAV(ORY,ORID,PARM1,PARM2) ;
; Update new start and stop date for the unsigned unreleased
; renewed text order
N STRTID,STOPID
S STRTID=$O(^OR(100,+ORID,4.5,"ID","START",0))
S STOPID=$O(^OR(100,+ORID,4.5,"ID","STOP",0))
S:$D(^OR(100,+ORID,4.5,STRTID,1)) ^(1)=PARM1
S:$D(^OR(100,+ORID,4.5,STOPID,1)) ^(1)=PARM2
D GETBYIFN^ORWORR(.ORY,+ORID)
Q
;
ISSPLY(ORY,DLGID,QODLG) ;
; ORY=1: is "PSO SUPPLY" dialog
N A,IFN
S ORY=""
S DLGID=$G(DLGID)
I DLGID?1"X".E S IFN=$E(DLGID,2,99),A=$P($G(^OR(100,+IFN,0)),"^",5) D
. I $P(A,";",2)[101.41 S DLGID=+A Q
. S DLGID=0
Q:+DLGID=0
Q:'$D(^ORD(101.41,DLGID,0))
I 'QODLG,($P(^ORD(101.41,DLGID,0),U)="PSO SUPPLY") S ORY=1
I QODLG D
. N SPLYDG S SPLYDG=$O(^ORD(100.98,"B","SPLY",0))
. I $P(^ORD(101.41,DLGID,0),U,5)=SPLYDG S ORY=1
Q
;
OXDATA(ORY,ORIEN) ; Return orderable item data for order check usage
Q:'$D(^OR(100,+ORIEN,0))
D MAYBEIV(.ORY,ORIEN,1) I $L($G(ORY))>1 Q
N DISPSUP,DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPID
S (DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPSUP)=0
S DISPID=""
S DISPIN=$O(^ORD(100.98,"B","UD RX",0))
S DISPOUT=$O(^ORD(100.98,"B","O RX",0))
N DISPCM S DISPCM=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",0))
N DISPCMIV S DISPCMIV=$O(^ORD(100.98,"B","CLINIC INFUSIONS",0))
S DISPSUP=$O(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
S DRUGID=$O(^OR(100,+ORIEN,4.5,"ID","DRUG",0))
S OIID=$O(^OR(100,+ORIEN,4.5,"ID","ORDERABLE",0))
S DISPID=$P(^OR(100,+ORIEN,0),U,11)
I DISPID=DISPIN S DISPID="PSI"
I DISPID=DISPOUT S DISPID="PSO"
I DISPID=DISPCM S DISPID="PSI"
I DISPID=DISPCMIV S DISPID="PSI"
I DISPID=DISPSUP S DISPID="PSO"
I (DISPID'="PSI"),(DISPID'="PSO") Q
I 'DRUGID,DISPID="PSI" D
.N ORCHI S ORCHI=0 F S ORCHI=$O(^OR(100,+ORIEN,2,ORCHI)) Q:'ORCHI D
..N ORCHDRID,ORCHOIID,ORCHIDX,ORCHIDY
..S ORCHDRID=$O(^OR(100,+ORCHI,4.5,"ID","DRUG",0))
..S ORCHOIID=$O(^OR(100,+ORCHI,4.5,"ID","ORDERABLE",0))
..Q:'ORCHDRID
..Q:'ORCHOIID
..S ORCHIDX=$O(^OR(100,+ORCHI,4.5,ORCHDRID,0))
..S ORCHIDY=$O(^OR(100,+ORCHI,4.5,ORCHOIID,0))
..I ORCHIDX,ORCHIDY S ORY=$G(^OR(100,+ORCHI,4.5,ORCHOIID,ORCHIDY))_U_DISPID_U_$G(^OR(100,+ORCHI,4.5,ORCHDRID,ORCHIDX))_"|"_$G(ORY)
Q:'DRUGID
Q:'OIID
S IDX=$O(^OR(100,+ORIEN,4.5,DRUGID,0))
S IDY=$O(^OR(100,+ORIEN,4.5,OIID,0))
I IDX,IDY,'+DISPID S ORY=$G(^OR(100,+ORIEN,4.5,OIID,IDY))_U_DISPID_U_$G(^OR(100,+ORIEN,4.5,DRUGID,IDX))
Q
;
MAYBEIV(ORY,ORIEN,FORMAT) ; Return orderable item data for iv order check usage
;PARAMETERS: ORY => REFERENCE TO ARRAY THAT STORES ORDERABLE ITEM DATA
; ORIEN => ORDER NUMBER FROM ORDER FILE (#100)
; FORMAT => FLAG DENOTING WHICH FORMAT TO RETURN THE DATA IN:
; NULL OR ZERO - NEW FORMAT (USING PIPE DELMITER)
; 1 - OLD FORMAT (USING CAROT DELIMITER)
N X0,ORDIALOG,DELIMIT
S DELIMIT=$S($G(FORMAT):"|",1:U)
S X0=^OR(100,+ORIEN,0)
S ORDIALOG=+$P(X0,U,5)
D GETDLG^ORCD(ORDIALOG)
D GETORDER^ORCD(+ORIEN)
I $D(ORDIALOG("B","SOLUTION")) D
.N ORI,ORSUB
.S ORSUB=$P(ORDIALOG("B","SOLUTION"),U,2)
.S ORI=0 F S ORI=$O(ORDIALOG(ORSUB,ORI)) Q:'ORI D
..S:DELIMIT="|" ORY=$G(ORY)_"|"_$G(ORDIALOG(ORSUB,ORI))_U_"PSIV"_U_"B;"
..S:DELIMIT=U ORY=$G(ORY)_U_$G(ORDIALOG(ORSUB,ORI))_"|"_"PSIV"_"|"_ORSUB_"||"_ORIEN_"||"_"B"
I $D(ORDIALOG("B","ADDITIVE")) D
.N ORI,ORSUB
.S ORSUB=$P(ORDIALOG("B","ADDITIVE"),U,2)
.S ORI=0 F S ORI=$O(ORDIALOG(ORSUB,ORI)) Q:'ORI D
..S:DELIMIT="|" ORY=$G(ORY)_"|"_$G(ORDIALOG(ORSUB,ORI))_U_"PSIV"_U_"A"
..S:DELIMIT=U ORY=$G(ORY)_U_$G(ORDIALOG(ORSUB,ORI))_"|"_"PSIV"_"|"_ORSUB_"||"_ORIEN_"||"_"A"
I $L($G(ORY),DELIMIT)>1 S ORY=$P(ORY,DELIMIT,2,$L(ORY,DELIMIT))
Q
;
WARN(ORVAL,ORIFN,ORACTION) ; Should a warning be displayed for order action
;
S ORVAL=0
;
; Copy
I ORACTION="RW" D Q:ORVAL
. ; Return warning if copying outpatient med order marked for titration
. I $$ISTITR^ORUTL3(+ORIFN) D
. . S ORVAL="1^This prescription has been marked as a titration order. "
. . S ORVAL=ORVAL_"Creating a COPY of the order will repeat the titration instructions. "
. . S ORVAL=ORVAL_"If you only want to copy the maintenance portion, please use the RENEW action. "
. . S ORVAL=ORVAL_"Do you wish to proceed? "
;
; Change
I ORACTION="XX" D Q:ORVAL
. ; Return warning if changing outpatient med order marked for titration
. I $$ISTITR^ORUTL3(+ORIFN) D
. . S ORVAL="1^This prescription has been marked as a titration order. "
. . S ORVAL=ORVAL_"Do you wish to proceed? "
;
; Renew
I ORACTION="RN" D Q:ORVAL
. ; Return warning if renewing outpatient med order marked for titration
. I $$ISTITR^ORUTL3(+ORIFN) D
. . S ORVAL="1^This prescription has been marked as a titration order. "
. . S ORVAL=ORVAL_"Only the maintenance portion of the RX will be renewed. "
. . S ORVAL=ORVAL_"If you want to re-titrate, please use the COPY action. "
. . S ORVAL=ORVAL_"Do you wish to proceed? "
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDXR01 7700 printed Sep 23, 2025@20:12:24 Page 2
ORWDXR01 ;SLC/JDL - Utilities for Order Actions ;May 04, 2022@13:28:41
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215,280,345,311,350,405**;Dec 17, 1997;Build 211
CANCHG(ORY,ORIFN,TXTOD) ;
+1 ;If it's an pending or unsigned unreleased renewed order, can edit=True
+2 SET ORY=0
+3 if '$DATA(^OR(100,+ORIFN,0))
QUIT
+4 IF TXTOD
DO TXTCAN(.ORY)
QUIT
+5 NEW OUTGRP,URELSTS,USIGSTS,RNTYPE,PDSTS
+6 NEW ODGRP,ODREL,ODSIG,ODTYPE,LSTACT
+7 SET OUTGRP=$ORDER(^ORD(100.98,"B","O RX",0))
+8 SET URELSTS=$ORDER(^ORD(100.01,"B","UNRELEASED",0))
+9 SET PDSTS=$ORDER(^ORD(100.01,"B","PENDING",0))
+10 ; unsigned order
SET USIGSTS=2
+11 ; renew action
SET RNTYPE=2
+12 ;Data from the order entry
+13 SET LSTACT=$PIECE($GET(^OR(100,+ORIFN,3)),U,7)
+14 SET ODGRP=$PIECE($GET(^OR(100,+ORIFN,0)),U,11)
+15 SET ODREL=$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
+16 SET ODSIG=$PIECE($GET(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
+17 SET ODTYPE=$PIECE($GET(^OR(100,+ORIFN,3)),U,11)
+18 IF (ODGRP=OUTGRP)
IF (ODREL=URELSTS)
IF (ODSIG=USIGSTS)
IF (ODTYPE=RNTYPE)
SET ORY=1
+19 QUIT
+20 ;
TXTCAN(ORY) ;
+1 ;if it's an unsigned unreleased renewed text order, can change=true
+2 NEW URELSTS,USIGSTS,RNTYPE
+3 NEW ODREL,ODSIG,ODTYPE,LSTACT
+4 SET URELSTS=$ORDER(^ORD(100.01,"B","UNRELEASED",0))
+5 ; unsigned order
SET USIGSTS=2
+6 ; renew action
SET RNTYPE=2
+7 ;Data from the order entry
+8 SET LSTACT=$PIECE($GET(^OR(100,+ORIFN,3)),U,7)
+9 SET ODREL=$PIECE($GET(^OR(100,+ORIFN,8,LSTACT,0)),U,15)
+10 SET ODSIG=$PIECE($GET(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
+11 SET ODTYPE=$PIECE($GET(^OR(100,+ORIFN,3)),U,11)
+12 IF (ODREL=URELSTS)
IF (ODSIG=USIGSTS)
IF (ODTYPE=RNTYPE)
SET ORY=1
+13 QUIT
+14 ;
SAVCHG(ORY,ORID,PARM1,PARM2,TXTOD,DAYSUP,QTY) ;
+1 ;save new changes on the unreleased unsigned renewed order
+2 if '$DATA(^OR(100,+ORID,0))
QUIT
+3 ;Update new start and stop date the text order
+4 IF TXTOD
DO TXTSAV(.ORY,ORID,PARM1,PARM2)
QUIT
+5 ;Update new refills and pickup for the med order
+6 NEW REFID,PICKID,SUPPLYID,QTYID,ACT,IX,TXT,REFPOS,NDQUIT
+7 SET (REFID,PICKID,ACT,REFPOS,NDQUIT)=0
SET ORY=""
+8 SET ACT=+$PIECE(ORID,";",2)
if ACT'>0
SET ACT=1
+9 SET REFID=$ORDER(^OR(100,+ORID,4.5,"ID","REFILLS",0))
+10 SET PICKID=$ORDER(^OR(100,+ORID,4.5,"ID","PICKUP",0))
+11 SET SUPPLYID=$ORDER(^OR(100,+ORID,4.5,"ID","SUPPLY",0))
+12 SET QTYID=$ORDER(^OR(100,+ORID,4.5,"ID","QTY",0))
+13 if $DATA(^OR(100,+ORID,4.5,REFID,1))
SET ^(1)=PARM1
+14 if $DATA(^OR(100,+ORID,4.5,PICKID,1))
SET ^(1)=PARM2
+15 if $DATA(^OR(100,+ORID,4.5,+SUPPLYID,1))
SET ^(1)=$GET(DAYSUP)
+16 if $DATA(^OR(100,+ORID,4.5,+QTYID,1))
SET ^(1)=$GET(QTY)
+17 SET IX=0
FOR
SET IX=$ORDER(^OR(100,+ORID,8,ACT,.1,IX))
if ('IX)!(NDQUIT)
QUIT
Begin DoDot:1
+18 SET TXT=$GET(^OR(100,+ORID,8,ACT,.1,IX,0))
+19 IF ($$UP^XLFSTR(TXT)["QUANTITY:")
IF ($$UP^XLFSTR(TXT)["REFILLS:")
Begin DoDot:2
+20 ;S REFPOS=$F($$UP^XLFSTR(TXT),"REFILLS")-$L("REFILLS")-1
+21 ;S TXT=$E(TXT,1,REFPOS)_"Refills: "_PARM1
+22 SET TXT=" Quantity: "_$GET(QTY)_" Refills: "_$GET(PARM1)
+23 SET ^OR(100,+ORID,8,ACT,.1,IX,0)=TXT
SET NDQUIT=1
QUIT
End DoDot:2
End DoDot:1
+24 DO GETBYIFN^ORWORR(.ORY,+ORID)
+25 QUIT
+26 ;
TXTSAV(ORY,ORID,PARM1,PARM2) ;
+1 ; Update new start and stop date for the unsigned unreleased
+2 ; renewed text order
+3 NEW STRTID,STOPID
+4 SET STRTID=$ORDER(^OR(100,+ORID,4.5,"ID","START",0))
+5 SET STOPID=$ORDER(^OR(100,+ORID,4.5,"ID","STOP",0))
+6 if $DATA(^OR(100,+ORID,4.5,STRTID,1))
SET ^(1)=PARM1
+7 if $DATA(^OR(100,+ORID,4.5,STOPID,1))
SET ^(1)=PARM2
+8 DO GETBYIFN^ORWORR(.ORY,+ORID)
+9 QUIT
+10 ;
ISSPLY(ORY,DLGID,QODLG) ;
+1 ; ORY=1: is "PSO SUPPLY" dialog
+2 NEW A,IFN
+3 SET ORY=""
+4 SET DLGID=$GET(DLGID)
+5 IF DLGID?1"X".E
SET IFN=$EXTRACT(DLGID,2,99)
SET A=$PIECE($GET(^OR(100,+IFN,0)),"^",5)
Begin DoDot:1
+6 IF $PIECE(A,";",2)[101.41
SET DLGID=+A
QUIT
+7 SET DLGID=0
End DoDot:1
+8 if +DLGID=0
QUIT
+9 if '$DATA(^ORD(101.41,DLGID,0))
QUIT
+10 IF 'QODLG
IF ($PIECE(^ORD(101.41,DLGID,0),U)="PSO SUPPLY")
SET ORY=1
+11 IF QODLG
Begin DoDot:1
+12 NEW SPLYDG
SET SPLYDG=$ORDER(^ORD(100.98,"B","SPLY",0))
+13 IF $PIECE(^ORD(101.41,DLGID,0),U,5)=SPLYDG
SET ORY=1
End DoDot:1
+14 QUIT
+15 ;
OXDATA(ORY,ORIEN) ; Return orderable item data for order check usage
+1 if '$DATA(^OR(100,+ORIEN,0))
QUIT
+2 DO MAYBEIV(.ORY,ORIEN,1)
IF $LENGTH($GET(ORY))>1
QUIT
+3 NEW DISPSUP,DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPID
+4 SET (DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPSUP)=0
+5 SET DISPID=""
+6 SET DISPIN=$ORDER(^ORD(100.98,"B","UD RX",0))
+7 SET DISPOUT=$ORDER(^ORD(100.98,"B","O RX",0))
+8 NEW DISPCM
SET DISPCM=$ORDER(^ORD(100.98,"B","CLINIC MEDICATIONS",0))
+9 NEW DISPCMIV
SET DISPCMIV=$ORDER(^ORD(100.98,"B","CLINIC INFUSIONS",0))
+10 SET DISPSUP=$ORDER(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
+11 SET DRUGID=$ORDER(^OR(100,+ORIEN,4.5,"ID","DRUG",0))
+12 SET OIID=$ORDER(^OR(100,+ORIEN,4.5,"ID","ORDERABLE",0))
+13 SET DISPID=$PIECE(^OR(100,+ORIEN,0),U,11)
+14 IF DISPID=DISPIN
SET DISPID="PSI"
+15 IF DISPID=DISPOUT
SET DISPID="PSO"
+16 IF DISPID=DISPCM
SET DISPID="PSI"
+17 IF DISPID=DISPCMIV
SET DISPID="PSI"
+18 IF DISPID=DISPSUP
SET DISPID="PSO"
+19 IF (DISPID'="PSI")
IF (DISPID'="PSO")
QUIT
+20 IF 'DRUGID
IF DISPID="PSI"
Begin DoDot:1
+21 NEW ORCHI
SET ORCHI=0
FOR
SET ORCHI=$ORDER(^OR(100,+ORIEN,2,ORCHI))
if 'ORCHI
QUIT
Begin DoDot:2
+22 NEW ORCHDRID,ORCHOIID,ORCHIDX,ORCHIDY
+23 SET ORCHDRID=$ORDER(^OR(100,+ORCHI,4.5,"ID","DRUG",0))
+24 SET ORCHOIID=$ORDER(^OR(100,+ORCHI,4.5,"ID","ORDERABLE",0))
+25 if 'ORCHDRID
QUIT
+26 if 'ORCHOIID
QUIT
+27 SET ORCHIDX=$ORDER(^OR(100,+ORCHI,4.5,ORCHDRID,0))
+28 SET ORCHIDY=$ORDER(^OR(100,+ORCHI,4.5,ORCHOIID,0))
+29 IF ORCHIDX
IF ORCHIDY
SET ORY=$GET(^OR(100,+ORCHI,4.5,ORCHOIID,ORCHIDY))_U_DISPID_U_$GET(^OR(100,+ORCHI,4.5,ORCHDRID,ORCHIDX))_"|"_$GET(ORY)
End DoDot:2
End DoDot:1
+30 if 'DRUGID
QUIT
+31 if 'OIID
QUIT
+32 SET IDX=$ORDER(^OR(100,+ORIEN,4.5,DRUGID,0))
+33 SET IDY=$ORDER(^OR(100,+ORIEN,4.5,OIID,0))
+34 IF IDX
IF IDY
IF '+DISPID
SET ORY=$GET(^OR(100,+ORIEN,4.5,OIID,IDY))_U_DISPID_U_$GET(^OR(100,+ORIEN,4.5,DRUGID,IDX))
+35 QUIT
+36 ;
MAYBEIV(ORY,ORIEN,FORMAT) ; Return orderable item data for iv order check usage
+1 ;PARAMETERS: ORY => REFERENCE TO ARRAY THAT STORES ORDERABLE ITEM DATA
+2 ; ORIEN => ORDER NUMBER FROM ORDER FILE (#100)
+3 ; FORMAT => FLAG DENOTING WHICH FORMAT TO RETURN THE DATA IN:
+4 ; NULL OR ZERO - NEW FORMAT (USING PIPE DELMITER)
+5 ; 1 - OLD FORMAT (USING CAROT DELIMITER)
+6 NEW X0,ORDIALOG,DELIMIT
+7 SET DELIMIT=$SELECT($GET(FORMAT):"|",1:U)
+8 SET X0=^OR(100,+ORIEN,0)
+9 SET ORDIALOG=+$PIECE(X0,U,5)
+10 DO GETDLG^ORCD(ORDIALOG)
+11 DO GETORDER^ORCD(+ORIEN)
+12 IF $DATA(ORDIALOG("B","SOLUTION"))
Begin DoDot:1
+13 NEW ORI,ORSUB
+14 SET ORSUB=$PIECE(ORDIALOG("B","SOLUTION"),U,2)
+15 SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(ORSUB,ORI))
if 'ORI
QUIT
Begin DoDot:2
+16 if DELIMIT="|"
SET ORY=$GET(ORY)_"|"_$GET(ORDIALOG(ORSUB,ORI))_U_"PSIV"_U_"B;"
+17 if DELIMIT=U
SET ORY=$GET(ORY)_U_$GET(ORDIALOG(ORSUB,ORI))_"|"_"PSIV"_"|"_ORSUB_"||"_ORIEN_"||"_"B"
End DoDot:2
End DoDot:1
+18 IF $DATA(ORDIALOG("B","ADDITIVE"))
Begin DoDot:1
+19 NEW ORI,ORSUB
+20 SET ORSUB=$PIECE(ORDIALOG("B","ADDITIVE"),U,2)
+21 SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(ORSUB,ORI))
if 'ORI
QUIT
Begin DoDot:2
+22 if DELIMIT="|"
SET ORY=$GET(ORY)_"|"_$GET(ORDIALOG(ORSUB,ORI))_U_"PSIV"_U_"A"
+23 if DELIMIT=U
SET ORY=$GET(ORY)_U_$GET(ORDIALOG(ORSUB,ORI))_"|"_"PSIV"_"|"_ORSUB_"||"_ORIEN_"||"_"A"
End DoDot:2
End DoDot:1
+24 IF $LENGTH($GET(ORY),DELIMIT)>1
SET ORY=$PIECE(ORY,DELIMIT,2,$LENGTH(ORY,DELIMIT))
+25 QUIT
+26 ;
WARN(ORVAL,ORIFN,ORACTION) ; Should a warning be displayed for order action
+1 ;
+2 SET ORVAL=0
+3 ;
+4 ; Copy
+5 IF ORACTION="RW"
Begin DoDot:1
+6 ; Return warning if copying outpatient med order marked for titration
+7 IF $$ISTITR^ORUTL3(+ORIFN)
Begin DoDot:2
+8 SET ORVAL="1^This prescription has been marked as a titration order. "
+9 SET ORVAL=ORVAL_"Creating a COPY of the order will repeat the titration instructions. "
+10 SET ORVAL=ORVAL_"If you only want to copy the maintenance portion, please use the RENEW action. "
+11 SET ORVAL=ORVAL_"Do you wish to proceed? "
End DoDot:2
End DoDot:1
if ORVAL
QUIT
+12 ;
+13 ; Change
+14 IF ORACTION="XX"
Begin DoDot:1
+15 ; Return warning if changing outpatient med order marked for titration
+16 IF $$ISTITR^ORUTL3(+ORIFN)
Begin DoDot:2
+17 SET ORVAL="1^This prescription has been marked as a titration order. "
+18 SET ORVAL=ORVAL_"Do you wish to proceed? "
End DoDot:2
End DoDot:1
if ORVAL
QUIT
+19 ;
+20 ; Renew
+21 IF ORACTION="RN"
Begin DoDot:1
+22 ; Return warning if renewing outpatient med order marked for titration
+23 IF $$ISTITR^ORUTL3(+ORIFN)
Begin DoDot:2
+24 SET ORVAL="1^This prescription has been marked as a titration order. "
+25 SET ORVAL=ORVAL_"Only the maintenance portion of the RX will be renewed. "
+26 SET ORVAL=ORVAL_"If you want to re-titrate, please use the COPY action. "
+27 SET ORVAL=ORVAL_"Do you wish to proceed? "
End DoDot:2
End DoDot:1
if ORVAL
QUIT
+28 ;
+29 QUIT
