SDEC31 ;ALB/SAT,PC - VISTA SCHEDULING RPCS ;Jul 23, 2021@15:22
;;5.3;Scheduling;**627,683,717,740,694,792,794,805**;Aug 13, 1993;Build 9
;
Q
;
NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE) ;Sets appointment noshow flag in SDEC APPOINTMENT file
;NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE) external parameter tag is in SDEC
;Called by SDEC NOSHOW
;SDECAPTID - (required) Appointment ID - Pointer to SDEC APPOINTMENT file
;SDECNS - (required) Cancel flag 1=YES (Set NOSHOW); 0=NO (Cancel NOSHOW)
;USERIEN - (optional) User that entered NoShow pointer to NEW PERSON
; default to current user
;SDECDATE - (optional) Date/Time that No-show was entered in external format
; default to NOW.
;Calls CANCEL^SDEC08 to set noshow data in ^DPT <<== NOT TRUE wtc 10/25/18
;Returns error code in recordset field ERRORID
;
N SDECNOD,DFN,SDECSTART,SDECID,SDECI,SDECZ,SDECERR,SDECMSG,SDFDA,SDECIENS,REQTYPE,CONS,CONSULTIEN,PROVIDER,NOTE,DATETIME,RESOURCE,REQSET
N SDECNOEV,%DT,X,Y,SDECOE,REQNODE,REQIEN
S SDECNOEV=1 ;Don't execute protocol
;
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S ^TMP("SDEC",$J,SDECI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
S SDECI=SDECI+1
;validate SDEC appointment ID
I '+SDECAPTID D ERR(0,"SDEC31: Invalid Appointment ID") Q
I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR(0,"SDEC31: Invalid Appointment ID") Q
;validate cancel flag
S SDECNS=$G(SDECNS)
S SDECNS=$S(SDECNS="YES":1,SDECNS=1:1,SDECNS="NO":0,SDECNS=0:0,1:"")
I SDECNS="" D ERR(0,"SDEC31: Invalid No Show value") Q
;validate user IEN (optional)
S USERIEN=$G(USERIEN)
I USERIEN'="" I '$D(^VA(200,+USERIEN,0)) S USERIEN=""
I USERIEN="" S USERIEN=DUZ
;validate cancel date/time (optional)
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
;S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y
S SDECDATE=$G(SDECDATE)
;I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE=""
I SDECDATE'="" S SDECDATE=$$NETTOFM^SDECDATE(SDECDATE,"Y","Y") I SDECDATE=-1 S SDECDATE="" ;
I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT
;
;Edit SDEC APPOINTMENT entry NOSHOW field
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
;I SDECNOD="" D ERR(0,"SDEC31: Invalid Appointment ID") Q
S DFN=$P(SDECNOD,U,5)
S SDECSTART=$P(SDECNOD,U)
;
;Modify PID CHANGE ALLOWED Field in 409.85 based on whether no-show or cancel no-show
S REQNODE=$G(^SDEC(409.84,SDECAPTID,2))
S REQIEN=$P(REQNODE,";")
I SDECNS=1 D
.S FDA(409.85,REQIEN_",",49)=1
I SDECNS=0 D
.S FDA(409.85,REQIEN_",",49)=0
D FILE^DIE(,"FDA","ERR") K FDA
; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
;
N SDATA,SDDA,SDCIHDL,SDECR1,SDECSC1
S SDECR1=$P(SDECNOD,U,7) ;RESOURCEID
I SDECR1="" D ERR(0,"SDEC31: Missing resource") Q
S SDECNOD=$G(^SDEC(409.831,SDECR1,0)) I SDECNOD="" D ERR(0,"SDEC31: Resource node missing") Q
S SDECSC1=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
I SDECSC1="" D ERR(0,"SDEC31: No location for resource") Q
I '$D(^SC(SDECSC1,0)) D ERR(0,"SDEC31: Location node missing") Q
;
S SDDA=$$FIND^SDEC25(DFN,SDECSTART,SDECSC1),SDATA=SDDA_U_DFN_U_SDECSTART_U_SDECSC1,SDCIHDL=$$HANDLE^SDAMEVT(1)
D BEFORE^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
;
; Process no show
;
D SDECNOS(SDECAPTID,SDECNS,USERIEN,SDECDATE)
I $D(SDECMSG("DIERR")) S SDECMSG=$G(SDECMSG("DIERR",1,"TEXT",1)) D ERR(0,"SDEC31: "_SDECMSG) Q
D APNOSHO(.SDECZ,SDECSC1,DFN,SDECSTART,SDECNS,USERIEN,SDECDATE,SDECAPTID)
I +$G(SDECZ) S SDECERR="SDEC31: APNOSHO Returned: "_SDECZ D ERR(0,SDECERR) Q
;
;*zeb+2 683 2/6/18 fix action required in PCE after no-show from GUI
S SDECOE=$P($G(^DPT(DFN,"S",SDECSTART,0)),"^",20)
I SDECOE D EN^SDCODEL(SDECOE,2,"","NOSHOW") ;*zeb 717 11/13/18 suppress event logging for cancel checkout when no-showing
;
; Event driver "AFTER" actions - wtc SD*5.3*717 10/24/18
;
;remove undo no-show from grid; /BLB/
;
S REQTYPE=$$GET1^DIQ(409.84,SDECAPTID,.22,"E")
I SDECNS=0,REQTYPE="CONSULT" D
.S CONS=$$GET1^DIQ(409.84,SDECAPTID,.22,"I"),CONSULTIEN=$P(CONS,";",1)
.S PROVIDER=$$GET1^DIQ(409.84,SDECAPTID,.16,"I")
.S NOTE=$$GET1^DIQ(409.84,SDECAPTID,1,"E")
.S DATETIME=$$GET1^DIQ(409.84,SDECAPTID,.01,"E")
.S RESOURCE=$$GET1^DIQ(409.84,SDECAPTID,.07,"I")
.D REQSET^SDEC07A(CONSULTIEN,PROVIDER,,1,,NOTE,DATETIME,RESOURCE)
;
D AFTER^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
;
; Execute event driver. 3=no show (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
;
D EVT^SDAMEVT(.SDATA,3,2,SDCIHDL) ;
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="1^"_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
APNOSHO(SDECZ,SDCL,DFN,SDT,SDECNS,USERIEN,SDECCDT,SDAPID) ;
; update file 2 info
;Set noshow for patient DFN in clinic SDCL
;at time SDT
N SDECC,%H,SDECIEN,SDRTYP
N SDECIENS,SDFDA,SDECMSG,IEN
S %H=$H D YMD^%DTC
;
S SDECIENS=SDT_","_DFN_","
I +SDECNS D
. S SDFDA(2.98,SDECIENS,3)="N"
. S SDFDA(2.98,SDECIENS,14)=USERIEN
. S SDFDA(2.98,SDECIENS,15)=SDECCDT
E D
. S SDFDA(2.98,SDECIENS,3)=""
. S SDFDA(2.98,SDECIENS,14)=""
. S SDFDA(2.98,SDECIENS,15)=""
K SDECIEN
D UPDATE^DIE("","SDFDA","SDECIEN","SDECMSG")
S SDECZ=$G(SDECMSG("DIERR",1,"TEXT",1))
S SDRTYP=$$GET1^DIQ(409.84,SDAPID_",",.22,"I")
I $P(SDRTYP,";",2)="GMR(123," D
.S IEN=$$SCIEN^SDECU2(DFN,SDCL,SDT)
.D NOSHOW^SDCNSLT(SDCL,SDT,DFN,$P(SDRTYP,";",1),IEN) ;,AUTO,NSDIE,NSDA)
;
;for Recall Request APPT NOSHOW ;VSE-1219;**792
I $P(SDRTYP,";",2)="SD(403.5," D RECREQ^SDECRECREQ(.SDECY,SDECAPTID,SDRTYP)
Q
;
SDECNOS(SDECAPTID,SDECNS,USERIEN,SDECDATE) ;
;
N SDFDA,SDECIENS
S SDECIENS=SDECAPTID_","
S SDFDA(409.84,SDECIENS,.1)=SDECNS ;NOSHOW
S SDFDA(409.84,SDECIENS,.101)=$S(+SDECNS:SDECDATE,1:"") ;NOSHOW DATE
S SDFDA(409.84,SDECIENS,.102)=$S(+SDECNS:USERIEN,1:"") ;NOSHOW USER
S SDFDA(409.84,SDECIENS,.17)=$S(+SDECNS:"N",1:"") ; Update STATUS SD*5.3*717 wtc 10/25/18
D FILE^DIE("","SDFDA","SDECMSG")
;
Q
;
NOSEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC NOSHOW APPOINTMENT event
;when appointments NOSHOW via PIMS interface.
;Propagates NOSHOW to SDECAPPT and raises refresh event to running GUI clients
;
Q:+$G(SDECNOEV)
Q:'+$G(SDECSC)
;Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
N SDECSTAT,SDECFOUND,SDECRES
S SDECSTAT=1
;S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" SDECSTAT=0
S SDECFOUND=0
I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$NOSEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
I SDECFOUND D NOSEVT3(SDECRES) Q
Q
;
NOSEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT) ;
;Get appointment id in SDECAPT
;If found, call SDECNOS(SDECAPPT) and return 1
;else return 0
N SDECFOUND,SDECAPPT
S SDECFOUND=0
Q:'+$G(SDECRES) SDECFOUND
Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND
S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND
. S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD=""
. I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q
I SDECFOUND,+$G(SDECAPPT) D SDECNOS(SDECAPPT,SDECSTAT)
Q SDECFOUND
;
NOSEVT3(SDECRES) ;
;Call RaiseEvent to notify GUI clients
;
Q
N SDECRESN
S SDECRESN=$G(^SDEC(409.831,SDECRES,0))
Q:SDECRESN=""
S SDECRESN=$P(SDECRESN,"^")
;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
Q
;
;
ERR(SDECERID,ERRTXT) ;Error processing
S:'+$G(SDECI) SDECI=999999
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECERID_"^"_ERRTXT_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ETRAP ;EP Error trap entry
D ^%ZTER
I '$D(SDECI) N SDECI S SDECI=999999
S SDECI=SDECI+1
D ERR(0,"SDEC31 Error")
Q
;
IMHERE(SDECRES) ;I'm Here
;IMHERE(SDECRES) external parameter tag is in SDEC
;Entry point for SDEC IM HERE remote procedure
; Returns a simple value to client. Used to establish continued existence
; of the client to the server; resets the server READ timeout.
S SDECRES=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC31 8134 printed Oct 16, 2024@18:51:01 Page 2
SDEC31 ;ALB/SAT,PC - VISTA SCHEDULING RPCS ;Jul 23, 2021@15:22
+1 ;;5.3;Scheduling;**627,683,717,740,694,792,794,805**;Aug 13, 1993;Build 9
+2 ;
+3 QUIT
+4 ;
NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE) ;Sets appointment noshow flag in SDEC APPOINTMENT file
+1 ;NOSHOW(SDECY,SDECAPTID,SDECNS,USERIEN,SDECDATE) external parameter tag is in SDEC
+2 ;Called by SDEC NOSHOW
+3 ;SDECAPTID - (required) Appointment ID - Pointer to SDEC APPOINTMENT file
+4 ;SDECNS - (required) Cancel flag 1=YES (Set NOSHOW); 0=NO (Cancel NOSHOW)
+5 ;USERIEN - (optional) User that entered NoShow pointer to NEW PERSON
+6 ; default to current user
+7 ;SDECDATE - (optional) Date/Time that No-show was entered in external format
+8 ; default to NOW.
+9 ;Calls CANCEL^SDEC08 to set noshow data in ^DPT <<== NOT TRUE wtc 10/25/18
+10 ;Returns error code in recordset field ERRORID
+11 ;
+12 NEW SDECNOD,DFN,SDECSTART,SDECID,SDECI,SDECZ,SDECERR,SDECMSG,SDFDA,SDECIENS,REQTYPE,CONS,CONSULTIEN,PROVIDER,NOTE,DATETIME,RESOURCE,REQSET
+13 NEW SDECNOEV,%DT,X,Y,SDECOE,REQNODE,REQIEN
+14 ;Don't execute protocol
SET SDECNOEV=1
+15 ;
+16 SET SDECI=0
+17 KILL ^TMP("SDEC",$JOB)
+18 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+19 SET ^TMP("SDEC",$JOB,SDECI)="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)
+20 SET SDECI=SDECI+1
+21 ;validate SDEC appointment ID
+22 IF '+SDECAPTID
DO ERR(0,"SDEC31: Invalid Appointment ID")
QUIT
+23 IF '$DATA(^SDEC(409.84,SDECAPTID,0))
DO ERR(0,"SDEC31: Invalid Appointment ID")
QUIT
+24 ;validate cancel flag
+25 SET SDECNS=$GET(SDECNS)
+26 SET SDECNS=$SELECT(SDECNS="YES":1,SDECNS=1:1,SDECNS="NO":0,SDECNS=0:0,1:"")
+27 IF SDECNS=""
DO ERR(0,"SDEC31: Invalid No Show value")
QUIT
+28 ;validate user IEN (optional)
+29 SET USERIEN=$GET(USERIEN)
+30 IF USERIEN'=""
IF '$DATA(^VA(200,+USERIEN,0))
SET USERIEN=""
+31 IF USERIEN=""
SET USERIEN=DUZ
+32 ;validate cancel date/time (optional)
+33 ;
+34 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+35 ;
+36 ;S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y
+37 SET SDECDATE=$GET(SDECDATE)
+38 ;I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE=""
+39 ;
IF SDECDATE'=""
SET SDECDATE=$$NETTOFM^SDECDATE(SDECDATE,"Y","Y")
IF SDECDATE=-1
SET SDECDATE=""
+40 IF $GET(SDECDATE)=""
SET SDECDATE=$$NOW^XLFDT
+41 ;
+42 ;Edit SDEC APPOINTMENT entry NOSHOW field
+43 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+44 ;I SDECNOD="" D ERR(0,"SDEC31: Invalid Appointment ID") Q
+45 SET DFN=$PIECE(SDECNOD,U,5)
+46 SET SDECSTART=$PIECE(SDECNOD,U)
+47 ;
+48 ;Modify PID CHANGE ALLOWED Field in 409.85 based on whether no-show or cancel no-show
+49 SET REQNODE=$GET(^SDEC(409.84,SDECAPTID,2))
+50 SET REQIEN=$PIECE(REQNODE,";")
+51 IF SDECNS=1
Begin DoDot:1
+52 SET FDA(409.85,REQIEN_",",49)=1
End DoDot:1
+53 IF SDECNS=0
Begin DoDot:1
+54 SET FDA(409.85,REQIEN_",",49)=0
End DoDot:1
+55 DO FILE^DIE(,"FDA","ERR")
KILL FDA
+56 ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
+57 ;
+58 NEW SDATA,SDDA,SDCIHDL,SDECR1,SDECSC1
+59 ;RESOURCEID
SET SDECR1=$PIECE(SDECNOD,U,7)
+60 IF SDECR1=""
DO ERR(0,"SDEC31: Missing resource")
QUIT
+61 SET SDECNOD=$GET(^SDEC(409.831,SDECR1,0))
IF SDECNOD=""
DO ERR(0,"SDEC31: Resource node missing")
QUIT
+62 ;HOSPITAL LOCATION
SET SDECSC1=$PIECE(SDECNOD,U,4)
+63 IF SDECSC1=""
DO ERR(0,"SDEC31: No location for resource")
QUIT
+64 IF '$DATA(^SC(SDECSC1,0))
DO ERR(0,"SDEC31: Location node missing")
QUIT
+65 ;
+66 SET SDDA=$$FIND^SDEC25(DFN,SDECSTART,SDECSC1)
SET SDATA=SDDA_U_DFN_U_SDECSTART_U_SDECSC1
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+67 DO BEFORE^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
+68 ;
+69 ; Process no show
+70 ;
+71 DO SDECNOS(SDECAPTID,SDECNS,USERIEN,SDECDATE)
+72 IF $DATA(SDECMSG("DIERR"))
SET SDECMSG=$GET(SDECMSG("DIERR",1,"TEXT",1))
DO ERR(0,"SDEC31: "_SDECMSG)
QUIT
+73 DO APNOSHO(.SDECZ,SDECSC1,DFN,SDECSTART,SDECNS,USERIEN,SDECDATE,SDECAPTID)
+74 IF +$GET(SDECZ)
SET SDECERR="SDEC31: APNOSHO Returned: "_SDECZ
DO ERR(0,SDECERR)
QUIT
+75 ;
+76 ;*zeb+2 683 2/6/18 fix action required in PCE after no-show from GUI
+77 SET SDECOE=$PIECE($GET(^DPT(DFN,"S",SDECSTART,0)),"^",20)
+78 ;*zeb 717 11/13/18 suppress event logging for cancel checkout when no-showing
IF SDECOE
DO EN^SDCODEL(SDECOE,2,"","NOSHOW")
+79 ;
+80 ; Event driver "AFTER" actions - wtc SD*5.3*717 10/24/18
+81 ;
+82 ;remove undo no-show from grid; /BLB/
+83 ;
+84 SET REQTYPE=$$GET1^DIQ(409.84,SDECAPTID,.22,"E")
+85 IF SDECNS=0
IF REQTYPE="CONSULT"
Begin DoDot:1
+86 SET CONS=$$GET1^DIQ(409.84,SDECAPTID,.22,"I")
SET CONSULTIEN=$PIECE(CONS,";",1)
+87 SET PROVIDER=$$GET1^DIQ(409.84,SDECAPTID,.16,"I")
+88 SET NOTE=$$GET1^DIQ(409.84,SDECAPTID,1,"E")
+89 SET DATETIME=$$GET1^DIQ(409.84,SDECAPTID,.01,"E")
+90 SET RESOURCE=$$GET1^DIQ(409.84,SDECAPTID,.07,"I")
+91 DO REQSET^SDEC07A(CONSULTIEN,PROVIDER,,1,,NOTE,DATETIME,RESOURCE)
End DoDot:1
+92 ;
+93 DO AFTER^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
+94 ;
+95 ; Execute event driver. 3=no show (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
+96 ;
+97 ;
DO EVT^SDAMEVT(.SDATA,3,2,SDCIHDL)
+98 ;
+99 SET SDECI=SDECI+1
+100 SET ^TMP("SDEC",$JOB,SDECI)="1^"_$CHAR(30)
+101 SET SDECI=SDECI+1
+102 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+103 QUIT
+104 ;
APNOSHO(SDECZ,SDCL,DFN,SDT,SDECNS,USERIEN,SDECCDT,SDAPID) ;
+1 ; update file 2 info
+2 ;Set noshow for patient DFN in clinic SDCL
+3 ;at time SDT
+4 NEW SDECC,%H,SDECIEN,SDRTYP
+5 NEW SDECIENS,SDFDA,SDECMSG,IEN
+6 SET %H=$HOROLOG
DO YMD^%DTC
+7 ;
+8 SET SDECIENS=SDT_","_DFN_","
+9 IF +SDECNS
Begin DoDot:1
+10 SET SDFDA(2.98,SDECIENS,3)="N"
+11 SET SDFDA(2.98,SDECIENS,14)=USERIEN
+12 SET SDFDA(2.98,SDECIENS,15)=SDECCDT
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET SDFDA(2.98,SDECIENS,3)=""
+15 SET SDFDA(2.98,SDECIENS,14)=""
+16 SET SDFDA(2.98,SDECIENS,15)=""
End DoDot:1
+17 KILL SDECIEN
+18 DO UPDATE^DIE("","SDFDA","SDECIEN","SDECMSG")
+19 SET SDECZ=$GET(SDECMSG("DIERR",1,"TEXT",1))
+20 SET SDRTYP=$$GET1^DIQ(409.84,SDAPID_",",.22,"I")
+21 IF $PIECE(SDRTYP,";",2)="GMR(123,"
Begin DoDot:1
+22 SET IEN=$$SCIEN^SDECU2(DFN,SDCL,SDT)
+23 ;,AUTO,NSDIE,NSDA)
DO NOSHOW^SDCNSLT(SDCL,SDT,DFN,$PIECE(SDRTYP,";",1),IEN)
End DoDot:1
+24 ;
+25 ;for Recall Request APPT NOSHOW ;VSE-1219;**792
+26 IF $PIECE(SDRTYP,";",2)="SD(403.5,"
DO RECREQ^SDECRECREQ(.SDECY,SDECAPTID,SDRTYP)
+27 QUIT
+28 ;
SDECNOS(SDECAPTID,SDECNS,USERIEN,SDECDATE) ;
+1 ;
+2 NEW SDFDA,SDECIENS
+3 SET SDECIENS=SDECAPTID_","
+4 ;NOSHOW
SET SDFDA(409.84,SDECIENS,.1)=SDECNS
+5 ;NOSHOW DATE
SET SDFDA(409.84,SDECIENS,.101)=$SELECT(+SDECNS:SDECDATE,1:"")
+6 ;NOSHOW USER
SET SDFDA(409.84,SDECIENS,.102)=$SELECT(+SDECNS:USERIEN,1:"")
+7 ; Update STATUS SD*5.3*717 wtc 10/25/18
SET SDFDA(409.84,SDECIENS,.17)=$SELECT(+SDECNS:"N",1:"")
+8 DO FILE^DIE("","SDFDA","SDECMSG")
+9 ;
+10 QUIT
+11 ;
NOSEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC NOSHOW APPOINTMENT event
+1 ;when appointments NOSHOW via PIMS interface.
+2 ;Propagates NOSHOW to SDECAPPT and raises refresh event to running GUI clients
+3 ;
+4 if +$GET(SDECNOEV)
QUIT
+5 if '+$GET(SDECSC)
QUIT
+6 ;Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"
+7 NEW SDECSTAT,SDECFOUND,SDECRES
+8 SET SDECSTAT=1
+9 ;S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" SDECSTAT=0
+10 SET SDECFOUND=0
+11 IF $DATA(^SDEC(409.831,"ALOC",SDECSC))
SET SDECRES=$ORDER(^SDEC(409.831,"ALOC",SDECSC,0))
SET SDECFOUND=$$NOSEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
+12 IF SDECFOUND
DO NOSEVT3(SDECRES)
QUIT
+13 QUIT
+14 ;
NOSEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT) ;
+1 ;Get appointment id in SDECAPT
+2 ;If found, call SDECNOS(SDECAPPT) and return 1
+3 ;else return 0
+4 NEW SDECFOUND,SDECAPPT
+5 SET SDECFOUND=0
+6 if '+$GET(SDECRES)
QUIT SDECFOUND
+7 if '$DATA(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART))
QUIT SDECFOUND
+8 SET SDECAPPT=0
FOR
SET SDECAPPT=$ORDER(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT))
if '+SDECAPPT
QUIT
Begin DoDot:1
+9 SET SDECNOD=$GET(^SDEC(409.84,SDECAPPT,0))
if SDECNOD=""
QUIT
+10 IF $PIECE(SDECNOD,U,5)=SDECPAT
IF $PIECE(SDECNOD,U,12)=""
SET SDECFOUND=1
QUIT
End DoDot:1
if SDECFOUND
QUIT
+11 IF SDECFOUND
IF +$GET(SDECAPPT)
DO SDECNOS(SDECAPPT,SDECSTAT)
+12 QUIT SDECFOUND
+13 ;
NOSEVT3(SDECRES) ;
+1 ;Call RaiseEvent to notify GUI clients
+2 ;
+3 QUIT
+4 NEW SDECRESN
+5 SET SDECRESN=$GET(^SDEC(409.831,SDECRES,0))
+6 if SDECRESN=""
QUIT
+7 SET SDECRESN=$PIECE(SDECRESN,"^")
+8 ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
+9 QUIT
+10 ;
+11 ;
ERR(SDECERID,ERRTXT) ;Error processing
+1 if '+$GET(SDECI)
SET SDECI=999999
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC",$JOB,SDECI)=SDECERID_"^"_ERRTXT_$CHAR(30)
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+6 QUIT
+7 ;
ETRAP ;EP Error trap entry
+1 DO ^%ZTER
+2 IF '$DATA(SDECI)
NEW SDECI
SET SDECI=999999
+3 SET SDECI=SDECI+1
+4 DO ERR(0,"SDEC31 Error")
+5 QUIT
+6 ;
IMHERE(SDECRES) ;I'm Here
+1 ;IMHERE(SDECRES) external parameter tag is in SDEC
+2 ;Entry point for SDEC IM HERE remote procedure
+3 ; Returns a simple value to client. Used to establish continued existence
+4 ; of the client to the server; resets the server READ timeout.
+5 SET SDECRES=1
+6 QUIT
+7 ;
