source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMEVNT2.m@ 1801

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1ORMEVNT2 ;SLC/DAN Additional event delayed order utilities ;3/31/04 09:12
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**177,186,195**;Dec 17, 1997
3 ;
4 ;DBIA SECTION
5 ;10063 - %ZTLOAD
6 ;17 - DGPM("ATID3"
7 ;
8DCGEN ;Auto-dc admission generic order for observation episode of
9 ;care, if it exists and other orders are being carried over
10 ;
11 N ORLIST,ORADM,OREASON,ORNATR,X,ORCREATE,ORPRNT,ORSIG,ORI,ORPKG,ORDC,ORDT,ORN
12 S ORLIST=$H
13 S ORADM=$G(VAIP(13,1)) ;Admission date/time for this episode of care
14 D ADMORD^ORMEVNT1 ;See if admission order exists
15 Q:'$D(^TMP("ORR",$J,ORLIST)) ;no order found
16 S OREASON=$P($G(^ORD(100.6,TORY,0)),U,4) I OREASON<1 S OREASON=+$O(^ORD(100.3,"C","ORDIS",0)) ;If no reason assigned to rule, use discharge
17 S ORNATR=+$P($G(^ORD(100.03,+$G(OREASON),0)),U,7) I ORNATR<1 S ORNATR=+$O(^ORD(100.02,"C","A",0)) ;Get nature from reason, if none then use auto-dc
18 S X=$G(^ORD(100.02,ORNATR,1)),ORCREATE=+$P(X,U),ORPRNT=+$P(X,U,2) ;create order action, print?
19 S ORSIG=$S('ORCREATE:"",1:$P(X,U,4)) ;Signature required?
20 S ORI=0 F S ORI=$O(^ORD(100.6,TORY,7,"B",ORI)) Q:ORI<1 S ORPKG(ORI)=1 ;Identify packages to be auto-dcd for the rule
21 S ORDT=$P($G(DGPMA),U),ORDC=TORY,ORN=""
22 D DC1^ORMEVNT1 ;Code to auto-dc order
23 Q
24 ;
25TIMER ;Start background job to make sure that patient was readmitted
26 ;following the discharge from observation. Readmission must
27 ;occur within 1 hour
28 N ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
29 S ZTRTN="TIMERDQ^ORMEVNT2",ZTIO="",ZTDESC="Observation readmit"
30 S ZTDTH=$P($G(^XTMP("ORDCOBS-"_+$G(ORVP),0)),U) ;If inpatient med orders will be reinstated, match timing
31 I ZTDTH="" S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,1) ;One hour from now
32 S ZTSAVE("*")="" ;Save everything for possible use in auto-dcing
33 D ^%ZTLOAD
34 Q
35 ;
36TIMERDQ ;Check if patient readmitted, if not, auto-dc orders that should have auto-dcd on discharge
37 N CVAIP
38 K VAIP("E") S VAIP("V")="CVAIP" D IN5^VADPT ;Is patient an inpatient?
39 I $G(^XTMP("ORDCOBS-"_$G(DFN),"READMIT")) G DEL ;186 If readmit from ASIH OBS hasn't happened then auto-dc orders
40 I CVAIP(13)'="",CVAIP(13)'=VAIP(13) Q ;Check to see that patient is currently an inpatient and that they are in a different episode of care than the observation episode
41 I +$P($Q(^DGPM("ATID3",DFN)),",",4)'=VAIP(1) Q ;Stop if there's been another discharge since the discharge from observation.
42DEL K ^XTMP("ORDCOBS-"_$G(DFN)) ;Inpatient meds waiting for reinstatement are no longer needed so XTMP can be deleted
43 D AUTODC^ORMEVNT1(TORY,$P($G(DGPMA),U)) ;Auto-dc orders from observation
44 I '$D(^ORE(100.2,$G(OREVENT),10)),$G(OREVENT) D ACTLOG^OREVNTX(OREVENT,"NW","D",1),DONE^OREVNTX(OREVENT,,DGPMDA) ;186 Log event in 100.2 if not previously done
45 Q
46 ;
47DISCH ; -- Lapse/cancel outstanding events on discharge ;Section moved with 195
48 N X,ADM,EVT,ORP,X0,IFN,STS,X8,ORNOW,J,ORX,ORCH,DAD S ORNOW=+$E($$NOW^XLFDT,1,12) ;195
49 S X=$P(DGPMA,U,18),ADM=$S(X=12!(X=38):"",1:+$G(VAIP(13))),EVT=0
50 F S EVT=+$O(^ORE(100.2,"AE",+ORVP,EVT)) Q:EVT<1 S ORP=+$O(^(EVT,0)) D
51 . I $G(^ORE(100.2,ORP,1)) K ^ORE(100.2,"AE",+ORVP,EVT,ORP) Q
52 . Q:$$LAPSED^OREVNTX(ORP) I $$EMPTY^OREVNTX(ORP) D CANCEL^OREVNTX(ORP) Q
53 . I ADM,$P($G(^ORE(100.2,ORP,0)),U,3)'=ADM Q ;ck adm if not death
54 . S X0=$G(^ORE(100.2,ORP,0)),ORX=ORP ;195
55 . S DAD=0 I $D(^ORE(100.2,"DAD",ORP)) S ORCH=0,DAD=ORP F S ORCH=$O(^ORE(100.2,"DAD",ORP,ORCH)) Q:'+ORCH S ORX=ORX_","_ORCH ;195
56 . F J=1:1:$L(ORX,",") S ORP=$P(ORX,",",J) S IFN=0 F S IFN=$O(^OR(100,"AEVNT",ORVP,ORP,IFN)) Q:IFN<1 D ;195
57 .. S STS=$P($G(^OR(100,IFN,3)),U,3) I (STS=10)!(IFN=+$P(X0,U,4)) D
58 ... D STATUS^ORCSAVE2(IFN,13) S X8=$G(^OR(100,IFN,8,1,0))
59 ... S:$P(X8,U,15) $P(^OR(100,IFN,8,1,0),U,15)=13
60 ... D:$P(X8,U,4)=2 SIGN^ORCSAVE2(IFN,"","",5,1)
61 ... S ^OR(100,IFN,6)=+$O(^ORD(100.02,"C","A",0))_U_U_ORNOW_U_+$O(^ORD(100.03,"C","ORDIS",0))_U_U_U_U_$G(OREVENT)
62 . S:$G(DAD) ORP=DAD D DONE^OREVNTX(ORP),ACTLOG^OREVNTX(ORP,"CA") ;195
63 Q
Note: See TracBrowser for help on using the repository browser.