SDEC25 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,665,671,717,694,800**;Aug 13, 1993;Build 23
;
; ICR
; ---
; 2309 - #9000010 ^AUPNVSIT
; 7030 - #2 (APPT record)
;
Q
;
CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF) ;Check in appointment
;CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF)
; external parameter tag is in SDEC
;
; INPUT: SDECAPTID - (required) Appointment ID
; SDECCDT - (optional) 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
; SDECROU - (optional) Print Routing Slip flag, valid values:
; 0=false 1=true
; SDECVCL - (unused) Clinic pointer to HOSPITAL LOCATION
; SDECVFM - (unused) FORM
; SDECOG - (unused) OUTGUIDE FLAG
; SDECCR - (unused) Generate Chart request upon check-in? (1-Yes, otherwise no)
; SDECPCC - (unused) ien of PWH Type in HEALTH SUMMARY PWH TYPE file ^APCHPWHT
; SDECWHF - (unused) Print Patient Wellness Handout flag
;
ENDBG ;
N BSDVSTN,EMSG
N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECIENS,SDECVEN
N SDECNOEV,SDECCAN,SDECR1,%DT,X,Y
S SDECNOEV=1 ;Don't execute protocol
S SDECCAN=0
;
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S ^TMP("SDEC",$J,0)="T00020ERRORID^T00150MESSAGE"_$C(30)
;validate SDEC appointment ID
I '+$G(SDECAPTID) D ERR("SDEC25: Invalid Appointment ID") Q
I '$D(^SDEC(409.84,+SDECAPTID,0)) D ERR("SDEC25: Invalid Appointment ID") Q
;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
;
;I 'SDECCAN,SDECCDT'="" S %DT="T" S X=SDECCDT D ^%DT S SDECCDT=Y I Y=-1 S SDECCDT=""
I 'SDECCAN,SDECCDT'="" S SDECCDT=$$NETTOFM^SDECDATE(SDECCDT,"Y") I SDECCDT=-1 S SDECCDT="" ;
I SDECCDT="" D ERR("SDEC25: Invalid Check-In Time") Q
;validate clinic stop code
S SDECCC=$G(SDECCC)
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=""
;I SDECPRV="" S SDECPRV=DUZ
;I SDECPRV="" S SDECPRV=""
;validate routine slip flag (optional)
S SDECROU=$$UP^XLFSTR($G(SDECROU))
S SDECROU=$S(SDECROU=1:"true",SDECROU="TRUE":"true",1:0)
;validate clinic
S SDECVCL=$G(SDECVCL)
I SDECVCL'="" I '$D(^SC(SDECVCL,0)) S SDECVCL=""
I SDECCC="",SDECVCL'="" S SDECCC=$P($G(^SC(SDECVCL,0)),U,7) ;get clinic stop from 44
;
S SDECNOD=^SDEC(409.84,SDECAPTID,0)
S DFN=$P(SDECNOD,U,5)
S SDECPATID=$P(SDECNOD,U,5)
S SDECSTART=$P(SDECNOD,U)
;
S SDECR1=$P(SDECNOD,U,7) ;RESOURCEID
;if resourceId is not null AND there is a valid resource record
I SDECR1]"",$D(^SDEC(409.831,SDECR1,0)) D I +$G(SDECZ) D ERR($P(SDECZ,U,2)) Q
. 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 ERR("SDEC25: Clinic not defined for this Resource: "_$P(SDECNOD,U,1)_" ("_SDECSC1_")") Q
. I 'SDECSC1]"",'$D(^SC(+SDECSC1,0)) D ERR("Clinic not defined for this Resource: "_$P(SDECNOD,U,1)_" ("_SDECSC1_")") Q
. ;
. ; 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,SDECSC1,SDECPATID,SDECCDT,SDECSTART)
.. I $G(SDECPRV) S DIE="^SDEC(409.84,",DA=SDECAPTID,DR=".16///"_SDECPRV D ^DIE
. ;
. 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
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="0^"_$S($G(EMSG)'="":EMSG,1:"")_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
SDECCHK(SDECAPTID,SDECCDT) ;
N SDECFDA,SDECMSG
S SDECIENS=SDECAPTID_","
S SDECFDA(409.84,SDECIENS,.03)=SDECCDT
S SDECFDA(409.84,SDECIENS,.04)=$S(SDECCDT'="":$$NOW^XLFDT,1:"")
D FILE^DIE("","SDECFDA","SDECMSG")
Q
;
APCHK(SDECZ,SDECSC1,SDECDFN,SDECCDT,SDECSTART) ;
;Checkin appointment for patient SDECDFN in clinic SDECSC1
;at time SDECSD
N APTN,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
;find IEN in ^SC multiple or null
S APTN=$$FIND^SDAM2(SDECC("PAT"),SDECC("APPT DATE"),SDECC("HOS LOC"))
;
;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")
;
;Set up SDECVEN array containing VEN EHP CLINIC, VEN EHP FORM, OUTGUIDE FLAG
;These values come from input param
S SDECVEN("CLINIC")=SDECVCL
S SDECVEN("FORM")=$G(SDECVFM)
S SDECVEN("OUTGUIDE")=$G(SDECOG)
;
N SDECOUT
D GETVISIT^SDECAPI4(.SDECC,.SDECOUT)
;K SDECC
;I SDECOUT(0)=1 S BSDVSTN=$O(SDECOUT(0)) ;if match found, set visit IEN
;D VISIT^SDECV(SDECC("HOS LOC"),SDECC("APPT DATE"),APTN,SDECC("PAT"),SDECC("CLINIC CODE"),SDECC("PROVIDER"),,.BSDMSG,.BSDVSTN,.SDECC) ;replace GETVISIT^SDECAPI4 to make sure all visit data is updated
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)
;I 'SDDA D ERR("SDEC25: Could not locate appointment in database or appointment is cancelled.") Q
;I 'SDDA D ERR("Could not locate appointment in database or appointment is cancelled.") Q
;
; Disabled event driver calls as they are present above in CHECKIN. SD*5.3*717 wtc 10/25/2018
;
;N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1)
;D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
S FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)="" D FILE^DIE(,"FDA","ERR")
;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;D CHKEVTD(DFN,SDT,SDCL)
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(ERRNO) ;Error processing
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=ERRNO_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC25 16722 printed Dec 13, 2024@02:50:18 Page 2
SDEC25 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,665,671,717,694,800**;Aug 13, 1993;Build 23
+2 ;
+3 ; ICR
+4 ; ---
+5 ; 2309 - #9000010 ^AUPNVSIT
+6 ; 7030 - #2 (APPT record)
+7 ;
+8 QUIT
+9 ;
CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF) ;Check in appointment
+1 ;CHECKIN(SDECY,SDECAPTID,SDECCDT,SDECCC,SDECPRV,SDECROU,SDECVCL,SDECVFM,SDECOG,SDECCR,SDECPCC,SDECWHF)
+2 ; external parameter tag is in SDEC
+3 ;
+4 ; INPUT: SDECAPTID - (required) Appointment ID
+5 ; SDECCDT - (optional) Check-in date/time
+6 ; "@" - indicates delete check-in
+7 ; SDECCC - (optional) Clinic Stop pointer to CLINIC STOP file
+8 ; SDECPRV - (optional) Provider pointer to NEW PERSON file
+9 ; default to current user
+10 ; SDECROU - (optional) Print Routing Slip flag, valid values:
+11 ; 0=false 1=true
+12 ; SDECVCL - (unused) Clinic pointer to HOSPITAL LOCATION
+13 ; SDECVFM - (unused) FORM
+14 ; SDECOG - (unused) OUTGUIDE FLAG
+15 ; SDECCR - (unused) Generate Chart request upon check-in? (1-Yes, otherwise no)
+16 ; SDECPCC - (unused) ien of PWH Type in HEALTH SUMMARY PWH TYPE file ^APCHPWHT
+17 ; SDECWHF - (unused) Print Patient Wellness Handout flag
+18 ;
ENDBG ;
+1 NEW BSDVSTN,EMSG
+2 NEW SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECIENS,SDECVEN
+3 NEW SDECNOEV,SDECCAN,SDECR1,%DT,X,Y
+4 ;Don't execute protocol
SET SDECNOEV=1
+5 SET SDECCAN=0
+6 ;
+7 SET SDECI=0
+8 KILL ^TMP("SDEC",$JOB)
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+10 SET ^TMP("SDEC",$JOB,0)="T00020ERRORID^T00150MESSAGE"_$CHAR(30)
+11 ;validate SDEC appointment ID
+12 IF '+$GET(SDECAPTID)
DO ERR("SDEC25: Invalid Appointment ID")
QUIT
+13 IF '$DATA(^SDEC(409.84,+SDECAPTID,0))
DO ERR("SDEC25: Invalid Appointment ID")
QUIT
+14 ;validate checkin date/time (required)
+15 SET SDECCDT=$GET(SDECCDT)
+16 if SDECCDT="@"
SET SDECCAN=1
+17 ;
+18 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+19 ;
+20 ;I 'SDECCAN,SDECCDT'="" S %DT="T" S X=SDECCDT D ^%DT S SDECCDT=Y I Y=-1 S SDECCDT=""
+21 ;
IF 'SDECCAN
IF SDECCDT'=""
SET SDECCDT=$$NETTOFM^SDECDATE(SDECCDT,"Y")
IF SDECCDT=-1
SET SDECCDT=""
+22 IF SDECCDT=""
DO ERR("SDEC25: Invalid Check-In Time")
QUIT
+23 ;validate clinic stop code
+24 SET SDECCC=$GET(SDECCC)
+25 IF SDECCC'=""
IF '$DATA(^DIC(40.7,SDECCC,0))
SET SDECCC=""
+26 ;validate provider (optional)
+27 SET SDECPRV=$GET(SDECPRV)
+28 IF SDECPRV'=""
IF '$DATA(^VA(200,+SDECPRV,0))
SET SDECPRV=""
+29 ;I SDECPRV="" S SDECPRV=DUZ
+30 ;I SDECPRV="" S SDECPRV=""
+31 ;validate routine slip flag (optional)
+32 SET SDECROU=$$UP^XLFSTR($GET(SDECROU))
+33 SET SDECROU=$SELECT(SDECROU=1:"true",SDECROU="TRUE":"true",1:0)
+34 ;validate clinic
+35 SET SDECVCL=$GET(SDECVCL)
+36 IF SDECVCL'=""
IF '$DATA(^SC(SDECVCL,0))
SET SDECVCL=""
+37 ;get clinic stop from 44
IF SDECCC=""
IF SDECVCL'=""
SET SDECCC=$PIECE($GET(^SC(SDECVCL,0)),U,7)
+38 ;
+39 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+40 SET DFN=$PIECE(SDECNOD,U,5)
+41 SET SDECPATID=$PIECE(SDECNOD,U,5)
+42 SET SDECSTART=$PIECE(SDECNOD,U)
+43 ;
+44 ;RESOURCEID
SET SDECR1=$PIECE(SDECNOD,U,7)
+45 ;if resourceId is not null AND there is a valid resource record
+46 IF SDECR1]""
IF $DATA(^SDEC(409.831,SDECR1,0))
Begin DoDot:1
+47 SET SDECNOD=^SDEC(409.831,SDECR1,0)
+48 ;HOSPITAL LOCATION
SET SDECSC1=$PIECE(SDECNOD,U,4)
+49 ;Hospital Location is required for CHECKIN
+50 ;I 'SDECSC1]"",'$D(^SC(+SDECSC1,0)) D ERR("SDEC25: Clinic not defined for this Resource: "_$P(SDECNOD,U,1)_" ("_SDECSC1_")") Q
+51 IF 'SDECSC1]""
IF '$DATA(^SC(+SDECSC1,0))
DO ERR("Clinic not defined for this Resource: "_$PIECE(SDECNOD,U,1)_" ("_SDECSC1_")")
QUIT
+52 ;
+53 ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/24/18
+54 ;
+55 ;
NEW SDATA,SDDA,SDCIHDL
+56 ;
SET SDDA=$$FIND(DFN,SDECSTART,SDECSC1)
SET SDATA=SDDA_U_DFN_U_SDECSTART_U_SDECSC1
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+57 ;
DO BEFORE^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
+58 ;
+59 ;
IF 'SDECCAN
Begin DoDot:2
+60 ;
+61 ; Checkin SDEC APPOINTMENT entry - wtc SD*5.3*717 10/24/18
+62 ;
+63 ; sets field .03 (Checkin), in file 409.84
DO SDECCHK(SDECAPTID,SDECCDT)
+64 DO APCHK(.SDECZ,SDECSC1,SDECPATID,SDECCDT,SDECSTART)
+65 IF $GET(SDECPRV)
SET DIE="^SDEC(409.84,"
SET DA=SDECAPTID
SET DR=".16///"_SDECPRV
DO ^DIE
End DoDot:2
+66 ;
+67 ;
IF SDECCAN
Begin DoDot:2
+68 ;
+69 ; Cancel check in - wtc SD*5.3*717 10/24/18
+70 ;
+71 ; sets field .03 (Checkin), in file 409.84
DO SDECCHK(SDECAPTID,"")
+72 ;
DO CANCHKIN(SDECPATID,SDECSC1,SDECSTART)
End DoDot:2
+73 ;
+74 ; Event driver "AFTER" actions - wtc SD*5.3*717 10/24/18
+75 ;
+76 ;
DO AFTER^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL)
+77 ;
+78 ; Execute event driver. 4=check in (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
+79 ;
+80 ;*zeb+1 717 3/19/19 prevent extra cancel check-in when canceling a checked-in walkin
+81 ;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)
DO ERR($PIECE(SDECZ,U,2))
QUIT
+82 ;
+83 SET SDECI=SDECI+1
+84 SET ^TMP("SDEC",$JOB,SDECI)="0^"_$SELECT($GET(EMSG)'="":EMSG,1:"")_$CHAR(30)
+85 SET SDECI=SDECI+1
+86 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+87 QUIT
+88 ;
SDECCHK(SDECAPTID,SDECCDT) ;
+1 NEW SDECFDA,SDECMSG
+2 SET SDECIENS=SDECAPTID_","
+3 SET SDECFDA(409.84,SDECIENS,.03)=SDECCDT
+4 SET SDECFDA(409.84,SDECIENS,.04)=$SELECT(SDECCDT'="":$$NOW^XLFDT,1:"")
+5 DO FILE^DIE("","SDECFDA","SDECMSG")
+6 QUIT
+7 ;
APCHK(SDECZ,SDECSC1,SDECDFN,SDECCDT,SDECSTART) ;
+1 ;Checkin appointment for patient SDECDFN in clinic SDECSC1
+2 ;at time SDECSD
+3 NEW APTN,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 ;find IEN in ^SC multiple or null
+12 SET APTN=$$FIND^SDAM2(SDECC("PAT"),SDECC("APPT DATE"),SDECC("HOS LOC"))
+13 ;
+14 ;Required by NEW API:
+15 SET SDECC("SRV CAT")="A"
+16 SET SDECC("TIME RANGE")=-1
+17 SET SDECC("VISIT DATE")=SDECCDT
+18 SET SDECC("SITE")=$GET(DUZ(2))
+19 SET SDECC("VISIT TYPE")="V"
+20 SET SDECC("CLN")=SDECC("HOS LOC")
+21 SET SDECC("ADT")=SDECC("APPT DATE")
+22 ;
+23 ;Set up SDECVEN array containing VEN EHP CLINIC, VEN EHP FORM, OUTGUIDE FLAG
+24 ;These values come from input param
+25 SET SDECVEN("CLINIC")=SDECVCL
+26 SET SDECVEN("FORM")=$GET(SDECVFM)
+27 SET SDECVEN("OUTGUIDE")=$GET(SDECOG)
+28 ;
+29 NEW SDECOUT
+30 DO GETVISIT^SDECAPI4(.SDECC,.SDECOUT)
+31 ;K SDECC
+32 ;I SDECOUT(0)=1 S BSDVSTN=$O(SDECOUT(0)) ;if match found, set visit IEN
+33 ;D VISIT^SDECV(SDECC("HOS LOC"),SDECC("APPT DATE"),APTN,SDECC("PAT"),SDECC("CLINIC CODE"),SDECC("PROVIDER"),,.BSDMSG,.BSDVSTN,.SDECC) ;replace GETVISIT^SDECAPI4 to make sure all visit data is updated
+34 QUIT
+35 ;
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 ;I 'SDDA D ERR("SDEC25: Could not locate appointment in database or appointment is cancelled.") Q
+8 ;I 'SDDA D ERR("Could not locate appointment in database or appointment is cancelled.") Q
+9 ;
+10 ; Disabled event driver calls as they are present above in CHECKIN. SD*5.3*717 wtc 10/25/2018
+11 ;
+12 ;N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1)
+13 ;D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+14 SET FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)=""
DO FILE^DIE(,"FDA","ERR")
+15 ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+16 ;D CHKEVTD(DFN,SDT,SDCL)
+17 KILL FDA,ERR
+18 QUIT
+19 ;
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(ERRNO) ;Error processing
+1 SET SDECI=SDECI+1
+2 SET ^TMP("SDEC",$JOB,SDECI)=ERRNO_$CHAR(30)
+3 SET SDECI=SDECI+1
+4 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+5 QUIT
