source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMEVT.m@ 1150

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1SDAMEVT ;ALB/MJK - Appt Event Driver Utilities ; 12/1/91 [ 09/19/96 1:39 PM ]
2 ;;5.3;Scheduling;**15,132,443**;Aug 13, 1993
3 ;
4BEFORE(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get before values
5 K ^TMP("SDAMEVT",$J)
6 D CAPTURE("BEFORE",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
7 Q
8 ;
9AFTER(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get after values
10 D CAPTURE("AFTER",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
11 Q
12 ;
13HANDLE(SDORG) ; -- get evt handle
14 ; SDORG = originating process (1=appt , 2=a/e , 3=disp)
15 S (Y,^($J))=$G(^TMP("SDEVT HANDLE",$J))+1
16 Q Y
17 ;
18CLEAN(SDHDL) ;
19 K ^TMP("SDEVT",$J,SDHDL)
20 Q
21 ;
22HDLKILL ; -- kill off handle data
23 K SDHDL,^TMP("SDEVT HANDLE",$J),^TMP("SDEVT",$J)
24 Q
25 ;
26CAPTURE(SDCAP,SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ;
27 N Z
28 S (Z,^TMP("SDAMEVT",$J,SDCAP,"DPT"),^TMP("SDEVT",$J,SDHDL,1,"DPT",0,SDCAP))=$G(^DPT(DFN,"S",SDT,0))
29 S (^TMP("SDAMEVT",$J,SDCAP,"SC"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,SDCAP))=$G(^SC(SDCL,"S",SDT,1,+SDDA,0))
30 S (^TMP("SDAMEVT",$J,SDCAP,"STATUS"),SDATA(SDCAP,"STATUS"))=$TR($$STATUS^SDAM1(DFN,SDT,SDCL,Z,SDDA),";","^")
31 D:$P(Z,U,20) OE(.SDCAP,1,$P(Z,U,20),.SDHDL)
32 Q
33 ;
34 ;
35EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ; -- calls the sdam event protocol
36 N OROLD
37 K DTOUT,DIROUT
38 I $G(SDATA("BEFORE","STATUS"))=$G(SDATA("AFTER","STATUS")),'$$COMP^SDAMEVT4(SDHDL,SDAMEVT) G EVTQ ; SD*5.3*443
39 S:$P(SDATA,U,3) $P(SDATA,U,5)=$$REQ^SDM1A(+$P(SDATA,U,3))
40 S X=+$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))_";ORD(101,"
41 D EN^XQOR
42EVTQ K XQORPOP,X,^TMP("SDAMEVT",$J) D CLEAN(SDHDL) Q
43 ;
44 ;
45MAKE(DFN,SDT,SDCL,SDDA,SDMODE) ; -- make appt event #1
46 N SDATA,%,SDMKHDL,SDHDL K ^TMP("SDAMEVT",$J)
47 S SDMKHDL=$$HANDLE(1)
48 S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),SDATA("BEFORE","STATUS"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"),^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
49 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
50 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
51 D EVT(.SDATA,1,+$G(SDAMODE),SDMKHDL)
52 ; -- if appt d/t is less than NOW then check-in
53 D NOW^%DTC
54 I SDT<% W:'$G(SDMODE) ! D
55 .N SDACT,SDCOQUIT
56 .S SDDA=+SDATA,DFN=$P(SDATA,U,2),SDT=$P(SDATA,U,3),SDCL=$P(SDATA,U,4) K SDATA
57 .I $$REQ^SDM1A(SDT)="CO",'$G(SDCOACT) D
58 ..S SDACT=$S(SDT<DT:"CO",1:$$ASK^SDAMEX) I SDACT']"" S SDCOQUIT=1 Q
59 ..I SDACT="CO" D CO^SDCO1(DFN,SDT,SDCL,SDDA,0,SDT)
60 .I '$G(SDCOQUIT),$G(SDACT)'="CO" D ONE^SDAM2(DFN,SDCL,SDT,SDDA,0,SDT)
61 Q
62 ;
63 ;
64CANCEL(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- cancel event #2
65 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
66 I "^5^7^9^10^"[("^"_+SDATA("AFTER","STATUS")_"^"),$P($G(^DPT(DFN,"S",SDT,0)),"^",20) D EN^SDCODEL(+$P(^(0),"^",20),0,SDHDL),OENUL^SDAMEVT1("AFTER",SDHDL)
67 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
68 D EVT(.SDATA,2,0,SDHDL)
69 Q
70 ;
71 ;
72NOSHOW(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- no-show event #3
73 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
74 I "^4^6^"[("^"_+SDATA("AFTER","STATUS")_"^"),$P($G(^DPT(DFN,"S",SDT,0)),"^",20) D EN^SDCODEL(+$P(^(0),"^",20),0,SDHDL),OENUL^SDAMEVT1("AFTER",SDHDL)
75 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
76 D EVT(.SDATA,3,0,SDHDL)
77 Q
78 ;
79OE(SDCAP,SDORG,SDOE,SDHDL) ; -- set up encounter data
80 N I,OP,FILE,X,SDKID
81 ;
82 ; -- set up 'OP'posite variable
83 S OP=$S(SDCAP="BEFORE":"AFTER",1:"BEFORE")
84 ;
85 ; -- set zero of oe
86 S X=$G(^SCE(SDOE,0))
87 S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,SDCAP)=X
88 S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,OP)) ^(OP)=""
89 ;
90 ; -- save other data
91 S FILE=409.42
92 S I=0 F S I=$O(^SDD(FILE,"OE",SDOE,I)) Q:'I D
93 . S X=$G(^SDD(FILE,I,0))
94 . S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,SDCAP)=X
95 . S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,OP)) ^(OP)=""
96 ;
97 IF SDORG'=1,SDORG'=3 G OEQ
98 ;
99 ; -- gets children oe's
100 S SDKID=0
101 F S SDKID=$O(^SCE("APAR",SDOE,SDKID)) Q:'SDKID D
102 . S X=$G(^SCE(SDKID,0))
103 . IF $P(X,U,8)'=4 Q ; -- must be a credit stop encounter
104 . S ^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,SDCAP)=X
105 . S:'$D(^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,OP)) ^(OP)=""
106OEQ Q
107 ;
108OECHG(SDORG,SDHDL) ; -- compare befores and afters
109 N Y,I,SDOE S (Y,SDOE)=0
110 F S SDOE=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE)) Q:'SDOE D Q:Y
111 . S I=0
112 . F S I=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I)) Q:'I I $G(^(I,0,"BEFORE"))='$G(^("AFTER")) S Y=1 Q
113 Q Y
114 ;
115OEVT(SDOE,SDCAP,SDHDL,SDATA,SDOE0) ; -- event driver calls by oe
116 ; SDATA only required for appts
117 ; SDOE0 only required for check out deletion AFTER
118 ;
119 N SD0,SDORG,SDT,DFN,SDDA,SDCL,SDOEP
120 S SD0=$S($D(^SCE(SDOE,0)):^(0),1:$G(SDOE0)),SDOEP=$P(SD0,U,6)
121 I SD0']""!(SDOEP) G OEVTQ
122 S SDT=+SD0,DFN=+$P(SD0,U,2),SDCL=+$P(SD0,U,4),SDORG=+$P(SD0,U,8),SDDA=$P(SD0,U,9)
123 I SDCAP="BEFORE" D
124 .I SDORG=1 D BEFORE(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL) Q
125 .I SDORG=2 D BEFORE^SDAMEVT2(SDOE,SDHDL) Q
126 .I SDORG=3 D BEFORE^SDAMEVT3(DFN,SDT,9,SDHDL)
127 I SDCAP="AFTER" D
128 .I SDORG=1 S SDATA=SDDA_"^"_DFN_"^"_SDT_"^"_SDCL D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL),EVT(.SDATA,5,0,SDHDL) Q
129 .I SDORG=2 D EVT^SDAMEVT2(SDOE,7,SDHDL) Q
130 .I SDORG=3 D EVT^SDAMEVT3(DFN,SDT,9,SDHDL)
131OEVTQ Q
132 ;
133 ; -- SEE SDAMEVT0 FOR DOC ON VARIABLES
Note: See TracBrowser for help on using the repository browser.