OREVNTX1 ; SLC/JLI - Event delayed orders RPC's ; 4/5/11 2:53pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165,149,243,280,347,367**;Dec 17, 1997;Build 2
;
PUTEVNT(ORY,DFN,EVT,ORIFN) ; Save new patient delayed events to file 100.2
S ORY=$$NEW^OREVNT(DFN,EVT,ORIFN)
Q
;
GTEVT(ORY,PTEVT) ; Return Event infomation based on PTEVT ptr #100.2
;EVTID ptr #100.5
Q:'+PTEVT
N EVTID,EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
S (EVTTYPE,EVTNAME,EVTDISP,PRTEVT)=""
S EVTDLG=0
I '$P(^ORE(100.2,+$G(PTEVT),0),U,2) Q
S EVTID=$$EVT^OREVNTX(PTEVT)
S PRTEVT=$P(^ORD(100.5,EVTID,0),U,12)
I PRTEVT S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
E S EVTTYPE=$P(^ORD(100.5,EVTID,0),U,2)
I $D(^ORD(100.5,EVTID,0)) D
. S EVTNAME=$P(^ORD(100.5,EVTID,0),U,1)
. S EVTDISP=$P(^ORD(100.5,EVTID,0),U,8)
. S EVTDLG=$P(^ORD(100.5,EVTID,0),U,4)
S ORY=EVTTYPE_U_EVTID_U_EVTNAME_U_EVTDISP_U_EVTDLG
Q
GTEVT1(ORY,EVT) ; Return Event information based on EVT ptr #100.5
;EVT ptr #100.5
Q:'+EVT
N EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
S (EVTDLG,PRTEVT)=0
S PRTEVT=$P(^ORD(100.5,+EVT,0),U,12)
I PRTEVT>0 S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
E S EVTTYPE=$P(^ORD(100.5,+EVT,0),U,2)
S EVTNAME=$P($G(^ORD(100.5,+EVT,0)),U,1)
S EVTDISP=$P($G(^ORD(100.5,+EVT,0)),U,8)
S EVTDLG=$P($G(^ORD(100.5,+EVT,0)),U,4)
S ORY=EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG
Q
;
EVT(ORY,PTEVT) ; Return Event ptr #100.5, given PTEVT ptr #100.2
Q:'+PTEVT
S ORY=$$EVT^OREVNTX(PTEVT)
Q
;
EXISTS(ORY,DFN,EVT) ;Returns PtEvtID ptr #100.2 if patient already has delayed orders
I '+EVT S ORY=0 Q
N PTEVT S (PTEVT,ORY)=0
S PTEVT=$O(^ORE(100.2,"AE",+DFN,+EVT,PTEVT))
I PTEVT>0 S ORY=PTEVT
Q
;
TYPEXT(ORY,DFN,EVT) ; does EVT has delayed orders?
; 1 if Patient DFN has delayed orders for EVT
; 2 if Parent/Sibling event has delayed orders
; 0 if No delayed orders for EVT
Q:'+EVT
S ORY=$$EXISTS^OREVNTX(DFN,EVT)
Q
;
MATCH(ORY,DFN,EVT) ;If Pt's current data match selected event
;DFN: patient DFN
;EVT: ptr to #100.5
S ORY=0
Q:('+DFN)!('+EVT)
S ORY=$$MATCH^OREVNT(DFN,EVT)
N TS,TSNM
S TS=$S($G(ORTS):+ORTS,1:+$G(^DPT(DFN,.103)))
S TSNM=$P($G(^DIC(45.7,TS,0)),U)
S:ORY ORY=ORY_U_TSNM
Q
;
NAME(ORY,PTEVT) ; Return Event name from #100.5, given PTEVT ptr #100.2
I PTEVT'>0 S ORY="" Q
S ORY=$$NAME^OREVNTX(PTEVT)
Q
;
DIV(ORY,PTEVT) ; Return division for PTEVT ptr #100.2
Q:'+PTEVT
S ORY=$$DIV^OREVNTX(PTEVT)
Q
;
DIV1(ORY,EVT) ; Return division for EVT ptr #100.5
Q:'+EVT
S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,3) S:ORY<1 ORY=+$G(DUZ(2))
Q
;
LOC(ORY,PTEVT) ; Return default hospital location ^SC( for PTEVT ptr #100.2
Q:'+PTEVT
S ORY=$$LOC^OREVNTX(PTEVT)
S ORY=+ORY
Q
;
LOC1(ORY,EVT) ; Return default hospital location ^SC( for EVT ptr #100.5
Q:'+EVT
S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,9) S:ORY<1 ORY=+$G(ORL)
Q
;
CHGEVT(ORY,NEWEVT,ORIDS) ; Change order's event
N ORI
S ORI=0
F S ORI=$O(ORIDS(ORI)) Q:'+ORI D
. D CHGEVT^OREVNTX(+$G(ORIDS(ORI)),NEWEVT)
Q
;
EMPTY(ORY,PTEVT) ; Return 1 if PTEVT doesn't have any orders
Q:'+PTEVT
S ORY=$$EMPTY^OREVNTX(PTEVT)
Q
;
DELPTEVT(ORY,PTEVT) ; Delete Patient Event in #100.2
Q:'+PTEVT
D CANCEL^OREVNTX(PTEVT)
Q
;
UPDTOR(ORY,PTIFN,ORIFN,PTEVT) ; If delayed order was DCed, then update the EVENT and "AEVNT"
Q ;Don't ever need to do this!
CURSPE(ORY,PTIFN) ; Return current treating specialty
Q:'PTIFN
N SPEC S SPEC=$$PT^DGPMOBS(PTIFN),ORY=""
I SPEC'<0 S ORY=$P(SPEC,U,3)_U_$P(SPEC,U,2)_U_$P(SPEC,U) ;name^ien^obs flag
Q
DFLTEVT(ORY,PVIFN) ; Return default release event based on provider IFN
N CMEVTLST,IDX
S CMEVTLST="",IDX=0
D GETLST^OREV3(.CMEVTLST)
F S IDX=$O(CMEVTLST(IDX)) Q:'IDX D
. I $P($G(CMEVTLST(IDX)),U,2) S ORY=$P($G(CMEVTLST(IDX)),U) Q
Q
CMEVTS(ORY,CLOC) ;Return common event list
N IDX,X0,X,LOC
S:CLOC>0 LOC=CLOC
S IDX=0,ORY=""
D GETLST^OREV3(.ORY)
F S IDX=$O(ORY(IDX)) Q:'IDX D
. S X0=""
. S:$L($G(^ORD(100.5,+ORY(IDX),0))) X0=$G(^(0))
. I '$L($P(X0,U,2)) D
.. S X=$P(X0,U,12) S:X $P(X0,U,2)=$P($G(^ORD(100.5,+X,0)),U,2)
. S:$L(X0) ORY(IDX)=+ORY(IDX)_U_X0
Q
;
DELDFLT(ORY,PVIFN) ; Delete default release event
Q:'PVIFN
N ORERR
S ORERR=""
D DEL^XPAR(PVIFN_";VA(200,","OREVNT DEFAULT",1,.ORERR)
Q
WRLSTED(LST,LOC,EVTID) ; Return list of dialogs for writing event delayed orders
; .Y(n): DlgName^ListBox Text
WRLST1 N ANENT
S LOC=+$G(LOC)_";SC(" I 'LOC S LOC=""
S ANENT="ALL^USR.`"_DUZ_"^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP
S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS EVENT LIST",EVTID,"I") Q:'MNU
S SEQ=0 F S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ D
. S IEN=0 F S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN D
. . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4)
. . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5)
. . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5)
. . S:'$L(TXT) TXT=$P(X,U,2)
. . I TYP="M" S:'FID FID=1001
. . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT
Q
;
GETDLG(LST,DLGID) ; Return dialog infomation based on the DLGID
N DIEN,DFID,DTXT,DTYP,DGRP,X0,X5
S DLGID=+DLGID
Q:'DLGID
S X0=^ORD(101.41,DLGID,0),X5=$G(^(5))
S DGRP=+$P(X0,U,5),DFID=+$P(X5,U,5),DTXT=$P(X5,U,4),DTYP=$P(X0,U,4)
S:'$L(DTXT) DTXT=$P(X0,U,2)
I $P(X0,U,4)="M" S:'DFID DFID=1001
S LST=DLGID_";"_DFID_";"_DGRP_";"_DTYP_U_DTXT
Q
DONE(LST,PTEVT) ; Terminate PTEvt
Q:'PTEVT
D DONE^OREVNTX(PTEVT)
D ACTLOG^OREVNTX(PTEVT,"MN")
Q
SETDFLT(ORY,EVT) ;Set personal default event
N ERR,VAL S ERR=""
Q:'$D(^ORD(100.5,EVT,0))
S VAL=$P(^ORD(100.5,EVT,0),U)
D EN^XPAR(DUZ_";VA(200,","OREVNT DEFAULT",1,VAL,ERR)
S ORY=ERR
Q
CPACT(ORY,EVT) ; Return True/False to display active orders for copy
; EVT ptr to #100.5
Q:'EVT
S ORY=0
Q:'$D(^ORD(100.5,EVT,0))
S ORY=$P(^ORD(100.5,EVT,0),U,11)
Q
PRMPTID(ORY,PRTNM) ;Return event prompt IEN for OR GTX EVENT
S:$D(^ORD(101.41,"B","OR GTX EVENT")) ORY=$O(^("OR GTX EVENT",0))
Q
ISDCOD(ORY,ORIFN) ;True: the order need to be filtered out
N PAS,X3,X0,ORGRPLST,THEGRP,IDX,ODGRP
S (ORY,IDX)=0
Q:'$D(^OR(100,+ORIFN,0))
S X0=$G(^OR(100,+ORIFN,0))
S ODGRP=$P(X0,U,11)
D GETLST^XPAR(.ORGRPLST,"ALL","OREVNT EXCLUDE DGRP")
F S IDX=$O(ORGRPLST(IDX)) Q:'IDX!ORY D
. S THEGRP=$P($G(ORGRPLST(IDX)),U,2)
. I $$GRPCHK(THEGRP,ODGRP) S ORY=1
I ORY Q
S PAS=";1;2;7;13;" ;*347 Update Filter
S:$D(^OR(100,+ORIFN,3)) X3=^OR(100,+ORIFN,3)
;*347 Filter out DC
S:(PAS[(";"_$P(X3,U,3)_";")) ORY=1
Q
DEFLTS(ORY,EVTID) ;Return default specialty for EVTID(#100.5)
Q:'+EVTID
N PRTEVT
S PRTEVT=0
S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
I PRTEVT>0 S EVTID=PRTEVT
S ORY=$$DEFTS^ORCDADT(EVTID)
Q
;
MULTS(ORY,EVTID) ;Return specialty list for the EVTID(#100.5)
Q:'+EVTID
N I,CNT,X,Y S (I,CNT)=0
N PRTEVT
S PRTEVT=0
S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
I PRTEVT>0 S EVTID=PRTEVT
F S I=$O(^ORD(100.5,+$G(EVTID),"TS",I)) Q:I<1 S X=+$G(^(I,0)) D
. S Y=$$GET1^DIQ(45.7,X_",",.01)
. S CNT=CNT+1,ORY(CNT)=X_U_Y
Q
;
PRTIDS(ORY,IDS) ;Return some prompt ids from #101.41
; treating specialty Id^attending provider id
N IDX,ORTS,ORATT
S (ORY,ORTS,ORATT)=""
S IDX=$O(^ORD(101.41,"B","OR GTX TREATING SPECIALTY",0))
S:$D(^ORD(101.41,IDX,1)) ORTS=$P($G(^ORD(101.41,IDX,1)),U,2,3)
S IDX=$O(^ORD(101.41,"B","OR GTX PROVIDER",0))
S:$D(^ORD(101.41,IDX,1)) ORATT=$P($G(^ORD(101.41,IDX,1)),U,2,3)
S ORY=ORTS_"~"_ORATT
Q
;
DFLTDLG(ORY,EVTID) ;Return event default dialog IEN
S ORY=0
; p.367 if this is a child event, dialog will be "" so use the parent's default dialog
S:$P($G(^ORD(100.5,+EVTID,0)),U,12) EVTID=$P($G(^ORD(100.5,+EVTID,0)),U,12)
Q:'$D(^ORD(100.5,+EVTID,0))
S ORY=$P(^ORD(100.5,+EVTID,0),U,4)
Q
AUTHMREL(ORY,USER) ;1: user can manual release delayed orders 0: can't
S ORY=$$CANREL^OREV3
Q
HAVEPRT(ORY,PTEVT) ;return parent patient event from #100.2
Q:'+PTEVT
S ORY=""
S:$L($G(^ORE(100.2,PTEVT,1))) ORY=$P(^(1),U,5)
Q
GRPCHK(DG,AGRP) ;If an order's group belong to DG group
N RST
S RST=0
N ORGRP
D GRP^ORQ1(DG)
S RST=$S($D(ORGRP(AGRP)):1,1:0)
Q RST
ODPTEVID(ORY,ORID) ;Return PtEvtID based on the ORID
Q:'$D(^OR(100,+ORID,0))
S ORY=$P($G(^OR(100,+ORID,0)),U,17)
Q
COMP(ORY,PTEVT) ;Return 1 or 0 if PTEVT completed or not
Q:'+PTEVT
S ORY=$$COMP^OREVNTX(+PTEVT)
Q
ISHDORD(ORY,ORID) ;Return 1 if it's on-hold med order
Q:'+ORID
Q:'$D(^OR(100,+ORID,0))
N STS,HDSTS,ODGP,INPT,OUPT,MEDS,IVMD
S HDSTS=$O(^ORD(100.01,"B","HOLD",0))
S STS=$P($G(^OR(100,+ORID,3)),U,3)
S INPT=$O(^ORD(100.98,"B","UD RX",0))
S OUPT=$O(^ORD(100.98,"B","O RX",0))
S MEDS=$O(^ORD(100.98,"B","RX",0))
S IVMD=$O(^ORD(100.98,"B","IV RX",0))
S ODGP=$P(^OR(100,+ORID,0),U,11)
I (U_INPT_U_OUPT_U_MEDS_U_IVMD_U[U_ODGP_U),(HDSTS=STS) S ORY=1
Q
ISPASS(ORY,PTEVTID,EVTTYPE) ;Return 1 if it's a pass event
S ORY=$$EVT^OREVNTX(PTEVTID)
S ORY=$P($G(^ORD(100.5,+ORY,0)),U,7)
I EVTTYPE="T",ORY,ORY<4 S ORY=1
E S ORY=0
Q
ISPASS1(ORY,EVTID,EVTTYPE) ;Return 1 if it's a pass event
S ORY=$P($G(^ORD(100.5,+EVTID,0)),U,7)
I EVTTYPE="T",ORY,ORY<4 S ORY=1
E S ORY=0
Q
DLGIEN(ORY,DLGNAME) ;Return Order Dialog IEN based on name
Q:'$D(^ORD(101.41,"B",DLGNAME))
S ORY=$O(^ORD(101.41,"B",DLGNAME,0))
Q
GETSTS(ORY,ORDID) ;Return Order status
Q:'+ORDID
Q:'$D(^OR(100,+ORDID,0))
S ORY=$P($G(^OR(100,+ORDID,3)),U,3)
Q
;
CHKORD(ORDER) ;Extrinsic function to determine if order is delayed and the "event" order
;
N VALUE
S VALUE=0
I +$P($G(^OR(100,ORDER,0)),U,17),'$O(^ORE(100.2,"AO",ORDER,0)) S VALUE=1 ;Delayed but not the "event" order
Q VALUE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOREVNTX1 9804 printed Dec 13, 2024@02:30:44 Page 2
OREVNTX1 ; SLC/JLI - Event delayed orders RPC's ; 4/5/11 2:53pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165,149,243,280,347,367**;Dec 17, 1997;Build 2
+2 ;
PUTEVNT(ORY,DFN,EVT,ORIFN) ; Save new patient delayed events to file 100.2
+1 SET ORY=$$NEW^OREVNT(DFN,EVT,ORIFN)
+2 QUIT
+3 ;
GTEVT(ORY,PTEVT) ; Return Event infomation based on PTEVT ptr #100.2
+1 ;EVTID ptr #100.5
+2 if '+PTEVT
QUIT
+3 NEW EVTID,EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
+4 SET (EVTTYPE,EVTNAME,EVTDISP,PRTEVT)=""
+5 SET EVTDLG=0
+6 IF '$PIECE(^ORE(100.2,+$GET(PTEVT),0),U,2)
QUIT
+7 SET EVTID=$$EVT^OREVNTX(PTEVT)
+8 SET PRTEVT=$PIECE(^ORD(100.5,EVTID,0),U,12)
+9 IF PRTEVT
SET EVTTYPE=$PIECE(^ORD(100.5,PRTEVT,0),U,2)
+10 IF '$TEST
SET EVTTYPE=$PIECE(^ORD(100.5,EVTID,0),U,2)
+11 IF $DATA(^ORD(100.5,EVTID,0))
Begin DoDot:1
+12 SET EVTNAME=$PIECE(^ORD(100.5,EVTID,0),U,1)
+13 SET EVTDISP=$PIECE(^ORD(100.5,EVTID,0),U,8)
+14 SET EVTDLG=$PIECE(^ORD(100.5,EVTID,0),U,4)
End DoDot:1
+15 SET ORY=EVTTYPE_U_EVTID_U_EVTNAME_U_EVTDISP_U_EVTDLG
+16 QUIT
GTEVT1(ORY,EVT) ; Return Event information based on EVT ptr #100.5
+1 ;EVT ptr #100.5
+2 if '+EVT
QUIT
+3 NEW EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
+4 SET (EVTDLG,PRTEVT)=0
+5 SET PRTEVT=$PIECE(^ORD(100.5,+EVT,0),U,12)
+6 IF PRTEVT>0
SET EVTTYPE=$PIECE(^ORD(100.5,PRTEVT,0),U,2)
+7 IF '$TEST
SET EVTTYPE=$PIECE(^ORD(100.5,+EVT,0),U,2)
+8 SET EVTNAME=$PIECE($GET(^ORD(100.5,+EVT,0)),U,1)
+9 SET EVTDISP=$PIECE($GET(^ORD(100.5,+EVT,0)),U,8)
+10 SET EVTDLG=$PIECE($GET(^ORD(100.5,+EVT,0)),U,4)
+11 SET ORY=EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG
+12 QUIT
+13 ;
EVT(ORY,PTEVT) ; Return Event ptr #100.5, given PTEVT ptr #100.2
+1 if '+PTEVT
QUIT
+2 SET ORY=$$EVT^OREVNTX(PTEVT)
+3 QUIT
+4 ;
EXISTS(ORY,DFN,EVT) ;Returns PtEvtID ptr #100.2 if patient already has delayed orders
+1 IF '+EVT
SET ORY=0
QUIT
+2 NEW PTEVT
SET (PTEVT,ORY)=0
+3 SET PTEVT=$ORDER(^ORE(100.2,"AE",+DFN,+EVT,PTEVT))
+4 IF PTEVT>0
SET ORY=PTEVT
+5 QUIT
+6 ;
TYPEXT(ORY,DFN,EVT) ; does EVT has delayed orders?
+1 ; 1 if Patient DFN has delayed orders for EVT
+2 ; 2 if Parent/Sibling event has delayed orders
+3 ; 0 if No delayed orders for EVT
+4 if '+EVT
QUIT
+5 SET ORY=$$EXISTS^OREVNTX(DFN,EVT)
+6 QUIT
+7 ;
MATCH(ORY,DFN,EVT) ;If Pt's current data match selected event
+1 ;DFN: patient DFN
+2 ;EVT: ptr to #100.5
+3 SET ORY=0
+4 if ('+DFN)!('+EVT)
QUIT
+5 SET ORY=$$MATCH^OREVNT(DFN,EVT)
+6 NEW TS,TSNM
+7 SET TS=$SELECT($GET(ORTS):+ORTS,1:+$GET(^DPT(DFN,.103)))
+8 SET TSNM=$PIECE($GET(^DIC(45.7,TS,0)),U)
+9 if ORY
SET ORY=ORY_U_TSNM
+10 QUIT
+11 ;
NAME(ORY,PTEVT) ; Return Event name from #100.5, given PTEVT ptr #100.2
+1 IF PTEVT'>0
SET ORY=""
QUIT
+2 SET ORY=$$NAME^OREVNTX(PTEVT)
+3 QUIT
+4 ;
DIV(ORY,PTEVT) ; Return division for PTEVT ptr #100.2
+1 if '+PTEVT
QUIT
+2 SET ORY=$$DIV^OREVNTX(PTEVT)
+3 QUIT
+4 ;
DIV1(ORY,EVT) ; Return division for EVT ptr #100.5
+1 if '+EVT
QUIT
+2 SET ORY=+$PIECE($GET(^ORD(100.5,+EVT,0)),U,3)
if ORY<1
SET ORY=+$GET(DUZ(2))
+3 QUIT
+4 ;
LOC(ORY,PTEVT) ; Return default hospital location ^SC( for PTEVT ptr #100.2
+1 if '+PTEVT
QUIT
+2 SET ORY=$$LOC^OREVNTX(PTEVT)
+3 SET ORY=+ORY
+4 QUIT
+5 ;
LOC1(ORY,EVT) ; Return default hospital location ^SC( for EVT ptr #100.5
+1 if '+EVT
QUIT
+2 SET ORY=+$PIECE($GET(^ORD(100.5,+EVT,0)),U,9)
if ORY<1
SET ORY=+$GET(ORL)
+3 QUIT
+4 ;
CHGEVT(ORY,NEWEVT,ORIDS) ; Change order's event
+1 NEW ORI
+2 SET ORI=0
+3 FOR
SET ORI=$ORDER(ORIDS(ORI))
if '+ORI
QUIT
Begin DoDot:1
+4 DO CHGEVT^OREVNTX(+$GET(ORIDS(ORI)),NEWEVT)
End DoDot:1
+5 QUIT
+6 ;
EMPTY(ORY,PTEVT) ; Return 1 if PTEVT doesn't have any orders
+1 if '+PTEVT
QUIT
+2 SET ORY=$$EMPTY^OREVNTX(PTEVT)
+3 QUIT
+4 ;
DELPTEVT(ORY,PTEVT) ; Delete Patient Event in #100.2
+1 if '+PTEVT
QUIT
+2 DO CANCEL^OREVNTX(PTEVT)
+3 QUIT
+4 ;
UPDTOR(ORY,PTIFN,ORIFN,PTEVT) ; If delayed order was DCed, then update the EVENT and "AEVNT"
+1 ;Don't ever need to do this!
QUIT
CURSPE(ORY,PTIFN) ; Return current treating specialty
+1 if 'PTIFN
QUIT
+2 NEW SPEC
SET SPEC=$$PT^DGPMOBS(PTIFN)
SET ORY=""
+3 ;name^ien^obs flag
IF SPEC'<0
SET ORY=$PIECE(SPEC,U,3)_U_$PIECE(SPEC,U,2)_U_$PIECE(SPEC,U)
+4 QUIT
DFLTEVT(ORY,PVIFN) ; Return default release event based on provider IFN
+1 NEW CMEVTLST,IDX
+2 SET CMEVTLST=""
SET IDX=0
+3 DO GETLST^OREV3(.CMEVTLST)
+4 FOR
SET IDX=$ORDER(CMEVTLST(IDX))
if 'IDX
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(CMEVTLST(IDX)),U,2)
SET ORY=$PIECE($GET(CMEVTLST(IDX)),U)
QUIT
End DoDot:1
+6 QUIT
CMEVTS(ORY,CLOC) ;Return common event list
+1 NEW IDX,X0,X,LOC
+2 if CLOC>0
SET LOC=CLOC
+3 SET IDX=0
SET ORY=""
+4 DO GETLST^OREV3(.ORY)
+5 FOR
SET IDX=$ORDER(ORY(IDX))
if 'IDX
QUIT
Begin DoDot:1
+6 SET X0=""
+7 if $LENGTH($GET(^ORD(100.5,+ORY(IDX),0)))
SET X0=$GET(^(0))
+8 IF '$LENGTH($PIECE(X0,U,2))
Begin DoDot:2
+9 SET X=$PIECE(X0,U,12)
if X
SET $PIECE(X0,U,2)=$PIECE($GET(^ORD(100.5,+X,0)),U,2)
End DoDot:2
+10 if $LENGTH(X0)
SET ORY(IDX)=+ORY(IDX)_U_X0
End DoDot:1
+11 QUIT
+12 ;
DELDFLT(ORY,PVIFN) ; Delete default release event
+1 if 'PVIFN
QUIT
+2 NEW ORERR
+3 SET ORERR=""
+4 DO DEL^XPAR(PVIFN_";VA(200,","OREVNT DEFAULT",1,.ORERR)
+5 QUIT
WRLSTED(LST,LOC,EVTID) ; Return list of dialogs for writing event delayed orders
+1 ; .Y(n): DlgName^ListBox Text
WRLST1 NEW ANENT
+1 SET LOC=+$GET(LOC)_";SC("
IF 'LOC
SET LOC=""
+2 SET ANENT="ALL^USR.`"_DUZ_"^"_LOC_$SELECT($GET(^VA(200,DUZ,5)):"^SRV.`"_+$GET(^(5)),1:"")
+3 NEW MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP
+4 SET MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS EVENT LIST",EVTID,"I")
if 'MNU
QUIT
+5 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,MNU,10,"B",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(101.41,MNU,10,"B",SEQ,IEN))
if 'IEN
QUIT
Begin DoDot:2
+7 SET X=$GET(^ORD(101.41,MNU,10,IEN,0))
SET ITM=+$PIECE(X,U,2)
SET TXT=$PIECE(X,U,4)
+8 SET X=$GET(^ORD(101.41,ITM,5))
SET FID=+$PIECE(X,U,5)
+9 SET X=$GET(^ORD(101.41,ITM,0))
SET TYP=$PIECE(X,U,4)
SET DGRP=+$PIECE(X,U,5)
+10 if '$LENGTH(TXT)
SET TXT=$PIECE(X,U,2)
+11 IF TYP="M"
if 'FID
SET FID=1001
+12 SET LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
GETDLG(LST,DLGID) ; Return dialog infomation based on the DLGID
+1 NEW DIEN,DFID,DTXT,DTYP,DGRP,X0,X5
+2 SET DLGID=+DLGID
+3 if 'DLGID
QUIT
+4 SET X0=^ORD(101.41,DLGID,0)
SET X5=$GET(^(5))
+5 SET DGRP=+$PIECE(X0,U,5)
SET DFID=+$PIECE(X5,U,5)
SET DTXT=$PIECE(X5,U,4)
SET DTYP=$PIECE(X0,U,4)
+6 if '$LENGTH(DTXT)
SET DTXT=$PIECE(X0,U,2)
+7 IF $PIECE(X0,U,4)="M"
if 'DFID
SET DFID=1001
+8 SET LST=DLGID_";"_DFID_";"_DGRP_";"_DTYP_U_DTXT
+9 QUIT
DONE(LST,PTEVT) ; Terminate PTEvt
+1 if 'PTEVT
QUIT
+2 DO DONE^OREVNTX(PTEVT)
+3 DO ACTLOG^OREVNTX(PTEVT,"MN")
+4 QUIT
SETDFLT(ORY,EVT) ;Set personal default event
+1 NEW ERR,VAL
SET ERR=""
+2 if '$DATA(^ORD(100.5,EVT,0))
QUIT
+3 SET VAL=$PIECE(^ORD(100.5,EVT,0),U)
+4 DO EN^XPAR(DUZ_";VA(200,","OREVNT DEFAULT",1,VAL,ERR)
+5 SET ORY=ERR
+6 QUIT
CPACT(ORY,EVT) ; Return True/False to display active orders for copy
+1 ; EVT ptr to #100.5
+2 if 'EVT
QUIT
+3 SET ORY=0
+4 if '$DATA(^ORD(100.5,EVT,0))
QUIT
+5 SET ORY=$PIECE(^ORD(100.5,EVT,0),U,11)
+6 QUIT
PRMPTID(ORY,PRTNM) ;Return event prompt IEN for OR GTX EVENT
+1 if $DATA(^ORD(101.41,"B","OR GTX EVENT"))
SET ORY=$ORDER(^("OR GTX EVENT",0))
+2 QUIT
ISDCOD(ORY,ORIFN) ;True: the order need to be filtered out
+1 NEW PAS,X3,X0,ORGRPLST,THEGRP,IDX,ODGRP
+2 SET (ORY,IDX)=0
+3 if '$DATA(^OR(100,+ORIFN,0))
QUIT
+4 SET X0=$GET(^OR(100,+ORIFN,0))
+5 SET ODGRP=$PIECE(X0,U,11)
+6 DO GETLST^XPAR(.ORGRPLST,"ALL","OREVNT EXCLUDE DGRP")
+7 FOR
SET IDX=$ORDER(ORGRPLST(IDX))
if 'IDX!ORY
QUIT
Begin DoDot:1
+8 SET THEGRP=$PIECE($GET(ORGRPLST(IDX)),U,2)
+9 IF $$GRPCHK(THEGRP,ODGRP)
SET ORY=1
End DoDot:1
+10 IF ORY
QUIT
+11 ;*347 Update Filter
SET PAS=";1;2;7;13;"
+12 if $DATA(^OR(100,+ORIFN,3))
SET X3=^OR(100,+ORIFN,3)
+13 ;*347 Filter out DC
+14 if (PAS[(";"_$PIECE(X3,U,3)_";"))
SET ORY=1
+15 QUIT
DEFLTS(ORY,EVTID) ;Return default specialty for EVTID(#100.5)
+1 if '+EVTID
QUIT
+2 NEW PRTEVT
+3 SET PRTEVT=0
+4 SET PRTEVT=$PIECE(^ORD(100.5,+EVTID,0),U,12)
+5 IF PRTEVT>0
SET EVTID=PRTEVT
+6 SET ORY=$$DEFTS^ORCDADT(EVTID)
+7 QUIT
+8 ;
MULTS(ORY,EVTID) ;Return specialty list for the EVTID(#100.5)
+1 if '+EVTID
QUIT
+2 NEW I,CNT,X,Y
SET (I,CNT)=0
+3 NEW PRTEVT
+4 SET PRTEVT=0
+5 SET PRTEVT=$PIECE(^ORD(100.5,+EVTID,0),U,12)
+6 IF PRTEVT>0
SET EVTID=PRTEVT
+7 FOR
SET I=$ORDER(^ORD(100.5,+$GET(EVTID),"TS",I))
if I<1
QUIT
SET X=+$GET(^(I,0))
Begin DoDot:1
+8 SET Y=$$GET1^DIQ(45.7,X_",",.01)
+9 SET CNT=CNT+1
SET ORY(CNT)=X_U_Y
End DoDot:1
+10 QUIT
+11 ;
PRTIDS(ORY,IDS) ;Return some prompt ids from #101.41
+1 ; treating specialty Id^attending provider id
+2 NEW IDX,ORTS,ORATT
+3 SET (ORY,ORTS,ORATT)=""
+4 SET IDX=$ORDER(^ORD(101.41,"B","OR GTX TREATING SPECIALTY",0))
+5 if $DATA(^ORD(101.41,IDX,1))
SET ORTS=$PIECE($GET(^ORD(101.41,IDX,1)),U,2,3)
+6 SET IDX=$ORDER(^ORD(101.41,"B","OR GTX PROVIDER",0))
+7 if $DATA(^ORD(101.41,IDX,1))
SET ORATT=$PIECE($GET(^ORD(101.41,IDX,1)),U,2,3)
+8 SET ORY=ORTS_"~"_ORATT
+9 QUIT
+10 ;
DFLTDLG(ORY,EVTID) ;Return event default dialog IEN
+1 SET ORY=0
+2 ; p.367 if this is a child event, dialog will be "" so use the parent's default dialog
+3 if $PIECE($GET(^ORD(100.5,+EVTID,0)),U,12)
SET EVTID=$PIECE($GET(^ORD(100.5,+EVTID,0)),U,12)
+4 if '$DATA(^ORD(100.5,+EVTID,0))
QUIT
+5 SET ORY=$PIECE(^ORD(100.5,+EVTID,0),U,4)
+6 QUIT
AUTHMREL(ORY,USER) ;1: user can manual release delayed orders 0: can't
+1 SET ORY=$$CANREL^OREV3
+2 QUIT
HAVEPRT(ORY,PTEVT) ;return parent patient event from #100.2
+1 if '+PTEVT
QUIT
+2 SET ORY=""
+3 if $LENGTH($GET(^ORE(100.2,PTEVT,1)))
SET ORY=$PIECE(^(1),U,5)
+4 QUIT
GRPCHK(DG,AGRP) ;If an order's group belong to DG group
+1 NEW RST
+2 SET RST=0
+3 NEW ORGRP
+4 DO GRP^ORQ1(DG)
+5 SET RST=$SELECT($DATA(ORGRP(AGRP)):1,1:0)
+6 QUIT RST
ODPTEVID(ORY,ORID) ;Return PtEvtID based on the ORID
+1 if '$DATA(^OR(100,+ORID,0))
QUIT
+2 SET ORY=$PIECE($GET(^OR(100,+ORID,0)),U,17)
+3 QUIT
COMP(ORY,PTEVT) ;Return 1 or 0 if PTEVT completed or not
+1 if '+PTEVT
QUIT
+2 SET ORY=$$COMP^OREVNTX(+PTEVT)
+3 QUIT
ISHDORD(ORY,ORID) ;Return 1 if it's on-hold med order
+1 if '+ORID
QUIT
+2 if '$DATA(^OR(100,+ORID,0))
QUIT
+3 NEW STS,HDSTS,ODGP,INPT,OUPT,MEDS,IVMD
+4 SET HDSTS=$ORDER(^ORD(100.01,"B","HOLD",0))
+5 SET STS=$PIECE($GET(^OR(100,+ORID,3)),U,3)
+6 SET INPT=$ORDER(^ORD(100.98,"B","UD RX",0))
+7 SET OUPT=$ORDER(^ORD(100.98,"B","O RX",0))
+8 SET MEDS=$ORDER(^ORD(100.98,"B","RX",0))
+9 SET IVMD=$ORDER(^ORD(100.98,"B","IV RX",0))
+10 SET ODGP=$PIECE(^OR(100,+ORID,0),U,11)
+11 IF (U_INPT_U_OUPT_U_MEDS_U_IVMD_U[U_ODGP_U)
IF (HDSTS=STS)
SET ORY=1
+12 QUIT
ISPASS(ORY,PTEVTID,EVTTYPE) ;Return 1 if it's a pass event
+1 SET ORY=$$EVT^OREVNTX(PTEVTID)
+2 SET ORY=$PIECE($GET(^ORD(100.5,+ORY,0)),U,7)
+3 IF EVTTYPE="T"
IF ORY
IF ORY<4
SET ORY=1
+4 IF '$TEST
SET ORY=0
+5 QUIT
ISPASS1(ORY,EVTID,EVTTYPE) ;Return 1 if it's a pass event
+1 SET ORY=$PIECE($GET(^ORD(100.5,+EVTID,0)),U,7)
+2 IF EVTTYPE="T"
IF ORY
IF ORY<4
SET ORY=1
+3 IF '$TEST
SET ORY=0
+4 QUIT
DLGIEN(ORY,DLGNAME) ;Return Order Dialog IEN based on name
+1 if '$DATA(^ORD(101.41,"B",DLGNAME))
QUIT
+2 SET ORY=$ORDER(^ORD(101.41,"B",DLGNAME,0))
+3 QUIT
GETSTS(ORY,ORDID) ;Return Order status
+1 if '+ORDID
QUIT
+2 if '$DATA(^OR(100,+ORDID,0))
QUIT
+3 SET ORY=$PIECE($GET(^OR(100,+ORDID,3)),U,3)
+4 QUIT
+5 ;
CHKORD(ORDER) ;Extrinsic function to determine if order is delayed and the "event" order
+1 ;
+2 NEW VALUE
+3 SET VALUE=0
+4 ;Delayed but not the "event" order
IF +$PIECE($GET(^OR(100,ORDER,0)),U,17)
IF '$ORDER(^ORE(100.2,"AO",ORDER,0))
SET VALUE=1
+5 QUIT VALUE
