source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQ13.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1ORQ13 ;slc/dcm-Get patient orders in context ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165**;Dec 17, 1997
3 ;
4EN ; -- Event Delayed: 24=All Delayed orders, or
5 ; 15=Admission, 16=Discharge, 17=Transfer, 25=OR, 26=Manual
6 ; or EVENT=ptr to Patient Event in #100.2
7 D UNDO I $G(EVENT) D EN1 Q
8 N TYPE,EVT,EVENT,IFN,X0,TM,STS
9 S TYPE=$S(FLG=15:"A",FLG=16:"D",FLG=17:"T",FLG=25:"O",FLG=26:"M",1:"ADTOM")
10 S EVT=0 F S EVT=+$O(^ORE(100.2,"AE",+PAT,EVT)) Q:EVT<1 S EVENT=+$O(^(EVT,0)) D
11 . Q:TYPE'[$P($G(^ORD(100.5,EVT,0)),U,2) ;Q:$$LAPSED^OREVNTX(EVENT)
12 . S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,EVENT,IFN)) Q:IFN<1 D ADD(IFN)
13 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST
14 Q
15 ;
16EN1 ; -- Delayed for EVENT [and related Pt Events]
17 N DAD,CHLD S DAD=+$P($G(^ORE(100.2,EVENT,1)),U,5) ;EVENT=child
18 I DAD<1,$O(^ORE(100.2,"DAD",EVENT,0)) S DAD=EVENT ;EVENT=parent
19 D:DAD<1 EVNT(EVENT) I DAD D
20 . D EVNT(DAD) S CHLD=0
21 . F S CHLD=+$O(^ORE(100.2,"DAD",DAD,CHLD)) Q:CHLD<1 D EVNT(CHLD)
22 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST
23 Q
24 ;
25EVNT(EVENT) ; -- Orders tied to EVENT in #100.2
26 N DONE,IFN,I,X,ORDER
27 S DONE=$G(^ORE(100.2,EVENT,1)) D:DONE ;get released, dc'd orders
28 . S I=+$O(^ORE(100.2,EVENT,10,"B"),-1),X=$P($G(^(I,0)),U,2) Q:X="LP"!(X="CA") ;skip if lapsed or cancelled
29 . S ORDER=+$P($G(^ORE(100.2,EVENT,0)),U,4) D:ORDER ADD(ORDER,"RL")
30 . S IFN=0 F S IFN=$O(^ORE(100.2,EVENT,2,IFN)) Q:IFN<1 D ADD(IFN,"RL")
31 . S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,EVENT,IFN)) Q:IFN<1 I IFN'=ORDER,'$D(^ORE(100.2,EVENT,2,IFN)) D ADD(IFN,"RL")
32 . S IFN=0 F S IFN=$O(^ORE(100.2,EVENT,3,IFN)) Q:IFN<1 D ADD(IFN,"DC")
33 I 'DONE S IFN=0 F S IFN=$O(^OR(100,"AEVNT",PAT,EVENT,IFN)) Q:IFN<1 D ADD(IFN)
34 Q
35 ;
36ADD(IFN,TYPE) ; -- add EVENT order to list?
37 N X0,X3,DA,X8,TM,CURR
38 S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)) Q:'$D(ORGRP(+$P(X0,U,11)))
39 Q:$P(X3,U,8) I $P(X3,U,9),'$P($G(^OR(100,$P(X3,U,9),3)),U,8) Q
40 I $P(X3,U,3)=12,$P($G(^OR(100,+$P(X3,U,6),0)),U,17)=EVENT Q ;changed
41 S CURR=$P(X3,U,7) S:CURR<1 CURR=+$O(^OR(100,IFN,8,"?"),-1) ;current/last
42 S DA=0 F S DA=+$O(^OR(100,IFN,8,DA)) Q:DA<1 S X8=$G(^(DA,0)) D
43 . S TM=$P(X8,U) Q:TM<SDATE Q:TM>EDATE
44 . I DA'=CURR,$P(X8,U,15)'=11 Q ;current or unrel action
45 . I DETAIL<2!'$L($G(TYPE)) D GET^ORQ12(IFN,ORLIST,DETAIL,DA) Q
46 . S ORLST=ORLST+1,^TMP("ORGOTIT",$J,IFN,DA)=""
47 . S ^TMP("ORR",$J,ORLIST,EVENT,TYPE,ORLST)=IFN_";"_DA
48 Q
49 ;
50UNDO ; -- un-invert dates from ORQ1
51 N X S X=EDATE,EDATE=SDATE,SDATE=X
52 S SDATE=9999999-SDATE,EDATE=9999999-EDATE
53 Q
54 ;
55QUIT ; -- stop
56 Q
Note: See TracBrowser for help on using the repository browser.