- 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 Jan 18, 2025@03:31:54 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