- 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 Feb 19, 2025@00:16:44 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