Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWDXR01

ORWDXR01.m

Go to the documentation of this file.
  1. 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
  1. CANCHG(ORY,ORIFN,TXTOD) ;
  1. ;If it's an pending or unsigned unreleased renewed order, can edit=True
  1. S ORY=0
  1. Q:'$D(^OR(100,+ORIFN,0))
  1. I TXTOD D TXTCAN(.ORY) Q
  1. N OUTGRP,URELSTS,USIGSTS,RNTYPE,PDSTS
  1. N ODGRP,ODREL,ODSIG,ODTYPE,LSTACT
  1. S OUTGRP=$O(^ORD(100.98,"B","O RX",0))
  1. S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
  1. S PDSTS=$O(^ORD(100.01,"B","PENDING",0))
  1. S USIGSTS=2 ; unsigned order
  1. S RNTYPE=2 ; renew action
  1. ;Data from the order entry
  1. S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
  1. S ODGRP=$P($G(^OR(100,+ORIFN,0)),U,11)
  1. S ODREL=$P($G(^OR(100,+ORIFN,3)),U,3)
  1. S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
  1. S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
  1. I (ODGRP=OUTGRP),(ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
  1. Q
  1. ;
  1. TXTCAN(ORY) ;
  1. ;if it's an unsigned unreleased renewed text order, can change=true
  1. N URELSTS,USIGSTS,RNTYPE
  1. N ODREL,ODSIG,ODTYPE,LSTACT
  1. S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
  1. S USIGSTS=2 ; unsigned order
  1. S RNTYPE=2 ; renew action
  1. ;Data from the order entry
  1. S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
  1. S ODREL=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,15)
  1. S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
  1. S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
  1. I (ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
  1. Q
  1. ;
  1. SAVCHG(ORY,ORID,PARM1,PARM2,TXTOD,DAYSUP,QTY) ;
  1. ;save new changes on the unreleased unsigned renewed order
  1. Q:'$D(^OR(100,+ORID,0))
  1. ;Update new start and stop date the text order
  1. I TXTOD D TXTSAV(.ORY,ORID,PARM1,PARM2) Q
  1. ;Update new refills and pickup for the med order
  1. N REFID,PICKID,SUPPLYID,QTYID,ACT,IX,TXT,REFPOS,NDQUIT
  1. S (REFID,PICKID,ACT,REFPOS,NDQUIT)=0,ORY=""
  1. S ACT=+$P(ORID,";",2) S:ACT'>0 ACT=1
  1. S REFID=$O(^OR(100,+ORID,4.5,"ID","REFILLS",0))
  1. S PICKID=$O(^OR(100,+ORID,4.5,"ID","PICKUP",0))
  1. S SUPPLYID=$O(^OR(100,+ORID,4.5,"ID","SUPPLY",0))
  1. S QTYID=$O(^OR(100,+ORID,4.5,"ID","QTY",0))
  1. S:$D(^OR(100,+ORID,4.5,REFID,1)) ^(1)=PARM1
  1. S:$D(^OR(100,+ORID,4.5,PICKID,1)) ^(1)=PARM2
  1. S:$D(^OR(100,+ORID,4.5,+SUPPLYID,1)) ^(1)=$G(DAYSUP)
  1. S:$D(^OR(100,+ORID,4.5,+QTYID,1)) ^(1)=$G(QTY)
  1. S IX=0 F S IX=$O(^OR(100,+ORID,8,ACT,.1,IX)) Q:('IX)!(NDQUIT) D
  1. . S TXT=$G(^OR(100,+ORID,8,ACT,.1,IX,0))
  1. . I ($$UP^XLFSTR(TXT)["QUANTITY:"),($$UP^XLFSTR(TXT)["REFILLS:") D
  1. . . ;S REFPOS=$F($$UP^XLFSTR(TXT),"REFILLS")-$L("REFILLS")-1
  1. . . ;S TXT=$E(TXT,1,REFPOS)_"Refills: "_PARM1
  1. . . S TXT=" Quantity: "_$G(QTY)_" Refills: "_$G(PARM1)
  1. . . S ^OR(100,+ORID,8,ACT,.1,IX,0)=TXT,NDQUIT=1 Q
  1. D GETBYIFN^ORWORR(.ORY,+ORID)
  1. Q
  1. ;
  1. TXTSAV(ORY,ORID,PARM1,PARM2) ;
  1. ; Update new start and stop date for the unsigned unreleased
  1. ; renewed text order
  1. N STRTID,STOPID
  1. S STRTID=$O(^OR(100,+ORID,4.5,"ID","START",0))
  1. S STOPID=$O(^OR(100,+ORID,4.5,"ID","STOP",0))
  1. S:$D(^OR(100,+ORID,4.5,STRTID,1)) ^(1)=PARM1
  1. S:$D(^OR(100,+ORID,4.5,STOPID,1)) ^(1)=PARM2
  1. D GETBYIFN^ORWORR(.ORY,+ORID)
  1. Q
  1. ;
  1. ISSPLY(ORY,DLGID,QODLG) ;
  1. ; ORY=1: is "PSO SUPPLY" dialog
  1. N A,IFN
  1. S ORY=""
  1. S DLGID=$G(DLGID)
  1. I DLGID?1"X".E S IFN=$E(DLGID,2,99),A=$P($G(^OR(100,+IFN,0)),"^",5) D
  1. . I $P(A,";",2)[101.41 S DLGID=+A Q
  1. . S DLGID=0
  1. Q:+DLGID=0
  1. Q:'$D(^ORD(101.41,DLGID,0))
  1. I 'QODLG,($P(^ORD(101.41,DLGID,0),U)="PSO SUPPLY") S ORY=1
  1. I QODLG D
  1. . N SPLYDG S SPLYDG=$O(^ORD(100.98,"B","SPLY",0))
  1. . I $P(^ORD(101.41,DLGID,0),U,5)=SPLYDG S ORY=1
  1. Q
  1. ;
  1. OXDATA(ORY,ORIEN) ; Return orderable item data for order check usage
  1. Q:'$D(^OR(100,+ORIEN,0))
  1. D MAYBEIV(.ORY,ORIEN,1) I $L($G(ORY))>1 Q
  1. N DISPSUP,DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPID
  1. S (DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPSUP)=0
  1. S DISPID=""
  1. S DISPIN=$O(^ORD(100.98,"B","UD RX",0))
  1. S DISPOUT=$O(^ORD(100.98,"B","O RX",0))
  1. N DISPCM S DISPCM=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",0))
  1. N DISPCMIV S DISPCMIV=$O(^ORD(100.98,"B","CLINIC INFUSIONS",0))
  1. S DISPSUP=$O(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
  1. S DRUGID=$O(^OR(100,+ORIEN,4.5,"ID","DRUG",0))
  1. S OIID=$O(^OR(100,+ORIEN,4.5,"ID","ORDERABLE",0))
  1. S DISPID=$P(^OR(100,+ORIEN,0),U,11)
  1. I DISPID=DISPIN S DISPID="PSI"
  1. I DISPID=DISPOUT S DISPID="PSO"
  1. I DISPID=DISPCM S DISPID="PSI"
  1. I DISPID=DISPCMIV S DISPID="PSI"
  1. I DISPID=DISPSUP S DISPID="PSO"
  1. I (DISPID'="PSI"),(DISPID'="PSO") Q
  1. I 'DRUGID,DISPID="PSI" D
  1. .N ORCHI S ORCHI=0 F S ORCHI=$O(^OR(100,+ORIEN,2,ORCHI)) Q:'ORCHI D
  1. ..N ORCHDRID,ORCHOIID,ORCHIDX,ORCHIDY
  1. ..S ORCHDRID=$O(^OR(100,+ORCHI,4.5,"ID","DRUG",0))
  1. ..S ORCHOIID=$O(^OR(100,+ORCHI,4.5,"ID","ORDERABLE",0))
  1. ..Q:'ORCHDRID
  1. ..Q:'ORCHOIID
  1. ..S ORCHIDX=$O(^OR(100,+ORCHI,4.5,ORCHDRID,0))
  1. ..S ORCHIDY=$O(^OR(100,+ORCHI,4.5,ORCHOIID,0))
  1. ..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)
  1. Q:'DRUGID
  1. Q:'OIID
  1. S IDX=$O(^OR(100,+ORIEN,4.5,DRUGID,0))
  1. S IDY=$O(^OR(100,+ORIEN,4.5,OIID,0))
  1. 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))
  1. Q
  1. ;
  1. MAYBEIV(ORY,ORIEN,FORMAT) ; Return orderable item data for iv order check usage
  1. ;PARAMETERS: ORY => REFERENCE TO ARRAY THAT STORES ORDERABLE ITEM DATA
  1. ; ORIEN => ORDER NUMBER FROM ORDER FILE (#100)
  1. ; FORMAT => FLAG DENOTING WHICH FORMAT TO RETURN THE DATA IN:
  1. ; NULL OR ZERO - NEW FORMAT (USING PIPE DELMITER)
  1. ; 1 - OLD FORMAT (USING CAROT DELIMITER)
  1. N X0,ORDIALOG,DELIMIT
  1. S DELIMIT=$S($G(FORMAT):"|",1:U)
  1. S X0=^OR(100,+ORIEN,0)
  1. S ORDIALOG=+$P(X0,U,5)
  1. D GETDLG^ORCD(ORDIALOG)
  1. D GETORDER^ORCD(+ORIEN)
  1. I $D(ORDIALOG("B","SOLUTION")) D
  1. .N ORI,ORSUB
  1. .S ORSUB=$P(ORDIALOG("B","SOLUTION"),U,2)
  1. .S ORI=0 F S ORI=$O(ORDIALOG(ORSUB,ORI)) Q:'ORI D
  1. ..S:DELIMIT="|" ORY=$G(ORY)_"|"_$G(ORDIALOG(ORSUB,ORI))_U_"PSIV"_U_"B;"
  1. ..S:DELIMIT=U ORY=$G(ORY)_U_$G(ORDIALOG(ORSUB,ORI))_"|"_"PSIV"_"|"_ORSUB_"||"_ORIEN_"||"_"B"
  1. I $D(ORDIALOG("B","ADDITIVE")) D
  1. .N ORI,ORSUB
  1. .S ORSUB=$P(ORDIALOG("B","ADDITIVE"),U,2)
  1. .S ORI=0 F S ORI=$O(ORDIALOG(ORSUB,ORI)) Q:'ORI D
  1. ..S:DELIMIT="|" ORY=$G(ORY)_"|"_$G(ORDIALOG(ORSUB,ORI))_U_"PSIV"_U_"A"
  1. ..S:DELIMIT=U ORY=$G(ORY)_U_$G(ORDIALOG(ORSUB,ORI))_"|"_"PSIV"_"|"_ORSUB_"||"_ORIEN_"||"_"A"
  1. I $L($G(ORY),DELIMIT)>1 S ORY=$P(ORY,DELIMIT,2,$L(ORY,DELIMIT))
  1. Q
  1. ;
  1. WARN(ORVAL,ORIFN,ORACTION) ; Should a warning be displayed for order action
  1. ;
  1. S ORVAL=0
  1. ;
  1. ; Copy
  1. I ORACTION="RW" D Q:ORVAL
  1. . ; Return warning if copying outpatient med order marked for titration
  1. . I $$ISTITR^ORUTL3(+ORIFN) D
  1. . . S ORVAL="1^This prescription has been marked as a titration order. "
  1. . . S ORVAL=ORVAL_"Creating a COPY of the order will repeat the titration instructions. "
  1. . . S ORVAL=ORVAL_"If you only want to copy the maintenance portion, please use the RENEW action. "
  1. . . S ORVAL=ORVAL_"Do you wish to proceed? "
  1. ;
  1. ; Change
  1. I ORACTION="XX" D Q:ORVAL
  1. . ; Return warning if changing outpatient med order marked for titration
  1. . I $$ISTITR^ORUTL3(+ORIFN) D
  1. . . S ORVAL="1^This prescription has been marked as a titration order. "
  1. . . S ORVAL=ORVAL_"Do you wish to proceed? "
  1. ;
  1. ; Renew
  1. I ORACTION="RN" D Q:ORVAL
  1. . ; Return warning if renewing outpatient med order marked for titration
  1. . I $$ISTITR^ORUTL3(+ORIFN) D
  1. . . S ORVAL="1^This prescription has been marked as a titration order. "
  1. . . S ORVAL=ORVAL_"Only the maintenance portion of the RX will be renewed. "
  1. . . S ORVAL=ORVAL_"If you want to re-titrate, please use the COPY action. "
  1. . . S ORVAL=ORVAL_"Do you wish to proceed? "
  1. ;
  1. Q