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