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

OREVNTX1.m

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