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

ORQOR2.m

Go to the documentation of this file. 
  1. ORQOR2 ; slc/CLA - Extrinsic functions which return order information ;6/14/96  10:15 [ 04/02/97  1:35 PM ]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,92,122,144,190,251**;Dec 17, 1997
  1. STATUS(ORN) ;extrinsic function returns the current status of an order in
  1.  ;the format: status ien^external text 
  1.  ;DBIA #3458 supported api for outpt pharmacy
  1.  Q:'$L($G(ORN)) ""
  1.  Q:'$L($G(^OR(100,ORN,3))) ""
  1.  N ORSTATUS
  1.  S ORSTATUS=$P(^OR(100,ORN,3),U,3)
  1.  S ORSTATUS=ORSTATUS_U_$G(^ORD(100.01,+ORSTATUS,0))
  1.  Q ORSTATUS
  1. RECENT(PT,OI,ST) ;extrinsic funct returns pt's most recent order for an orderable item and status in format:
  1.  ; order number^order text (truncated to 60 chars)^start d/t^status
  1.  N INDT,ORN,CDT,ORSTATUS,ORTEXT,RESULT S RESULT="",ORN="",INDT=""
  1.  F  S INDT=$O(^OR(100,"AOI",OI,PT_";DPT(",INDT)) Q:INDT=""!(RESULT'="")  D
  1.  .F  S ORN=$O(^OR(100,"AOI",OI,PT_";DPT(",INDT,ORN)) Q:ORN=""  D
  1.  ..S ORSTATUS=$P(^OR(100,ORN,3),U,3)
  1.  ..I '$L($G(ST))!($G(ORSTATUS)=ST) D
  1.  ...S ORSTATUS=$G(^ORD(100.01,ORSTATUS,0)),CDT=9999999-INDT
  1.  ...S ORTEXT=$P($$TEXT^ORKOR(ORN,60),U,2)
  1.  ...S RESULT=ORN_U_ORTEXT_U_CDT_U_ORSTATUS
  1.  Q RESULT
  1. DUPRANGE(OI,DG,ODT,ORPT) ;extrinsic funct returns duplicate order range beginning date in the format:
  1.  ;fileman d/t^inverse fileman d/t
  1.  ;OI   = orderable item ien
  1.  ;DG   = display group abbrev. (e.g. 'LR')
  1.  ;ODT  = order effective/start date/time in FM format
  1.  ;ORPT = patient dfn
  1.  N DHRS,BDT,INBDT,ORSRV,ORLOC
  1.  S BDT="",INBDT=""
  1.  ;
  1.  ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
  1.  ;reliably determined, and many simultaneous outpt locations can occur):
  1.  I +$G(ORPT)>0 D
  1.  .N DFN S DFN=ORPT,VA200="" D OERR^VADPT
  1.  .I +$G(VAIN(4))>0 S ORLOC=+$G(^DIC(42,+$G(VAIN(4)),44))
  1.  .K VA200,VAIN
  1.  ;
  1.  S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
  1.  S DHRS=$$GET^XPAR("LOC.`"_$G(ORLOC)_"^SRV.`"_$G(ORSRV)_"^DIV^SYS","ORK DUP ORDER RANGE OI",OI,"I")
  1.  Q:$G(DHRS)=0 "0^0" ;quit if number of hours for this OI is zero
  1.  I +$G(DHRS)<1 D
  1.  .I DG="LR" S DHRS=$$GET^XPAR("LOC.`"_$G(ORLOC)_"^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORK DUP ORDER RANGE LAB",1,"I")
  1.  .I DG="RA" S DHRS=$$GET^XPAR("LOC.`"_$G(ORLOC)_"^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORK DUP ORDER RANGE RADIOLOGY",1,"I")
  1.  I +$G(DHRS)<1 S DHRS=48  ;non-lab and non-radiology default is 48 hrs
  1.  S BDT=$$FMADD^XLFDT(ODT,"","-"_DHRS,"",""),INBDT=9999999-BDT
  1.  Q BDT_U_INBDT
  1. ORDERER(ORNUM) ;ext. funct. gets ordering provider DUZ from ORDER File (#100)
  1.  Q:'$L($G(ORNUM)) ""
  1.  S ORNUM=+$G(ORNUM)
  1.  N ORQDUZ,ORQI S ORQDUZ=""
  1.  I $L($G(^OR(100,ORNUM,8,0))) D
  1.  .S ORQI=0,ORQI=$O(^OR(100,ORNUM,8,"C","NW",ORQI))  ;8 node for New order
  1.  Q:+$G(ORQI)<1 ""
  1.  S ORQDUZ=$P(^OR(100,ORNUM,8,ORQI,0),U,3)
  1.  Q ORQDUZ
  1. UNSIGNOR(ORNUM) ;ext. funct. gets ordering provider DUZ from ORDER File (#100)
  1.  ; based on order action number (8 node)
  1.  ; if no action number return orderer for New order
  1.  ;ORNUM in format: <order ien><action number>
  1.  Q:'$L(+$G(ORNUM)) ""
  1.  N ORQDUZ,ORQI S ORQDUZ=""
  1.  S ORQI=$P(ORNUM,";",2)
  1.  S ORNUM=$P(ORNUM,";")
  1.  Q:+$G(ORNUM)<1 ""
  1.  I +$G(ORQI)<1 S ORQI=$P($G(^OR(100,ORNUM,8,0)),U,3)
  1.  I $L(ORQI),$L($G(^OR(100,ORNUM,8,ORQI,0))) D
  1.  .S ORQDUZ=$P(^OR(100,ORNUM,8,ORQI,0),U,3)
  1.  Q ORQDUZ
  1. OI(ORNUM) ;ext. funct. gets Orderable Item ien from ORDER File (#100)
  1.  Q:+$G(ORNUM)<1 ""
  1.  N OI S OI=""
  1.  S OI=+$G(^OR(100,+$G(ORNUM),.1,1,0))
  1.  Q OI
  1. DG(ORNUM) ;ext. funct. gets Display Group ien from ORDER File (#100)
  1.  Q:'$L($G(ORNUM)) ""
  1.  N DG S DG=""
  1.  S DG=$G(^OR(100,ORNUM,0))
  1.  I $L(DG) S DG=$P(DG,U,11)
  1.  Q DG
  1. DGRX(ORNUM)        ;ext. funct. determines if order is pharmacy order
  1.  Q:+$G(ORNUM)<1 ""
  1.  N DG,DGNAME,RXDG
  1.  S DG=$$DG(ORNUM)
  1.  S DGNAME=$P($G(^ORD(100.98,+DG,0)),U) Q:'$L(DGNAME) ""
  1.  F RXDG="PHARMACY","INPATIENT MEDICATIONS","OUTPATIENT MEDICATIONS","UNIT DOSE MEDICATIONS","IV MEDICATIONS","NON-VA MEDICATIONS","CLINIC ORDERS","" Q:(DGNAME=RXDG)
  1.  Q RXDG
  1. PT(ORNUM) ;ext. funct. gets Patient dfn from ORDER File (#100)
  1.  Q:'$L($G(ORNUM)) ""
  1.  N PT S PT=""
  1.  S PT=$G(^OR(100,ORNUM,0))
  1.  I $L(PT) S PT=$P(PT,U,2),PT=$P(PT,";DPT")
  1.  Q PT
  1. RSLTFLG(ORNUM) ;ext. funct. returns duz of user to receive alert if order was
  1.  ; flagged to alert when resulted
  1.  Q:'$L($G(ORNUM)) ""
  1.  N FLG S FLG=""
  1.  S FLG=$G(^OR(100,+ORNUM,3))
  1.  I $L(FLG) S FLG=$P(FLG,U,10)
  1.  Q FLG