SDES25 ;ALB/MGD/LEG - VISTA SCHEDULING RPCS ;June 7, 2021@13:07
;;5.3;Scheduling;**790**;Aug 13, 1993;Build 11
;
; Documented API's and Integration Agreements
; -------------------------------------------
; Reference to ^AUPNVSIT( In ICR #2309
; Reference to ^DPT( In ICR #7030
;
Q
; Check in appointment
CHECKIN(JSON,SDECAPTID,SDECCDT,SDECCC,SDECPRV) ;
; RPC: SDES APPT CHECKIN JSON. Entry parameter tag is in SDES.
; This routine is based off of the existing SDES25 routine. It has been
; optimized and updated to return info in JSON format.
;
; INPUT: SDECAPTID - (required) Appointment ID
; SDECCDT - (required) Check-in date/time
; "@" - indicates delete check-in
; SDECCC - (optional) Clinic Stop pointer to CLINIC STOP file
; SDECPRV - (optional) Provider pointer to NEW PERSON file
; default to current user
;
; OUTPUT: JSON formatted data for success ("0"), error info for failure (error message)
;
N BSDVSTN
N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECZ,SDECIENS,SDECVEN,JSONMSG
N SDECNOEV,SDECCAN,SDECR1,SDESERROR,%DT,X,Y,ERR
S SDECNOEV=1 ;Don't execute protocol
S SDECCAN=0
S SDESERROR=0 ; Initialize error flag = 0:No Error
;
;validate SDEC appointment ID
S SDECAPTID=$G(SDECAPTID)
I SDECAPTID="" S SDESERROR=1 D ERRLOG^SDESJSON(.JSONMSG,14)
I SDECAPTID'="",'$D(^SDEC(409.84,SDECAPTID,0)) S SDESERROR=1 D ERRLOG^SDESJSON(.JSONMSG,15)
S SDECAPTID=+SDECAPTID
;validate checkin date/time (required)
S SDECCDT=$G(SDECCDT)
S:SDECCDT="@" SDECCAN=1
;
; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
;
; ### IS THE PREVIOUS DAY @24 GOING TO BE A PROBLEM ?
I SDECCDT="" S SDESERROR=1 D ERRLOG^SDESJSON(.JSONMSG,21)
I 'SDECCAN,SDECCDT'="" S SDECCDT=$$NETTOFM^SDECDATE(SDECCDT,"Y") I SDECCDT=-1 S SDESERROR=1,SDECCDT="" D ERRLOG^SDESJSON(.JSONMSG,22)
;validate clinic stop code
S SDECCC=$G(SDECCC)
; ### DOES THE VA GET "CREDIT" BASED ON THE ABILITY TO TRACK CHECKING VIA CLINIC STOP CODE?
; ### IF SO, SHOULD THIS BE UPDATED TO PREVENT CHECKINS UNTIL A VALID STOP CODE IS PROVIDED?
I SDECCC'="" I '$D(^DIC(40.7,SDECCC,0)) S SDECCC=""
;validate provider (optional)
S SDECPRV=$G(SDECPRV)
I SDECPRV'="" I '$D(^VA(200,+SDECPRV,0)) S SDECPRV=""
;
S SDECNOD=$G(^SDEC(409.84,SDECAPTID,0))
S (SDECPATID,DFN)=$P(SDECNOD,U,5)
S SDECSTART=$P(SDECNOD,U)
;
S SDECR1=$P(SDECNOD,U,7) ;RESOURCEID
I 'SDESERROR D
. I SDECR1<1 S SDESERROR=1 D ERRLOG^SDESJSON(.JSONMSG,18)
. I SDECR1]"",'$D(^SDEC(409.831,SDECR1,0)) S SDESERROR=1 D ERRLOG^SDESJSON(.JSONMSG,19)
. I SDECR1]"",$D(^SDEC(409.831,SDECR1,0)) D
. . S SDECNOD=^SDEC(409.831,SDECR1,0)
. . S SDECSC1=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
. . ;Hospital Location is required for CHECKIN
. . I 'SDECSC1]"",'$D(^SC(+SDECSC1,0)) D Q
. . . N SDESERRMSG2
. . . S SDESERRMSG2=$P(SDECNOD,U,1)_" ("_SDECSC1_")"
. . . D ERRLOG^SDESJSON(.JSONMSG,18,SDESERRMSG2)
. . . S SDESERROR=1
;if resource Id is not null AND there is a valid resource record
; ### Trace what sets SDECZ
I 'SDESERROR D I +$G(SDECZ) S SDESERROR=1 D ERRLOG^SDESJSON(.JSONMSG,0,$P(SDECZ,U,2))
. ;
. ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/24/18
. ;
. N SDATA,SDDA,SDCIHDL ;
. S SDDA=$$FIND(DFN,SDECSTART,SDECSC1),SDATA=SDDA_U_DFN_U_SDECSTART_U_SDECSC1,SDCIHDL=$$HANDLE^SDAMEVT(1) ;
. D BEFORE^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL) ;
. ;
. I 'SDECCAN D ;
. . ;
. . ; Checkin SDEC APPOINTMENT entry - wtc SD*5.3*717 10/24/18
. . ;
. . D SDECCHK(SDECAPTID,SDECCDT) ; sets field .03 (Checkin), in file 409.84
. . D APCHK(.SDECZ,SDECPATID,SDECSC1,SDECCC,SDECPRV,SDECSTART,SDECCDT,DUZ)
. . I $G(SDECPRV) S DIE="^SDEC(409.84,",DA=SDECAPTID,DR=".16///"_SDECPRV D ^DIE ; PROVIDER
. ;
. I SDECCAN D ;
. . ;
. . ; Cancel check in - wtc SD*5.3*717 10/24/18
. . ;
. . D SDECCHK(SDECAPTID,"") ; sets field .03 (Checkin), in file 409.84
. . D CANCHKIN(SDECPATID,SDECSC1,SDECSTART) ;
. ;
. ; Event driver "AFTER" actions - wtc SD*5.3*717 10/24/18
. ;
. D AFTER^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL) ;
. ;
. ; Execute event driver. 4=check in (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
. ;
. ;*zeb+1 717 3/19/19 prevent extra cancel check-in when canceling a checked-in walkin
. I '((SDECCDT="@")&($G(SDECTYP)]"")) D EVT^SDAMEVT(.SDATA,4,2,SDCIHDL) ;assumes SDECTYP, which is defined if coming from APPDEL^SDEC08
;
; If Checkin was successful, update JSONMSG array and call JSON encoder.
; ### Need to validate whether to send by a 0 or a "" for succesful checkins
I 'SDESERROR S JSONMSG("RESULT",1)=0
D ENCODE^SDESJSON(.JSONMSG,.JSON,.ERR)
Q
;
; Update Checkin related fields
SDECCHK(SDECAPTID,SDECCDT) ;
N SDECFDA,SDECMSG
S SDECIENS=SDECAPTID_","
S SDECFDA(409.84,SDECIENS,.03)=SDECCDT ; CHECKIN
S SDECFDA(409.84,SDECIENS,.04)=$S(SDECCDT'="":$$NOW^XLFDT,1:"") ; CHECK IN TIME ENTERED
D FILE^DIE("","SDECFDA","SDECMSG")
Q
;
APCHK(SDECZ,SDECPATID,SDECSC1,SDECCC,SDECPRV,SDECSTART,SDECCDT,DUZ) ;
;Checkin appointment for patient SDECDFN in clinic SDECSC1
;at time SDECSD
N BSDMSG,SDECC
S SDECC("PAT")=SDECPATID
S SDECC("HOS LOC")=SDECSC1
S SDECC("CLINIC CODE")=SDECCC
S SDECC("PROVIDER")=SDECPRV
S SDECC("APPT DATE")=SDECSTART
S SDECC("CDT")=SDECCDT
S SDECC("USR")=DUZ
;
;Required by NEW API:
S SDECC("SRV CAT")="A"
S SDECC("TIME RANGE")=-1
S SDECC("VISIT DATE")=SDECCDT
S SDECC("SITE")=$G(DUZ(2))
S SDECC("VISIT TYPE")="V"
S SDECC("CLN")=SDECC("HOS LOC")
S SDECC("ADT")=SDECC("APPT DATE")
;
N SDECOUT
D GETVISIT^SDECAPI4(.SDECC,.SDECOUT)
Q
;
CANCHKIN(DFN,SDCL,SDT) ; Logic to cancel a checkin if the checkin date/time is passed in as '@'
; input: DFN := ifn of patient
; SDCL := clinic#
; SDT := appt d/t
;
N SDDA
S SDDA=$$FIND(DFN,SDT,SDCL)
S FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)=""
D FILE^DIE(,"FDA","ERR")
K FDA,ERR
Q
;
FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
; input: DFN := ifn of pat.
; SDT := appt d/t
; SDCL := ifn of clinic
; output: [returned] := ifn if pat has appt on date/time
;
N Y
S Y=0 F S Y=$O(^SC(SDCL,"S",SDT,1,Y)) Q:'Y I $D(^(Y,0)),DFN=+^(0),$D(^DPT(+DFN,"S",SDT,0)),$$VALID(DFN,SDCL,SDT,Y) Q
Q Y
;
VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
; check to see they exist prior to calling this entry point.
; input: DFN := ifn of pat.
; SDT := appt d/t
; SDCL := ifn of clinic
; SDDA := ifn of appt
; output: [returned] := 1 for valid appt., 0 for not valid
Q $S($P(^SC(SDCL,"S",SDT,1,SDDA,0),U,9)'="C":1,$P(^DPT(DFN,"S",SDT,0),U,2)["C":1,1:0)
;
CHKEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event
;when appointments CHECKIN via PIMS interface.
;Propagates CHECKIN to SDECAPPT and raises refresh event to running GUI clients
;
Q:+$G(SDECNOEV)
Q:'+$G(SDECSC)
N SDECSTAT,SDECFOUND,SDECRES
S SDECSTAT=""
S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" SDECSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
S SDECFOUND=0
I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
I SDECFOUND D CHKEVT3(SDECRES) Q
Q
;
CHKEVT1(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 ;
. D SDECCHK(SDECAPPT,SDECSTAT)
Q SDECFOUND
;
CHKEVT3(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^SDEC23("SCHEDULE-"_SDECRESN,"","","")
;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
Q
;
CHKEVTD(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event
;when an appointment CHECKIN is deleted via.
;Deletes CHECKIN to and raises refresh event to running GUI clients
;
;
Q:+$G(SDECNOEV)
Q:'+$G(SDECSC)
N SDECSTAT,SDECFOUND,SDECRES
S SDECSTAT=""
S:$G(SDATA("AFTER","STATUS"))'="CHECKED IN" SDECSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
I SDECSTAT="" S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0))
I SDECRES D CHKEVT3(SDECRES) Q
S SDECFOUND=0
;
;I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
;I SDECFOUND D CHKEVT3(SDECRES) Q
Q
;
;CHECK OUT APPOINTMENT - RPC
CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) ;Check Out appointment
;CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) external parameter tag is in SDEC
; Returns SDECY
; Input -- DFN Patient file IEN
; SDT Appointment Date/Time in FM format
; SDCODT Date/Time of Check Out FM FORMAT [REQUIRED]
; SDECAPTID - Appointment ID
; VPRV - V Provider
;SETUP ERROR TRACKING
N APIERR,CNT,ERR,%DT,X,Y
N SDCL,SDASK,SDCOACT,SDCOALBF,SDDA,SDLNE,SDQUIET
N SDECI,SDECNOD,RPCPERM
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S ^TMP("SDEC",$J,0)="T00020ERRORID"_$C(30)
S RPCPERM=""
S RPCPERM=$$KCHK^XUSRB("SD SUPERVISOR",DUZ) I RPCPERM=0 D ERR("THE SD SUPERVISOR KEY IS REQUIRED TO PERFORM THIS ACTION.") Q
I '+SDECAPTID D ERR("Invalid Appointment ID.") Q
I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR("Invalid Appointment ID.") Q
;INITIALIZE VARIABLES
;
; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
;
;S %DT="T"
;S X=SDT
;D ^%DT ; GET FM FORMAT FOR APPOINTMENT DATE/TIME
;S SDT=Y
S SDT=$$NETTOFM^SDECDATE(SDT,"Y") ;
;S X=SDCODT
;D ^%DT ; GET FM FORMAT FOR CHECKOUT DATE/TIME
S SDCODT=$$NETTOFM^SDECDATE(SDCODT,"Y") ;
;ChecOut time cannot be in the future
;S SDCODT=Y
I SDCODT>$$HTFM^XLFDT($H) D ERR("Check Out time cannot be in the future.") Q
;
;appointment record
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
;make sure CHECKOUT time is after CHECKIN time
I SDCODT'>$P(SDECNOD,U,3) D ERR("Check Out time must be at least 1 minute after the Check In time of "_$TR($$FMTE^XLFDT($P(SDECNOD,U,3)),"@"," ")_".") Q ;alb/sat 665
;Hospital Location of RESOURCE
S SDECRES=$P(SDECNOD,U,7) ;RESOURCEID
S SDECNOD=^SDEC(409.831,SDECRES,0)
S SDCL=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
;
S SDDA=0
S SDASK=0
S SDCOALBF=""
S SDCOACT="CO"
S SDLNE=""
S SDQUIET=1
K APIERR
S APIERR=0
;
; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
;
N SDATA,SDDA,SDCIHDL ;
S SDDA=$$FIND(DFN,SDT,SDCL),SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1) ;
;
; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
;
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
;
D CO^SDEC25A(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,.SDCOALBF,SDECAPTID,SDQUIET,VPRV,.APIERR) ;Appt Check Out
;
; Skip event driver actions if error occurred checking appointment out. - wtc SD*5.3*717 10/25/2018
;
I 'APIERR D ;
. ;
. ; Event driver "AFTER" actions - wtc SD*5.3*717 10/25/18
. ;
. D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
. ;
. ; Execute event driver. 5=check out (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
. ;
. D EVT^SDAMEVT(.SDATA,5,2,SDCIHDL) ;
;
;ERROR(S) FOUND
I APIERR>0 D
. S CNT=""
. F S CNT=$O(APIERR(CNT)) Q:CNT="" S ERR=APIERR(CNT) S SDECI=SDECI+1 D ERR(ERR)
;NO ERROR
I APIERR<1 D
. S SDECI=SDECI+1
. S ^TMP("SDEC",$J,SDECI)="0"_$C(30)
. S SDECI=SDECI+1
. S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
;CHECK OUT APPOINTMENT - RPC
CANCKOUT(SDECY,SDECAPTID) ;Cancel Check Out appointment
;CANCKOUT(SDECY,SDECAPTID) external parameter tag is in SDEC
; Returns SDECY
; Input -- SDECAPTID - Appointment ID
N APS,DA,DFN,DIE,DR,RES
N SDCL,SDN,SDOE,SDT,SDV
N SDECI,SDECNOD,RPCPERM
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S ^TMP("SDEC",$J,0)="T00020ERRORID"_$C(30)
S RPCPERM=""
S RPCPERM=$$KCHK^XUSRB("SD SUPERVISOR",DUZ) I RPCPERM=0 D ERR("THE SD SUPERVISOR KEY IS REQUIRED TO PERFORM THIS ACTION.") Q
I '+SDECAPTID D ERR("Invalid Appointment ID.") Q
I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR("Invalid Appointment ID.") Q
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
S APS=$P(SDECNOD,U,19)
S DFN=$P(SDECNOD,U,5)
S SDT=$P(SDECNOD,U)
S RES=$P(SDECNOD,U,7)
S SDCL=$P(^SDEC(409.831,RES,0),U,4)
I $P(SDECNOD,U,14)="" D ERR("Appointment is not Checked Out.") Q
;
; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
;
N SDATA,SDDA,SDCIHDL ;
S SDDA=$$FIND(DFN,SDT,SDCL),SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1) ;
;
; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
;
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
;
; ^SDECAPPT: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
S DIE="^SDEC(409.84,"
S DA=SDECAPTID
S DR=".14////@;.08///"_DUZ
D ^DIE
; ^SC file 44: clear piece C;3: CHECKED OUT; clear piece C;4: CHECK OUT USER; clear C;6: CHECK OUT ENTERED
S DIE="^SC("_SDCL_",""S"","_SDT_",1,"
S DA(2)=SDCL,DA(1)=SDT,(DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT)
S DR="303///@;304///@;306///@"
D ^DIE
; ^AUPNVSIT file 9000010: clear piece 18: CHECK OUT DATE&TIME
S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
S SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
I +SDV D
. S DIE="^AUPNVSIT(",DA=SDV
. S DR=".18///@"
. D ^DIE
; ^SCE file 409.68: Set piece 12 back to CHECKED IN, pointer to APPOINTMENT STATUS file 409.63; clear piece 7: CHECK OUT PROCESS COMPLETION
I +APS D
. S DIE=409.68,DA=SDOE,DR=".07///@;.12///"_APS_";101///"_DUZ_";102///"_$$NOW^XLFDT
. D ^DIE
;
; Event driver "AFTER" actions - wtc SD*5.3*717 10/25/18
;
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
;
; Execute event driver. 5=check out (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
;
D EVT^SDAMEVT(.SDATA,5,2,SDCIHDL) ;
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="0"_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
CANAPPT(SDECAPTID) ;external call to cancel check out in SDEC APPOINTMENT called by SDCODEL for VistA Delete Check Out
N APS,DA,DIE,DR,DFN,RES,SDCL,SDT
N SDECNOD
I '+$G(SDECAPTID) Q
I '$D(^SDEC(409.84,+SDECAPTID,0)) Q
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
S APS=$P(SDECNOD,U,19)
S DFN=$P(SDECNOD,U,5)
S SDT=$P(SDECNOD,U)
S RES=$P(SDECNOD,U,7)
S SDCL=$P(^SDEC(409.831,RES,0),U,4)
I $P(SDECNOD,U,14)="" Q
; ^SDEC(409.84: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
S DIE="^SDEC(409.84,"
S DA=SDECAPTID
S DR=".14////@;.08///"_DUZ
D ^DIE
Q
;
ERROR ;
D ERR("VISTA Error")
Q
;
ERR(JSONMSG) ;Error processing
S JSONMSG("Error",1)=JSONMSG
D ENCODE^XLFJSON("JSONMSG","JSON","ERR")
S SDESERROR=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES25 15437 printed Oct 16, 2024@18:53:47 Page 2
SDES25 ;ALB/MGD/LEG - VISTA SCHEDULING RPCS ;June 7, 2021@13:07
+1 ;;5.3;Scheduling;**790**;Aug 13, 1993;Build 11
+2 ;
+3 ; Documented API's and Integration Agreements
+4 ; -------------------------------------------
+5 ; Reference to ^AUPNVSIT( In ICR #2309
+6 ; Reference to ^DPT( In ICR #7030
+7 ;
+8 QUIT
+9 ; Check in appointment
CHECKIN(JSON,SDECAPTID,SDECCDT,SDECCC,SDECPRV) ;
+1 ; RPC: SDES APPT CHECKIN JSON. Entry parameter tag is in SDES.
+2 ; This routine is based off of the existing SDES25 routine. It has been
+3 ; optimized and updated to return info in JSON format.
+4 ;
+5 ; INPUT: SDECAPTID - (required) Appointment ID
+6 ; SDECCDT - (required) Check-in date/time
+7 ; "@" - indicates delete check-in
+8 ; SDECCC - (optional) Clinic Stop pointer to CLINIC STOP file
+9 ; SDECPRV - (optional) Provider pointer to NEW PERSON file
+10 ; default to current user
+11 ;
+12 ; OUTPUT: JSON formatted data for success ("0"), error info for failure (error message)
+13 ;
+14 NEW BSDVSTN
+15 NEW SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECZ,SDECIENS,SDECVEN,JSONMSG
+16 NEW SDECNOEV,SDECCAN,SDECR1,SDESERROR,%DT,X,Y,ERR
+17 ;Don't execute protocol
SET SDECNOEV=1
+18 SET SDECCAN=0
+19 ; Initialize error flag = 0:No Error
SET SDESERROR=0
+20 ;
+21 ;validate SDEC appointment ID
+22 SET SDECAPTID=$GET(SDECAPTID)
+23 IF SDECAPTID=""
SET SDESERROR=1
DO ERRLOG^SDESJSON(.JSONMSG,14)
+24 IF SDECAPTID'=""
IF '$DATA(^SDEC(409.84,SDECAPTID,0))
SET SDESERROR=1
DO ERRLOG^SDESJSON(.JSONMSG,15)
+25 SET SDECAPTID=+SDECAPTID
+26 ;validate checkin date/time (required)
+27 SET SDECCDT=$GET(SDECCDT)
+28 if SDECCDT="@"
SET SDECCAN=1
+29 ;
+30 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+31 ;
+32 ; ### IS THE PREVIOUS DAY @24 GOING TO BE A PROBLEM ?
+33 IF SDECCDT=""
SET SDESERROR=1
DO ERRLOG^SDESJSON(.JSONMSG,21)
+34 IF 'SDECCAN
IF SDECCDT'=""
SET SDECCDT=$$NETTOFM^SDECDATE(SDECCDT,"Y")
IF SDECCDT=-1
SET SDESERROR=1
SET SDECCDT=""
DO ERRLOG^SDESJSON(.JSONMSG,22)
+35 ;validate clinic stop code
+36 SET SDECCC=$GET(SDECCC)
+37 ; ### DOES THE VA GET "CREDIT" BASED ON THE ABILITY TO TRACK CHECKING VIA CLINIC STOP CODE?
+38 ; ### IF SO, SHOULD THIS BE UPDATED TO PREVENT CHECKINS UNTIL A VALID STOP CODE IS PROVIDED?
+39 IF SDECCC'=""
IF '$DATA(^DIC(40.7,SDECCC,0))
SET SDECCC=""
+40 ;validate provider (optional)
+41 SET SDECPRV=$GET(SDECPRV)
+42 IF SDECPRV'=""
IF '$DATA(^VA(200,+SDECPRV,0))
SET SDECPRV=""
+43 ;
+44 SET SDECNOD=$GET(^SDEC(409.84,SDECAPTID,0))
+45 SET (SDECPATID,DFN)=$PIECE(SDECNOD,U,5)
+46 SET SDECSTART=$PIECE(SDECNOD,U)
+47 ;
+48 ;RESOURCEID
SET SDECR1=$PIECE(SDECNOD,U,7)
+49 IF 'SDESERROR
Begin DoDot:1
+50 IF SDECR1<1
SET SDESERROR=1
DO ERRLOG^SDESJSON(.JSONMSG,18)
+51 IF SDECR1]""
IF '$DATA(^SDEC(409.831,SDECR1,0))
SET SDESERROR=1
DO ERRLOG^SDESJSON(.JSONMSG,19)
+52 IF SDECR1]""
IF $DATA(^SDEC(409.831,SDECR1,0))
Begin DoDot:2
+53 SET SDECNOD=^SDEC(409.831,SDECR1,0)
+54 ;HOSPITAL LOCATION
SET SDECSC1=$PIECE(SDECNOD,U,4)
+55 ;Hospital Location is required for CHECKIN
+56 IF 'SDECSC1]""
IF '$DATA(^SC(+SDECSC1,0))
Begin DoDot:3
+57 NEW SDESERRMSG2
+58 SET SDESERRMSG2=$PIECE(SDECNOD,U,1)_" ("_SDECSC1_")"
+59 DO ERRLOG^SDESJSON(.JSONMSG,18,SDESERRMSG2)
+60 SET SDESERROR=1
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+61 ;if resource Id is not null AND there is a valid resource record
+62 ; ### Trace what sets SDECZ
+63 IF 'SDESERROR
Begin DoDot:1
+64 ;
+65 ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/24/18
+66 ;
+67 ;
NEW SDATA,SDDA,SDCIHDL
+68 ;
SET SDDA=$$FIND(DFN,SDECSTART,SDECSC1)
SET SDATA=SDDA_U_DFN_U_SDECSTART_U_SDECSC1
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+69 ;
DO BEFORE^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
+70 ;
+71 ;
IF 'SDECCAN
Begin DoDot:2
+72 ;
+73 ; Checkin SDEC APPOINTMENT entry - wtc SD*5.3*717 10/24/18
+74 ;
+75 ; sets field .03 (Checkin), in file 409.84
DO SDECCHK(SDECAPTID,SDECCDT)
+76 DO APCHK(.SDECZ,SDECPATID,SDECSC1,SDECCC,SDECPRV,SDECSTART,SDECCDT,DUZ)
+77 ; PROVIDER
IF $GET(SDECPRV)
SET DIE="^SDEC(409.84,"
SET DA=SDECAPTID
SET DR=".16///"_SDECPRV
DO ^DIE
End DoDot:2
+78 ;
+79 ;
IF SDECCAN
Begin DoDot:2
+80 ;
+81 ; Cancel check in - wtc SD*5.3*717 10/24/18
+82 ;
+83 ; sets field .03 (Checkin), in file 409.84
DO SDECCHK(SDECAPTID,"")
+84 ;
DO CANCHKIN(SDECPATID,SDECSC1,SDECSTART)
End DoDot:2
+85 ;
+86 ; Event driver "AFTER" actions - wtc SD*5.3*717 10/24/18
+87 ;
+88 ;
DO AFTER^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
+89 ;
+90 ; Execute event driver. 4=check in (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
+91 ;
+92 ;*zeb+1 717 3/19/19 prevent extra cancel check-in when canceling a checked-in walkin
+93 ;assumes SDECTYP, which is defined if coming from APPDEL^SDEC08
IF '((SDECCDT="@")&($GET(SDECTYP)]""))
DO EVT^SDAMEVT(.SDATA,4,2,SDCIHDL)
End DoDot:1
IF +$GET(SDECZ)
SET SDESERROR=1
DO ERRLOG^SDESJSON(.JSONMSG,0,$PIECE(SDECZ,U,2))
+94 ;
+95 ; If Checkin was successful, update JSONMSG array and call JSON encoder.
+96 ; ### Need to validate whether to send by a 0 or a "" for succesful checkins
+97 IF 'SDESERROR
SET JSONMSG("RESULT",1)=0
+98 DO ENCODE^SDESJSON(.JSONMSG,.JSON,.ERR)
+99 QUIT
+100 ;
+101 ; Update Checkin related fields
SDECCHK(SDECAPTID,SDECCDT) ;
+1 NEW SDECFDA,SDECMSG
+2 SET SDECIENS=SDECAPTID_","
+3 ; CHECKIN
SET SDECFDA(409.84,SDECIENS,.03)=SDECCDT
+4 ; CHECK IN TIME ENTERED
SET SDECFDA(409.84,SDECIENS,.04)=$SELECT(SDECCDT'="":$$NOW^XLFDT,1:"")
+5 DO FILE^DIE("","SDECFDA","SDECMSG")
+6 QUIT
+7 ;
APCHK(SDECZ,SDECPATID,SDECSC1,SDECCC,SDECPRV,SDECSTART,SDECCDT,DUZ) ;
+1 ;Checkin appointment for patient SDECDFN in clinic SDECSC1
+2 ;at time SDECSD
+3 NEW BSDMSG,SDECC
+4 SET SDECC("PAT")=SDECPATID
+5 SET SDECC("HOS LOC")=SDECSC1
+6 SET SDECC("CLINIC CODE")=SDECCC
+7 SET SDECC("PROVIDER")=SDECPRV
+8 SET SDECC("APPT DATE")=SDECSTART
+9 SET SDECC("CDT")=SDECCDT
+10 SET SDECC("USR")=DUZ
+11 ;
+12 ;Required by NEW API:
+13 SET SDECC("SRV CAT")="A"
+14 SET SDECC("TIME RANGE")=-1
+15 SET SDECC("VISIT DATE")=SDECCDT
+16 SET SDECC("SITE")=$GET(DUZ(2))
+17 SET SDECC("VISIT TYPE")="V"
+18 SET SDECC("CLN")=SDECC("HOS LOC")
+19 SET SDECC("ADT")=SDECC("APPT DATE")
+20 ;
+21 NEW SDECOUT
+22 DO GETVISIT^SDECAPI4(.SDECC,.SDECOUT)
+23 QUIT
+24 ;
CANCHKIN(DFN,SDCL,SDT) ; Logic to cancel a checkin if the checkin date/time is passed in as '@'
+1 ; input: DFN := ifn of patient
+2 ; SDCL := clinic#
+3 ; SDT := appt d/t
+4 ;
+5 NEW SDDA
+6 SET SDDA=$$FIND(DFN,SDT,SDCL)
+7 SET FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)=""
+8 DO FILE^DIE(,"FDA","ERR")
+9 KILL FDA,ERR
+10 QUIT
+11 ;
FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
+1 ; input: DFN := ifn of pat.
+2 ; SDT := appt d/t
+3 ; SDCL := ifn of clinic
+4 ; output: [returned] := ifn if pat has appt on date/time
+5 ;
+6 NEW Y
+7 SET Y=0
FOR
SET Y=$ORDER(^SC(SDCL,"S",SDT,1,Y))
if 'Y
QUIT
IF $DATA(^(Y,0))
IF DFN=+^(0)
IF $DATA(^DPT(+DFN,"S",SDT,0))
IF $$VALID(DFN,SDCL,SDT,Y)
QUIT
+8 QUIT Y
+9 ;
VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
+1 ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
+2 ; check to see they exist prior to calling this entry point.
+3 ; input: DFN := ifn of pat.
+4 ; SDT := appt d/t
+5 ; SDCL := ifn of clinic
+6 ; SDDA := ifn of appt
+7 ; output: [returned] := 1 for valid appt., 0 for not valid
+8 QUIT $SELECT($PIECE(^SC(SDCL,"S",SDT,1,SDDA,0),U,9)'="C":1,$PIECE(^DPT(DFN,"S",SDT,0),U,2)["C":1,1:0)
+9 ;
CHKEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event
+1 ;when appointments CHECKIN via PIMS interface.
+2 ;Propagates CHECKIN to SDECAPPT and raises refresh event to running GUI clients
+3 ;
+4 if +$GET(SDECNOEV)
QUIT
+5 if '+$GET(SDECSC)
QUIT
+6 NEW SDECSTAT,SDECFOUND,SDECRES
+7 SET SDECSTAT=""
+8 if $GET(SDATA("AFTER","STATUS"))["CHECKED IN"
SET SDECSTAT=$PIECE(SDATA("AFTER","STATUS"),"^",4)
+9 SET SDECFOUND=0
+10 IF $DATA(^SDEC(409.831,"ALOC",SDECSC))
SET SDECRES=$ORDER(^SDEC(409.831,"ALOC",SDECSC,0))
SET SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
+11 IF SDECFOUND
DO CHKEVT3(SDECRES)
QUIT
+12 QUIT
+13 ;
CHKEVT1(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)
Begin DoDot:1
+12 DO SDECCHK(SDECAPPT,SDECSTAT)
End DoDot:1
+13 QUIT SDECFOUND
+14 ;
CHKEVT3(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^SDEC23("SCHEDULE-"_SDECRESN,"","","")
+9 ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
+10 QUIT
+11 ;
CHKEVTD(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event
+1 ;when an appointment CHECKIN is deleted via.
+2 ;Deletes CHECKIN to and raises refresh event to running GUI clients
+3 ;
+4 ;
+5 if +$GET(SDECNOEV)
QUIT
+6 if '+$GET(SDECSC)
QUIT
+7 NEW SDECSTAT,SDECFOUND,SDECRES
+8 SET SDECSTAT=""
+9 if $GET(SDATA("AFTER","STATUS"))'="CHECKED IN"
SET SDECSTAT=$PIECE(SDATA("AFTER","STATUS"),"^",4)
+10 IF SDECSTAT=""
SET SDECRES=$ORDER(^SDEC(409.831,"ALOC",SDECSC,0))
+11 IF SDECRES
DO CHKEVT3(SDECRES)
QUIT
+12 SET SDECFOUND=0
+13 ;
+14 ;I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
+15 ;I SDECFOUND D CHKEVT3(SDECRES) Q
+16 QUIT
+17 ;
+18 ;CHECK OUT APPOINTMENT - RPC
CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) ;Check Out appointment
+1 ;CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) external parameter tag is in SDEC
+2 ; Returns SDECY
+3 ; Input -- DFN Patient file IEN
+4 ; SDT Appointment Date/Time in FM format
+5 ; SDCODT Date/Time of Check Out FM FORMAT [REQUIRED]
+6 ; SDECAPTID - Appointment ID
+7 ; VPRV - V Provider
+8 ;SETUP ERROR TRACKING
+9 NEW APIERR,CNT,ERR,%DT,X,Y
+10 NEW SDCL,SDASK,SDCOACT,SDCOALBF,SDDA,SDLNE,SDQUIET
+11 NEW SDECI,SDECNOD,RPCPERM
+12 SET SDECI=0
+13 KILL ^TMP("SDEC",$JOB)
+14 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+15 SET ^TMP("SDEC",$JOB,0)="T00020ERRORID"_$CHAR(30)
+16 SET RPCPERM=""
+17 SET RPCPERM=$$KCHK^XUSRB("SD SUPERVISOR",DUZ)
IF RPCPERM=0
DO ERR("THE SD SUPERVISOR KEY IS REQUIRED TO PERFORM THIS ACTION.")
QUIT
+18 IF '+SDECAPTID
DO ERR("Invalid Appointment ID.")
QUIT
+19 IF '$DATA(^SDEC(409.84,SDECAPTID,0))
DO ERR("Invalid Appointment ID.")
QUIT
+20 ;INITIALIZE VARIABLES
+21 ;
+22 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+23 ;
+24 ;S %DT="T"
+25 ;S X=SDT
+26 ;D ^%DT ; GET FM FORMAT FOR APPOINTMENT DATE/TIME
+27 ;S SDT=Y
+28 ;
SET SDT=$$NETTOFM^SDECDATE(SDT,"Y")
+29 ;S X=SDCODT
+30 ;D ^%DT ; GET FM FORMAT FOR CHECKOUT DATE/TIME
+31 ;
SET SDCODT=$$NETTOFM^SDECDATE(SDCODT,"Y")
+32 ;ChecOut time cannot be in the future
+33 ;S SDCODT=Y
+34 IF SDCODT>$$HTFM^XLFDT($HOROLOG)
DO ERR("Check Out time cannot be in the future.")
QUIT
+35 ;
+36 ;appointment record
+37 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+38 ;make sure CHECKOUT time is after CHECKIN time
+39 ;alb/sat 665
IF SDCODT'>$PIECE(SDECNOD,U,3)
DO ERR("Check Out time must be at least 1 minute after the Check In time of "_$TRANSLATE($$FMTE^XLFDT($PIECE(SDECNOD,U,3)),"@"," ")_".")
QUIT
+40 ;Hospital Location of RESOURCE
+41 ;RESOURCEID
SET SDECRES=$PIECE(SDECNOD,U,7)
+42 SET SDECNOD=^SDEC(409.831,SDECRES,0)
+43 ;HOSPITAL LOCATION
SET SDCL=$PIECE(SDECNOD,U,4)
+44 ;
+45 SET SDDA=0
+46 SET SDASK=0
+47 SET SDCOALBF=""
+48 SET SDCOACT="CO"
+49 SET SDLNE=""
+50 SET SDQUIET=1
+51 KILL APIERR
+52 SET APIERR=0
+53 ;
+54 ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
+55 ;
+56 ;
NEW SDATA,SDDA,SDCIHDL
+57 ;
SET SDDA=$$FIND(DFN,SDT,SDCL)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+58 ;
+59 ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
+60 ;
+61 ;
DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+62 ;
+63 ;Appt Check Out
DO CO^SDEC25A(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,.SDCOALBF,SDECAPTID,SDQUIET,VPRV,.APIERR)
+64 ;
+65 ; Skip event driver actions if error occurred checking appointment out. - wtc SD*5.3*717 10/25/2018
+66 ;
+67 ;
IF 'APIERR
Begin DoDot:1
+68 ;
+69 ; Event driver "AFTER" actions - wtc SD*5.3*717 10/25/18
+70 ;
+71 ;
DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+72 ;
+73 ; Execute event driver. 5=check out (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
+74 ;
+75 ;
DO EVT^SDAMEVT(.SDATA,5,2,SDCIHDL)
End DoDot:1
+76 ;
+77 ;ERROR(S) FOUND
+78 IF APIERR>0
Begin DoDot:1
+79 SET CNT=""
+80 FOR
SET CNT=$ORDER(APIERR(CNT))
if CNT=""
QUIT
SET ERR=APIERR(CNT)
SET SDECI=SDECI+1
DO ERR(ERR)
End DoDot:1
+81 ;NO ERROR
+82 IF APIERR<1
Begin DoDot:1
+83 SET SDECI=SDECI+1
+84 SET ^TMP("SDEC",$JOB,SDECI)="0"_$CHAR(30)
+85 SET SDECI=SDECI+1
+86 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
End DoDot:1
+87 QUIT
+88 ;
+89 ;CHECK OUT APPOINTMENT - RPC
CANCKOUT(SDECY,SDECAPTID) ;Cancel Check Out appointment
+1 ;CANCKOUT(SDECY,SDECAPTID) external parameter tag is in SDEC
+2 ; Returns SDECY
+3 ; Input -- SDECAPTID - Appointment ID
+4 NEW APS,DA,DFN,DIE,DR,RES
+5 NEW SDCL,SDN,SDOE,SDT,SDV
+6 NEW SDECI,SDECNOD,RPCPERM
+7 SET SDECI=0
+8 KILL ^TMP("SDEC",$JOB)
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+10 SET ^TMP("SDEC",$JOB,0)="T00020ERRORID"_$CHAR(30)
+11 SET RPCPERM=""
+12 SET RPCPERM=$$KCHK^XUSRB("SD SUPERVISOR",DUZ)
IF RPCPERM=0
DO ERR("THE SD SUPERVISOR KEY IS REQUIRED TO PERFORM THIS ACTION.")
QUIT
+13 IF '+SDECAPTID
DO ERR("Invalid Appointment ID.")
QUIT
+14 IF '$DATA(^SDEC(409.84,SDECAPTID,0))
DO ERR("Invalid Appointment ID.")
QUIT
+15 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+16 SET APS=$PIECE(SDECNOD,U,19)
+17 SET DFN=$PIECE(SDECNOD,U,5)
+18 SET SDT=$PIECE(SDECNOD,U)
+19 SET RES=$PIECE(SDECNOD,U,7)
+20 SET SDCL=$PIECE(^SDEC(409.831,RES,0),U,4)
+21 IF $PIECE(SDECNOD,U,14)=""
DO ERR("Appointment is not Checked Out.")
QUIT
+22 ;
+23 ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
+24 ;
+25 ;
NEW SDATA,SDDA,SDCIHDL
+26 ;
SET SDDA=$$FIND(DFN,SDT,SDCL)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+27 ;
+28 ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
+29 ;
+30 ;
DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+31 ;
+32 ; ^SDECAPPT: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
+33 SET DIE="^SDEC(409.84,"
+34 SET DA=SDECAPTID
+35 SET DR=".14////@;.08///"_DUZ
+36 DO ^DIE
+37 ; ^SC file 44: clear piece C;3: CHECKED OUT; clear piece C;4: CHECK OUT USER; clear C;6: CHECK OUT ENTERED
+38 SET DIE="^SC("_SDCL_",""S"","_SDT_",1,"
+39 SET DA(2)=SDCL
SET DA(1)=SDT
SET (DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT)
+40 SET DR="303///@;304///@;306///@"
+41 DO ^DIE
+42 ; ^AUPNVSIT file 9000010: clear piece 18: CHECK OUT DATE&TIME
+43 SET SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
+44 SET SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
+45 IF +SDV
Begin DoDot:1
+46 SET DIE="^AUPNVSIT("
SET DA=SDV
+47 SET DR=".18///@"
+48 DO ^DIE
End DoDot:1
+49 ; ^SCE file 409.68: Set piece 12 back to CHECKED IN, pointer to APPOINTMENT STATUS file 409.63; clear piece 7: CHECK OUT PROCESS COMPLETION
+50 IF +APS
Begin DoDot:1
+51 SET DIE=409.68
SET DA=SDOE
SET DR=".07///@;.12///"_APS_";101///"_DUZ_";102///"_$$NOW^XLFDT
+52 DO ^DIE
End DoDot:1
+53 ;
+54 ; Event driver "AFTER" actions - wtc SD*5.3*717 10/25/18
+55 ;
+56 ;
DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+57 ;
+58 ; Execute event driver. 5=check out (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
+59 ;
+60 ;
DO EVT^SDAMEVT(.SDATA,5,2,SDCIHDL)
+61 ;
+62 SET SDECI=SDECI+1
+63 SET ^TMP("SDEC",$JOB,SDECI)="0"_$CHAR(30)
+64 SET SDECI=SDECI+1
+65 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+66 QUIT
+67 ;
CANAPPT(SDECAPTID) ;external call to cancel check out in SDEC APPOINTMENT called by SDCODEL for VistA Delete Check Out
+1 NEW APS,DA,DIE,DR,DFN,RES,SDCL,SDT
+2 NEW SDECNOD
+3 IF '+$GET(SDECAPTID)
QUIT
+4 IF '$DATA(^SDEC(409.84,+SDECAPTID,0))
QUIT
+5 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+6 SET APS=$PIECE(SDECNOD,U,19)
+7 SET DFN=$PIECE(SDECNOD,U,5)
+8 SET SDT=$PIECE(SDECNOD,U)
+9 SET RES=$PIECE(SDECNOD,U,7)
+10 SET SDCL=$PIECE(^SDEC(409.831,RES,0),U,4)
+11 IF $PIECE(SDECNOD,U,14)=""
QUIT
+12 ; ^SDEC(409.84: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
+13 SET DIE="^SDEC(409.84,"
+14 SET DA=SDECAPTID
+15 SET DR=".14////@;.08///"_DUZ
+16 DO ^DIE
+17 QUIT
+18 ;
ERROR ;
+1 DO ERR("VISTA Error")
+2 QUIT
+3 ;
ERR(JSONMSG) ;Error processing
+1 SET JSONMSG("Error",1)=JSONMSG
+2 DO ENCODE^XLFJSON("JSONMSG","JSON","ERR")
+3 SET SDESERROR=1
+4 QUIT
