source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREV4.m@ 619

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1OREV4 ;SLC/DAN Event delayed orders cont ;10/25/02 13:54
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
3 ;DBIA reference section
4 ;10006 - DIC
5 ;10018 - DIE
6 ;10013 - DIK
7 ;10103 - XLFDT
8 ;2056 - DIQ
9 ;2263 - XPAR
10 ;
11 N Y,DIC,ZTSAVE,IEN
12 S DIC="^ORE(100.2,",DIC(0)="AEMQ" D ^DIC
13 Q:Y=-1 ;Quit if no selection made
14 S IEN=+Y
15 W !
16 S ZTSAVE("IEN")="",ZTSAVE("DIC")="",ZTSAVE("IO*")=""
17 D QUE^ORUTL1("DQI^OREV4","Patient event inquiry",.ZTSAVE) ;Get device to print on
18 Q
19 ;
20DQI ;Tasked entry point or continue if not queued
21 U IO
22 S DA=IEN
23 D EN^DIQ
24 Q
25 ;
26CHKPRM ;Checks to see if event is defined in either the OREVNT DEFAULT
27 ;or the OREVNT COMMON LIST parameter. If so, then it will be removed
28 ;from the parameters as PARENT type events are not allowed in these
29 ;parameters. This API is called when an event becomes a parent.
30 N DIC,Y,X,PRMC,PRMD,PARAM,I,J
31 S DIC=8989.51,DIC(0)="MX",X="OREVNT COMMON LIST" D ^DIC
32 Q:Y=-1 ;Parameter doesn't exist
33 S PRMC=+Y
34 S X="OREVNT DEFAULT" D ^DIC
35 Q:Y=-1 ;Parameter doesn't exist
36 S PRMD=+Y
37 F PARAM=PRMC,PRMD D
38 .K ORLST
39 .D ENVAL^XPAR(.ORLST,PRMC) ;get list of values
40 .Q:ORLST=0 ;No values
41 .S I="" F S I=$O(ORLST(I)) Q:I="" D
42 ..S J="" F S J=$O(ORLST(I,J)) Q:J="" D
43 ...I ORLST(I,J)=DA D EN^XPAR(I,PARAM,J,"@") ;delete event from parameter
44 Q
45 ;
46DELAYED(DFN) ;Display list of delayed events for a patient, identified by DFN
47 N EVT,IFN,DISP
48 I '$D(^ORE(100.2,"AE",DFN)) Q ;Quit if no delayed orders exist for the patient
49 S EVT=0,DISP=0
50 F S EVT=$O(^ORE(100.2,"AE",DFN,EVT)) Q:'+EVT D
51 .S IFN=$O(^ORE(100.2,"AE",DFN,EVT,0))
52 .Q:$$LAPSED^OREVNTX(IFN) ;quit if event has lapsed
53 .W:'DISP !!,"Delayed orders exist for this patient!",$C(7) S DISP=1
54 .W !,"EVENT: ",$P($G(^ORD(100.5,+$P(^ORE(100.2,IFN,0),U,2),0)),U,8),", created on ",$$FMTE^XLFDT($P(^ORE(100.2,IFN,0),U,5),1)
55 Q
56 ;
57PARENTOK() ;This function determines if the event can be a parent
58 ;if an event has future delayed orders tied to it then it can't be
59 ;a parent
60 N OK,SUB,RIEN,PIEN
61 S OK=1
62 S SUB="^ORE(100.2,""AE"")"
63 F S SUB=$Q(@SUB) Q:SUB'["AE"!('OK) D
64 .S RIEN=$P(SUB,",",4) ;Release event ID
65 .S PIEN=$P(SUB,",",5) ;Patient event ID
66 .Q:$$LAPSED^OREVNTX(PIEN) ;quit if event has lapsed
67 .I RIEN=DA W !!,"You may not make ",$P($G(^ORD(100.5,DA,0)),U)," a parent",!,"at this time because there are unprocessed delayed orders assigned to it." H 3 S OK=0
68 Q OK
69 ;
70ACTSURG(ORTYPE,DA) ;Function returns 1 if an active surgery event already exists
71 N ACT,DIV,I
72 S ACT=0
73 I ORTYPE="E" D
74 .S DIV=$P($G(^ORD(100.5,DA,0)),U,3)
75 .S I=0 F S I=$O(^ORD(100.5,"ADT","O",I)) Q:'+I I DA'=I I DIV=$P($G(^ORD(100.5,I,0)),U,3)&('$G(^ORD(100.5,I,1))) S ACT=1
76 .Q
77 I ORTYPE="A" D
78 .S DIV=$P($G(^ORD(100.6,DA,0)),U,3)
79 .S I=0 F S I=$O(^ORD(100.6,"AE",DIV,"O",I)) Q:'+I I I'=DA S ACT=1
80 .Q
81 Q ACT
82 ;
83FROMTO(MUL,SUB1,SUB2) ;Check FROM - TO entries in file 100.6
84 N DA,DIK,LOC0,X,Y,DEL,ERR
85 I MUL="S" D Q
86 .I '$D(^ORD(100.6,SUB1,4,SUB2,1,"B")) D ;Check for TO entries in specialties multiple
87 ..W !!,"ERROR - Missing TO entry - ",$P($G(^DIC(45.7,$P(^ORD(100.6,SUB1,4,SUB2,0),U),0)),U)," DELETED.",!
88 ..S DA(1)=SUB1,DA=SUB2,DIK="^ORD(100.6,"_DA(1)_",4," D ^DIK
89 ;
90 I MUL="L" D
91 .S LOC0=^ORD(100.6,SUB1,5,SUB2,0)
92 .I +$P(LOC0,U,2)=0&($P(LOC0,U,3)="") S DEL=1,ERR=1
93 .I +$P(LOC0,U,4)=0&($P(LOC0,U,5)="") S DEL=1,ERR=1
94 .I $G(ERR) W !!,"ERROR - Missing FROM or TO location - '",$P(LOC0,U),"' DELETED.",! Q
95 .I $P(LOC0,U,2) D CLEAR(SUB1,SUB2,2) ;If user selects "all" clear "from" field
96 .I $P(LOC0,U,4) D CLEAR(SUB1,SUB2,4) ;If user selects "all" clear "to" field
97 .I $P(LOC0,U,2)&($P(LOC0,U,4)) W !!,"WARNING - You've defined a 'FROM ALL' locations to 'TO ALL' locations entry",!,"and it will supercede all other entries.",! Q
98 .I $O(^ORD(100.6,SUB1,5,"ADC",$S($P(LOC0,U,2)=1:"ALL",1:$P(LOC0,U,3)),$S($P(LOC0,U,4)=1:"ALL",1:$P(LOC0,U,5)),SUB2)) S DEL=1,ERR=1
99 .I $O(^ORD(100.6,SUB1,5,"ADC",$S($P(LOC0,U,2)=1:"ALL",1:$P(LOC0,U,3)),$S($P(LOC0,U,4)=1:"ALL",1:$P(LOC0,U,5)),SUB2),-1) S DEL=1,ERR=1
100 .I $G(ERR) W !!,"ERROR - Duplicate entry exists - '",$P(LOC0,U),"' DELETED.",!
101 I $G(DEL) S DIK="^ORD(100.6,"_SUB1_",5,",DA=SUB2,DA(1)=SUB1 D ^DIK
102 Q
103 ;
104CLEAR(TENT,MENT,FIELD) ;Clear selected fields
105 N DA,DIE,Y,X,FILE
106 S FILE(100.62,MENT_","_TENT_",",FIELD)="@" D FILE^DIE("","FILE")
107 Q
Note: See TracBrowser for help on using the repository browser.