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

SDAMEVT.m

Go to the documentation of this file.
SDAMEVT ;ALB/MJK - Appt Event Driver Utilities ; 12/1/91 [ 09/19/96  1:39 PM ]
 ;;5.3;Scheduling;**15,132,443,717**;Aug 13, 1993;Build 12
 ;;Per VHA Directive 2004-038, this routine should not be modified
 ;
BEFORE(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get before values
 K ^TMP("SDAMEVT",$J)
 D CAPTURE("BEFORE",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
 Q
 ;
AFTER(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get after values
 D CAPTURE("AFTER",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
 Q
 ;
HANDLE(SDORG) ; -- get evt handle
 ;  SDORG = originating process (1=appt , 2=a/e , 3=disp)
 S (Y,^($J))=$G(^TMP("SDEVT HANDLE",$J))+1
 Q Y
 ;
CLEAN(SDHDL) ;
 K ^TMP("SDEVT",$J,SDHDL)
 Q
 ;
HDLKILL ; -- kill off handle data
 K SDHDL,^TMP("SDEVT HANDLE",$J),^TMP("SDEVT",$J)
 Q
 ;
CAPTURE(SDCAP,SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ;
 N Z
 S (Z,^TMP("SDAMEVT",$J,SDCAP,"DPT"),^TMP("SDEVT",$J,SDHDL,1,"DPT",0,SDCAP))=$G(^DPT(DFN,"S",SDT,0))
 S (^TMP("SDAMEVT",$J,SDCAP,"SC"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,SDCAP))=$G(^SC(SDCL,"S",SDT,1,+SDDA,0))
 S (^TMP("SDAMEVT",$J,SDCAP,"STATUS"),SDATA(SDCAP,"STATUS"))=$TR($$STATUS^SDAM1(DFN,SDT,SDCL,Z,SDDA),";","^")
 D:$P(Z,U,20) OE(.SDCAP,1,$P(Z,U,20),.SDHDL)
 Q
 ;
 ;
EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ; -- calls the sdam event protocol
 N OROLD
 K DTOUT,DIROUT
 I $G(SDATA("BEFORE","STATUS"))=$G(SDATA("AFTER","STATUS")),'$$COMP^SDAMEVT4(SDHDL,SDAMEVT) G EVTQ  ; SD*5.3*443
 S:$P(SDATA,U,3) $P(SDATA,U,5)=$$REQ^SDM1A(+$P(SDATA,U,3))
 I SDMODE=2 N DGQUIET S DGQUIET=1  ;*zeb 10/4/18 717 set DGQUIET to suppress user interaction when called from GUI
 S X=+$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))_";ORD(101,"
 D EN^XQOR
EVTQ K XQORPOP,X,^TMP("SDAMEVT",$J) D CLEAN(SDHDL) Q
 ;
 ;
MAKE(DFN,SDT,SDCL,SDDA,SDMODE) ; -- make appt event #1
 N SDATA,%,SDMKHDL,SDHDL K ^TMP("SDAMEVT",$J)
 S SDMKHDL=$$HANDLE(1)
 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"))=""
 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
 D EVT(.SDATA,1,+$G(SDMODE),SDMKHDL)  ;*zeb 10/25/18 717 fix typo with SDMODE so SDMODE is passed correctly
 Q:SDMODE=2  ;*zeb 10/24/18 717 don't need check in/out code below if calling from GUI
 ; -- if appt d/t is less than NOW then check-in
 D NOW^%DTC
 I SDT<% W:'$G(SDMODE) ! D
 .N SDACT,SDCOQUIT
 .S SDDA=+SDATA,DFN=$P(SDATA,U,2),SDT=$P(SDATA,U,3),SDCL=$P(SDATA,U,4) K SDATA
 .I $$REQ^SDM1A(SDT)="CO",'$G(SDCOACT) D
 ..S SDACT=$S(SDT<DT:"CO",1:$$ASK^SDAMEX) I SDACT']"" S SDCOQUIT=1 Q
 ..I SDACT="CO" D CO^SDCO1(DFN,SDT,SDCL,SDDA,0,SDT)
 .I '$G(SDCOQUIT),$G(SDACT)'="CO" D ONE^SDAM2(DFN,SDCL,SDT,SDDA,0,SDT)
 Q
 ;
 ;
CANCEL(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- cancel event #2
 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
 I (SDMODE'=2),("^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)  ;*zeb 10/25/18 717 status has already changed for GUI calls
 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
 D EVT(.SDATA,2,$S(SDMODE=2:2,1:0),SDHDL)  ;*zeb 10/25/18 717 don't assume SDMODE is 0 if it is 2
 Q
 ;
 ;
NOSHOW(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- no-show event #3
 D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
 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)
 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
 D EVT(.SDATA,3,0,SDHDL)
 Q
 ;
OE(SDCAP,SDORG,SDOE,SDHDL) ; -- set up encounter data
 N I,OP,FILE,X,SDKID
 ;
 ; -- set up 'OP'posite variable
 S OP=$S(SDCAP="BEFORE":"AFTER",1:"BEFORE")
 ;
 ; -- set zero of oe
 S X=$G(^SCE(SDOE,0))
 S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,SDCAP)=X
 S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,OP)) ^(OP)=""
 ;
 ; -- save other data
 S FILE=409.42
 S I=0 F  S I=$O(^SDD(FILE,"OE",SDOE,I)) Q:'I  D
 . S X=$G(^SDD(FILE,I,0))
 . S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,SDCAP)=X
 . S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,OP)) ^(OP)=""
 ;
 IF SDORG'=1,SDORG'=3 G OEQ
 ;
 ; -- gets children oe's
 S SDKID=0
 F  S SDKID=$O(^SCE("APAR",SDOE,SDKID)) Q:'SDKID  D
 . S X=$G(^SCE(SDKID,0))
 . IF $P(X,U,8)'=4 Q  ; -- must be a credit stop encounter
 . S ^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,SDCAP)=X
 . S:'$D(^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,OP)) ^(OP)=""
OEQ Q
 ;
OECHG(SDORG,SDHDL) ; -- compare befores and afters
 N Y,I,SDOE S (Y,SDOE)=0
 F  S SDOE=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE)) Q:'SDOE  D  Q:Y
 . S I=0
 . 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
 Q Y
 ;
OEVT(SDOE,SDCAP,SDHDL,SDATA,SDOE0) ; -- event driver calls by oe
 ; SDATA only required for appts
 ; SDOE0 only required for check out deletion AFTER
 ;
 N SD0,SDORG,SDT,DFN,SDDA,SDCL,SDOEP
 S SD0=$S($D(^SCE(SDOE,0)):^(0),1:$G(SDOE0)),SDOEP=$P(SD0,U,6)
 I SD0']""!(SDOEP) G OEVTQ
 S SDT=+SD0,DFN=+$P(SD0,U,2),SDCL=+$P(SD0,U,4),SDORG=+$P(SD0,U,8),SDDA=$P(SD0,U,9)
 I SDCAP="BEFORE" D
 .I SDORG=1 D BEFORE(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL) Q
 .I SDORG=2 D BEFORE^SDAMEVT2(SDOE,SDHDL) Q
 .I SDORG=3 D BEFORE^SDAMEVT3(DFN,SDT,9,SDHDL)
 I SDCAP="AFTER" D
 .I SDORG=1 S SDATA=SDDA_"^"_DFN_"^"_SDT_"^"_SDCL D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL),EVT(.SDATA,5,0,SDHDL) Q
 .I SDORG=2 D EVT^SDAMEVT2(SDOE,7,SDHDL) Q
 .I SDORG=3 D EVT^SDAMEVT3(DFN,SDT,9,SDHDL)
OEVTQ Q
 ;
 ; -- SEE SDAMEVT0 FOR DOC ON VARIABLES