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. 
  1. SDAMEVT ;ALB/MJK - Appt Event Driver Utilities ; 12/1/91 [ 09/19/96  1:39 PM ]
  1.  ;;5.3;Scheduling;**15,132,443,1005,1015**;Aug 13, 1993;Build 21
  1.  ;IHS/ANMC/LJF 7/06/2000 assume Check-in if appt is TODAY
  1.  ;             7/31/2001 bypass checkin if in silent mode
  1.  ;             1/04/2002 kill visit variables after event driver
  1.  ;             9/18/2003 added BSDOPT to kill list
  1.  ;IHS/OIT/LJF  05/25/2006 PATCH 1005 prevent checking in walkins with temp chart #s
  1.  ;
  1. BEFORE(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get before values
  1.  K ^TMP("SDAMEVT",$J)
  1.  D CAPTURE("BEFORE",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
  1.  Q
  1.  ;
  1. AFTER(SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ; -- get after values
  1.  D CAPTURE("AFTER",.SDATA,.DFN,.SDT,.SDCL,.SDDA,.SDHDL)
  1.  Q
  1.  ;
  1. HANDLE(SDORG) ; -- get evt handle
  1.  ;  SDORG = originating process (1=appt , 2=a/e , 3=disp)
  1.  S (Y,^($J))=$G(^TMP("SDEVT HANDLE",$J))+1
  1.  Q Y
  1.  ;
  1. CLEAN(SDHDL) ;
  1.  K ^TMP("SDEVT",$J,SDHDL)
  1.  Q
  1.  ;
  1. HDLKILL ; -- kill off handle data
  1.  K SDHDL,^TMP("SDEVT HANDLE",$J),^TMP("SDEVT",$J)
  1.  Q
  1.  ;
  1. CAPTURE(SDCAP,SDATA,DFN,SDT,SDCL,SDDA,SDHDL) ;
  1.  N Z
  1.  S (Z,^TMP("SDAMEVT",$J,SDCAP,"DPT"),^TMP("SDEVT",$J,SDHDL,1,"DPT",0,SDCAP))=$G(^DPT(DFN,"S",SDT,0))
  1.  S (^TMP("SDAMEVT",$J,SDCAP,"SC"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,SDCAP))=$G(^SC(SDCL,"S",SDT,1,+SDDA,0))
  1.  S (^TMP("SDAMEVT",$J,SDCAP,"STATUS"),SDATA(SDCAP,"STATUS"))=$TR($$STATUS^SDAM1(DFN,SDT,SDCL,Z,SDDA),";","^")
  1.  D:$P(Z,U,20) OE(.SDCAP,1,$P(Z,U,20),.SDHDL)
  1.  Q
  1.  ;
  1.  ;
  1. EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ; -- calls the sdam event protocol
  1.  N OROLD
  1.  K DTOUT,DIROUT
  1.  I $G(SDATA("BEFORE","STATUS"))=$G(SDATA("AFTER","STATUS")),'$$COMP^SDAMEVT4(SDHDL,SDAMEVT) G EVTQ  ; SD*5.3*443
  1.  S:$P(SDATA,U,3) $P(SDATA,U,5)=$$REQ^SDM1A(+$P(SDATA,U,3))
  1.  ;S X=+$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))_";ORD(101,"  ;IHS/ANMC/LJF 6/22/2000
  1.  S X=+$O(^ORD(101,"B","BSDAM APPOINTMENT EVENTS",0))_";ORD(101,"  ;IHS/ANMC/LJF 6/22/2000
  1.  D EN^XQOR
  1.  K BSDVSTN,BSDVCN,BSDOPT   ;IHS/ANMC/LJF 1/04/2002;9/18/2003
  1. EVTQ K XQORPOP,X,^TMP("SDAMEVT",$J) D CLEAN(SDHDL) Q
  1.  ;
  1.  ;
  1. MAKE(DFN,SDT,SDCL,SDDA,SDMODE) ; -- make appt event #1
  1.  N SDATA,%,SDMKHDL,SDHDL K ^TMP("SDAMEVT",$J)
  1.  S SDMKHDL=$$HANDLE(1)
  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"))=""
  1.  D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
  1.  S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1.  ;9/26/2002 WAR per LJF23
  1.  ;D EVT(.SDATA,1,+$G(SDAMODE),SDMKHDL)     ;IHS/ANMC/LJF 8/07/2002
  1.  D EVT(.SDATA,1,+$G(SDMODE),SDMKHDL)      ;IHS/ANMC/LJF 8/07/2002 fixed variable spelling
  1.  ; -- if appt d/t is less than NOW then check-in
  1.  D NOW^%DTC
  1.  I SDT<% W:'$G(SDMODE) ! D
  1.  .N SDACT,SDCOQUIT
  1.  .S SDDA=+SDATA,DFN=$P(SDATA,U,2),SDT=$P(SDATA,U,3),SDCL=$P(SDATA,U,4) K SDATA
  1.  .I $G(SDMODE)=2 Q  ;IHS/ANMC/LJF 7/31/2001
  1.  .;
  1.  .;IHS/OIT/LJF 05/25/2006 PATCH 1005
  1.  .I $$HRCN^BDGF2(DFN,DUZ(2))["T" D  Q
  1.  .. W !?5,"**** CANNOT check in patient with temporary chart #. ****"
  1.  .. D PAUSE^BDGF
  1.  .;
  1.  .I $$REQ^SDM1A(SDT)="CO",'$G(SDCOACT) D
  1.  ..;S SDACT=$S(SDT<DT:"CO",1:$$ASK^SDAMEX) I SDACT']"" S SDCOQUIT=1 Q
  1.  ..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
  1.  ..I SDACT="CO" D CO^SDCO1(DFN,SDT,SDCL,SDDA,0,SDT)
  1.  .I '$G(SDCOQUIT),$G(SDACT)'="CO" D ONE^SDAM2(DFN,SDCL,SDT,SDDA,0,SDT)
  1.  Q
  1.  ;
  1.  ;
  1. CANCEL(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- cancel event #2
  1.  D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
  1.  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)
  1.  S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1.  D EVT(.SDATA,2,0,SDHDL)
  1.  Q
  1.  ;
  1.  ;
  1. NOSHOW(SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDHDL) ; -- no-show event #3
  1.  D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
  1.  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)
  1.  S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
  1.  D EVT(.SDATA,3,0,SDHDL)
  1.  Q
  1.  ;
  1. OE(SDCAP,SDORG,SDOE,SDHDL) ; -- set up encounter data
  1.  N I,OP,FILE,X,SDKID
  1.  ;
  1.  ; -- set up 'OP'posite variable
  1.  S OP=$S(SDCAP="BEFORE":"AFTER",1:"BEFORE")
  1.  ;
  1.  ; -- set zero of oe
  1.  S X=$G(^SCE(SDOE,0))
  1.  S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,SDCAP)=X
  1.  S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,0,OP)) ^(OP)=""
  1.  ;
  1.  ; -- save other data
  1.  S FILE=409.42
  1.  S I=0 F  S I=$O(^SDD(FILE,"OE",SDOE,I)) Q:'I  D
  1.  . S X=$G(^SDD(FILE,I,0))
  1.  . S ^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,SDCAP)=X
  1.  . S:'$D(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE,"CL",I,0,OP)) ^(OP)=""
  1.  ;
  1.  IF SDORG'=1,SDORG'=3 G OEQ
  1.  ;
  1.  ; -- gets children oe's
  1.  S SDKID=0
  1.  F  S SDKID=$O(^SCE("APAR",SDOE,SDKID)) Q:'SDKID  D
  1.  . S X=$G(^SCE(SDKID,0))
  1.  . IF $P(X,U,8)'=4 Q  ; -- must be a credit stop encounter
  1.  . S ^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,SDCAP)=X
  1.  . S:'$D(^TMP("SDEVT",$J,SDHDL,4,"SDOE",SDKID,0,OP)) ^(OP)=""
  1. OEQ Q
  1.  ;
  1. OECHG(SDORG,SDHDL) ; -- compare befores and afters
  1.  N Y,I,SDOE S (Y,SDOE)=0
  1.  F  S SDOE=$O(^TMP("SDEVT",$J,SDHDL,SDORG,"SDOE",SDOE)) Q:'SDOE  D  Q:Y
  1.  . S I=0
  1.  . 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
  1.  Q Y
  1.  ;
  1. OEVT(SDOE,SDCAP,SDHDL,SDATA,SDOE0) ; -- event driver calls by oe
  1.  ; SDATA only required for appts
  1.  ; SDOE0 only required for check out deletion AFTER
  1.  ;
  1.  N SD0,SDORG,SDT,DFN,SDDA,SDCL,SDOEP
  1.  S SD0=$S($D(^SCE(SDOE,0)):^(0),1:$G(SDOE0)),SDOEP=$P(SD0,U,6)
  1.  I SD0']""!(SDOEP) G OEVTQ
  1.  S SDT=+SD0,DFN=+$P(SD0,U,2),SDCL=+$P(SD0,U,4),SDORG=+$P(SD0,U,8),SDDA=$P(SD0,U,9)
  1.  I SDCAP="BEFORE" D
  1.  .I SDORG=1 D BEFORE(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL) Q
  1.  .I SDORG=2 D BEFORE^SDAMEVT2(SDOE,SDHDL) Q
  1.  .I SDORG=3 D BEFORE^SDAMEVT3(DFN,SDT,9,SDHDL)
  1.  I SDCAP="AFTER" D
  1.  .I SDORG=1 S SDATA=SDDA_"^"_DFN_"^"_SDT_"^"_SDCL D AFTER(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL),EVT(.SDATA,5,0,SDHDL) Q
  1.  .I SDORG=2 D EVT^SDAMEVT2(SDOE,7,SDHDL) Q
  1.  .I SDORG=3 D EVT^SDAMEVT3(DFN,SDT,9,SDHDL)
  1. OEVTQ Q
  1.  ;
  1.  ; -- SEE SDAMEVT0 FOR DOC ON VARIABLES