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,1005,1015**;Aug 13, 1993;Build 21
 ;IHS/ANMC/LJF 7/06/2000 assume Check-in if appt is TODAY
 ;             7/31/2001 bypass checkin if in silent mode
 ;             1/04/2002 kill visit variables after event driver
 ;             9/18/2003 added BSDOPT to kill list
 ;IHS/OIT/LJF  05/25/2006 PATCH 1005 prevent checking in walkins with temp chart #s
 ;
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))
 ;S X=+$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))_";ORD(101,"  ;IHS/ANMC/LJF 6/22/2000
 S X=+$O(^ORD(101,"B","BSDAM APPOINTMENT EVENTS",0))_";ORD(101,"  ;IHS/ANMC/LJF 6/22/2000
 D EN^XQOR
 K BSDVSTN,BSDVCN,BSDOPT   ;IHS/ANMC/LJF 1/04/2002;9/18/2003
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
 ;9/26/2002 WAR per LJF23
 ;D EVT(.SDATA,1,+$G(SDAMODE),SDMKHDL)     ;IHS/ANMC/LJF 8/07/2002
 D EVT(.SDATA,1,+$G(SDMODE),SDMKHDL)      ;IHS/ANMC/LJF 8/07/2002 fixed variable spelling
 ; -- 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 $G(SDMODE)=2 Q  ;IHS/ANMC/LJF 7/31/2001
 .;
 .;IHS/OIT/LJF 05/25/2006 PATCH 1005
 .I $$HRCN^BDGF2(DFN,DUZ(2))["T" D  Q
 .. W !?5,"**** CANNOT check in patient with temporary chart #. ****"
 .. D PAUSE^BDGF
 .;
 .I $$REQ^SDM1A(SDT)="CO",'$G(SDCOACT) D
 ..;S SDACT=$S(SDT<DT:"CO",1:$$ASK^SDAMEX) I SDACT']"" S SDCOQUIT=1 Q
 ..S SDACT=$S(SDT<DT:"CO",SDT\1=DT:"CI",1:$$ASK^SDAMEX) I SDACT']"" S SDCOQUIT=1 Q  ;IHS/ANMC/LJF 7/06/2000
 ..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 "^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)
 S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
 D EVT(.SDATA,2,0,SDHDL)
 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