- 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 Feb 19, 2025@00:02:37 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