Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDEC25

SDEC25.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; ICR
  1. ; ---
  1. ; 2309 - #9000010 ^AUPNVSIT
  1. ; 7030 - #2 (APPT record)
  1. ;
  1. Q
  1. ;
  1. 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)
  1. ; external parameter tag is in SDEC
  1. ;
  1. ; INPUT: SDECAPTID - (required) Appointment ID
  1. ; SDECCDT - (optional) Check-in date/time
  1. ; "@" - indicates delete check-in
  1. ; SDECCC - (optional) Clinic Stop pointer to CLINIC STOP file
  1. ; SDECPRV - (optional) Provider pointer to NEW PERSON file
  1. ; default to current user
  1. ; SDECROU - (optional) Print Routing Slip flag, valid values:
  1. ; 0=false 1=true
  1. ; SDECVCL - (unused) Clinic pointer to HOSPITAL LOCATION
  1. ; SDECVFM - (unused) FORM
  1. ; SDECOG - (unused) OUTGUIDE FLAG
  1. ; SDECCR - (unused) Generate Chart request upon check-in? (1-Yes, otherwise no)
  1. ; SDECPCC - (unused) ien of PWH Type in HEALTH SUMMARY PWH TYPE file ^APCHPWHT
  1. ; SDECWHF - (unused) Print Patient Wellness Handout flag
  1. ;
  1. ENDBG ;
  1. N BSDVSTN,EMSG
  1. N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECIENS,SDECVEN
  1. N SDECNOEV,SDECCAN,SDECR1,%DT,X,Y
  1. S SDECNOEV=1 ;Don't execute protocol
  1. S SDECCAN=0
  1. ;
  1. S SDECI=0
  1. K ^TMP("SDEC",$J)
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. S ^TMP("SDEC",$J,0)="T00020ERRORID^T00150MESSAGE"_$C(30)
  1. ;validate SDEC appointment ID
  1. I '+$G(SDECAPTID) D ERR("SDEC25: Invalid Appointment ID") Q
  1. I '$D(^SDEC(409.84,+SDECAPTID,0)) D ERR("SDEC25: Invalid Appointment ID") Q
  1. ;validate checkin date/time (required)
  1. S SDECCDT=$G(SDECCDT)
  1. S:SDECCDT="@" SDECCAN=1
  1. ;
  1. ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
  1. ;
  1. ;I 'SDECCAN,SDECCDT'="" S %DT="T" S X=SDECCDT D ^%DT S SDECCDT=Y I Y=-1 S SDECCDT=""
  1. I 'SDECCAN,SDECCDT'="" S SDECCDT=$$NETTOFM^SDECDATE(SDECCDT,"Y") I SDECCDT=-1 S SDECCDT="" ;
  1. I SDECCDT="" D ERR("SDEC25: Invalid Check-In Time") Q
  1. ;validate clinic stop code
  1. S SDECCC=$G(SDECCC)
  1. I SDECCC'="" I '$D(^DIC(40.7,SDECCC,0)) S SDECCC=""
  1. ;validate provider (optional)
  1. S SDECPRV=$G(SDECPRV)
  1. I SDECPRV'="" I '$D(^VA(200,+SDECPRV,0)) S SDECPRV=""
  1. ;I SDECPRV="" S SDECPRV=DUZ
  1. ;I SDECPRV="" S SDECPRV=""
  1. ;validate routine slip flag (optional)
  1. S SDECROU=$$UP^XLFSTR($G(SDECROU))
  1. S SDECROU=$S(SDECROU=1:"true",SDECROU="TRUE":"true",1:0)
  1. ;validate clinic
  1. S SDECVCL=$G(SDECVCL)
  1. I SDECVCL'="" I '$D(^SC(SDECVCL,0)) S SDECVCL=""
  1. I SDECCC="",SDECVCL'="" S SDECCC=$P($G(^SC(SDECVCL,0)),U,7) ;get clinic stop from 44
  1. ;
  1. S SDECNOD=^SDEC(409.84,SDECAPTID,0)
  1. S DFN=$P(SDECNOD,U,5)
  1. S SDECPATID=$P(SDECNOD,U,5)
  1. S SDECSTART=$P(SDECNOD,U)
  1. ;
  1. S SDECR1=$P(SDECNOD,U,7) ;RESOURCEID
  1. ;if resourceId is not null AND there is a valid resource record
  1. I SDECR1]"",$D(^SDEC(409.831,SDECR1,0)) D I +$G(SDECZ) D ERR($P(SDECZ,U,2)) Q
  1. . S SDECNOD=^SDEC(409.831,SDECR1,0)
  1. . S SDECSC1=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
  1. . ;Hospital Location is required for CHECKIN
  1. . ;I 'SDECSC1]"",'$D(^SC(+SDECSC1,0)) D ERR("SDEC25: Clinic not defined for this Resource: "_$P(SDECNOD,U,1)_" ("_SDECSC1_")") Q
  1. . I 'SDECSC1]"",'$D(^SC(+SDECSC1,0)) D ERR("Clinic not defined for this Resource: "_$P(SDECNOD,U,1)_" ("_SDECSC1_")") Q
  1. . ;
  1. . ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/24/18
  1. . ;
  1. . N SDATA,SDDA,SDCIHDL ;
  1. . S SDDA=$$FIND(DFN,SDECSTART,SDECSC1),SDATA=SDDA_U_DFN_U_SDECSTART_U_SDECSC1,SDCIHDL=$$HANDLE^SDAMEVT(1) ;
  1. . D BEFORE^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL) ;
  1. . ;
  1. . I 'SDECCAN D ;
  1. .. ;
  1. .. ; Checkin SDEC APPOINTMENT entry - wtc SD*5.3*717 10/24/18
  1. .. ;
  1. .. D SDECCHK(SDECAPTID,SDECCDT) ; sets field .03 (Checkin), in file 409.84
  1. .. D APCHK(.SDECZ,SDECSC1,SDECPATID,SDECCDT,SDECSTART)
  1. .. I $G(SDECPRV) S DIE="^SDEC(409.84,",DA=SDECAPTID,DR=".16///"_SDECPRV D ^DIE
  1. . ;
  1. . I SDECCAN D ;
  1. .. ;
  1. .. ; Cancel check in - wtc SD*5.3*717 10/24/18
  1. .. ;
  1. .. D SDECCHK(SDECAPTID,"") ; sets field .03 (Checkin), in file 409.84
  1. .. D CANCHKIN(SDECPATID,SDECSC1,SDECSTART) ;
  1. . ;
  1. . ; Event driver "AFTER" actions - wtc SD*5.3*717 10/24/18
  1. . ;
  1. . D AFTER^SDAMEVT(.SDATA,DFN,SDECSTART,SDECSC1,SDDA,SDCIHDL) ;
  1. . ;
  1. . ; Execute event driver. 4=check in (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
  1. . ;
  1. . ;*zeb+1 717 3/19/19 prevent extra cancel check-in when canceling a checked-in walkin
  1. . I '((SDECCDT="@")&($G(SDECTYP)]"")) D EVT^SDAMEVT(.SDATA,4,2,SDCIHDL) ;assumes SDECTYP, which is defined if coming from APPDEL^SDEC08
  1. ;
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)="0^"_$S($G(EMSG)'="":EMSG,1:"")_$C(30)
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q
  1. ;
  1. SDECCHK(SDECAPTID,SDECCDT) ;
  1. N SDECFDA,SDECMSG
  1. S SDECIENS=SDECAPTID_","
  1. S SDECFDA(409.84,SDECIENS,.03)=SDECCDT
  1. S SDECFDA(409.84,SDECIENS,.04)=$S(SDECCDT'="":$$NOW^XLFDT,1:"")
  1. D FILE^DIE("","SDECFDA","SDECMSG")
  1. Q
  1. ;
  1. APCHK(SDECZ,SDECSC1,SDECDFN,SDECCDT,SDECSTART) ;
  1. ;Checkin appointment for patient SDECDFN in clinic SDECSC1
  1. ;at time SDECSD
  1. N APTN,BSDMSG,SDECC
  1. S SDECC("PAT")=SDECPATID
  1. S SDECC("HOS LOC")=SDECSC1
  1. S SDECC("CLINIC CODE")=SDECCC
  1. S SDECC("PROVIDER")=SDECPRV
  1. S SDECC("APPT DATE")=SDECSTART
  1. S SDECC("CDT")=SDECCDT
  1. S SDECC("USR")=DUZ
  1. ;find IEN in ^SC multiple or null
  1. S APTN=$$FIND^SDAM2(SDECC("PAT"),SDECC("APPT DATE"),SDECC("HOS LOC"))
  1. ;
  1. ;Required by NEW API:
  1. S SDECC("SRV CAT")="A"
  1. S SDECC("TIME RANGE")=-1
  1. S SDECC("VISIT DATE")=SDECCDT
  1. S SDECC("SITE")=$G(DUZ(2))
  1. S SDECC("VISIT TYPE")="V"
  1. S SDECC("CLN")=SDECC("HOS LOC")
  1. S SDECC("ADT")=SDECC("APPT DATE")
  1. ;
  1. ;Set up SDECVEN array containing VEN EHP CLINIC, VEN EHP FORM, OUTGUIDE FLAG
  1. ;These values come from input param
  1. S SDECVEN("CLINIC")=SDECVCL
  1. S SDECVEN("FORM")=$G(SDECVFM)
  1. S SDECVEN("OUTGUIDE")=$G(SDECOG)
  1. ;
  1. N SDECOUT
  1. D GETVISIT^SDECAPI4(.SDECC,.SDECOUT)
  1. ;K SDECC
  1. ;I SDECOUT(0)=1 S BSDVSTN=$O(SDECOUT(0)) ;if match found, set visit IEN
  1. ;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
  1. Q
  1. ;
  1. CANCHKIN(DFN,SDCL,SDT) ; Logic to cancel a checkin if the checkin date/time is passed in as '@'
  1. ; input: DFN := ifn of patient
  1. ; SDCL := clinic#
  1. ; SDT := appt d/t
  1. ;
  1. N SDDA
  1. S SDDA=$$FIND(DFN,SDT,SDCL)
  1. ;I 'SDDA D ERR("SDEC25: Could not locate appointment in database or appointment is cancelled.") Q
  1. ;I 'SDDA D ERR("Could not locate appointment in database or appointment is cancelled.") Q
  1. ;
  1. ; Disabled event driver calls as they are present above in CHECKIN. SD*5.3*717 wtc 10/25/2018
  1. ;
  1. ;N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1)
  1. ;D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
  1. S FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)="" D FILE^DIE(,"FDA","ERR")
  1. ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
  1. ;D CHKEVTD(DFN,SDT,SDCL)
  1. K FDA,ERR
  1. Q
  1. ;
  1. FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
  1. ; input: DFN := ifn of pat.
  1. ; SDT := appt d/t
  1. ; SDCL := ifn of clinic
  1. ; output: [returned] := ifn if pat has appt on date/time
  1. ;
  1. N Y
  1. 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
  1. Q Y
  1. ;
  1. VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
  1. ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
  1. ; check to see they exist prior to calling this entry point.
  1. ; input: DFN := ifn of pat.
  1. ; SDT := appt d/t
  1. ; SDCL := ifn of clinic
  1. ; SDDA := ifn of appt
  1. ; output: [returned] := 1 for valid appt., 0 for not valid
  1. 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)
  1. ;
  1. CHKEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event
  1. ;when appointments CHECKIN via PIMS interface.
  1. ;Propagates CHECKIN to SDECAPPT and raises refresh event to running GUI clients
  1. ;
  1. Q:+$G(SDECNOEV)
  1. Q:'+$G(SDECSC)
  1. N SDECSTAT,SDECFOUND,SDECRES
  1. S SDECSTAT=""
  1. S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" SDECSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
  1. S SDECFOUND=0
  1. I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
  1. I SDECFOUND D CHKEVT3(SDECRES) Q
  1. Q
  1. ;
  1. CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT) ;
  1. ;Get appointment id in SDECAPT
  1. ;If found, call SDECNOS(SDECAPPT) and return 1
  1. ;else return 0
  1. N SDECFOUND,SDECAPPT
  1. S SDECFOUND=0
  1. Q:'+$G(SDECRES) SDECFOUND
  1. Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND
  1. S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND
  1. . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD=""
  1. . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q
  1. I SDECFOUND,+$G(SDECAPPT) D ;
  1. . D SDECCHK(SDECAPPT,SDECSTAT)
  1. Q SDECFOUND
  1. ;
  1. CHKEVT3(SDECRES) ;
  1. ;Call RaiseEvent to notify GUI clients
  1. ;
  1. Q
  1. N SDECRESN
  1. S SDECRESN=$G(^SDEC(409.831,SDECRES,0))
  1. Q:SDECRESN=""
  1. S SDECRESN=$P(SDECRESN,"^")
  1. ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","")
  1. ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN)
  1. Q
  1. ;
  1. CHKEVTD(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CHECKIN APPOINTMENT event
  1. ;when an appointment CHECKIN is deleted via.
  1. ;Deletes CHECKIN to and raises refresh event to running GUI clients
  1. ;
  1. ;
  1. Q:+$G(SDECNOEV)
  1. Q:'+$G(SDECSC)
  1. N SDECSTAT,SDECFOUND,SDECRES
  1. S SDECSTAT=""
  1. S:$G(SDATA("AFTER","STATUS"))'="CHECKED IN" SDECSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
  1. I SDECSTAT="" S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0))
  1. I SDECRES D CHKEVT3(SDECRES) Q
  1. S SDECFOUND=0
  1. ;
  1. ;I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CHKEVT1(SDECRES,SDECSTART,SDECPAT,SDECSTAT)
  1. ;I SDECFOUND D CHKEVT3(SDECRES) Q
  1. Q
  1. ;
  1. ;CHECK OUT APPOINTMENT - RPC
  1. CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) ;Check Out appointment
  1. ;CHECKOUT(SDECY,DFN,SDT,SDCODT,SDECAPTID,VPRV) external parameter tag is in SDEC
  1. ; Returns SDECY
  1. ; Input -- DFN Patient file IEN
  1. ; SDT Appointment Date/Time in FM format
  1. ; SDCODT Date/Time of Check Out FM FORMAT [REQUIRED]
  1. ; SDECAPTID - Appointment ID
  1. ; VPRV - V Provider
  1. ;SETUP ERROR TRACKING
  1. N APIERR,CNT,ERR,%DT,X,Y
  1. N SDCL,SDASK,SDCOACT,SDCOALBF,SDDA,SDLNE,SDQUIET
  1. N SDECI,SDECNOD,RPCPERM
  1. S SDECI=0
  1. K ^TMP("SDEC",$J)
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. S ^TMP("SDEC",$J,0)="T00020ERRORID"_$C(30)
  1. S RPCPERM=""
  1. S RPCPERM=$$KCHK^XUSRB("SD SUPERVISOR",DUZ) I RPCPERM=0 D ERR("THE SD SUPERVISOR KEY IS REQUIRED TO PERFORM THIS ACTION.") Q
  1. I '+SDECAPTID D ERR("Invalid Appointment ID.") Q
  1. I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR("Invalid Appointment ID.") Q
  1. ;INITIALIZE VARIABLES
  1. ;
  1. ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
  1. ;
  1. ;S %DT="T"
  1. ;S X=SDT
  1. ;D ^%DT ; GET FM FORMAT FOR APPOINTMENT DATE/TIME
  1. ;S SDT=Y
  1. S SDT=$$NETTOFM^SDECDATE(SDT,"Y") ;
  1. ;S X=SDCODT
  1. ;D ^%DT ; GET FM FORMAT FOR CHECKOUT DATE/TIME
  1. S SDCODT=$$NETTOFM^SDECDATE(SDCODT,"Y") ;
  1. ;ChecOut time cannot be in the future
  1. ;S SDCODT=Y
  1. I SDCODT>$$HTFM^XLFDT($H) D ERR("Check Out time cannot be in the future.") Q
  1. ;
  1. ;appointment record
  1. S SDECNOD=^SDEC(409.84,SDECAPTID,0)
  1. ;make sure CHECKOUT time is after CHECKIN time
  1. 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
  1. ;Hospital Location of RESOURCE
  1. S SDECRES=$P(SDECNOD,U,7) ;RESOURCEID
  1. S SDECNOD=^SDEC(409.831,SDECRES,0)
  1. S SDCL=$P(SDECNOD,U,4) ;HOSPITAL LOCATION
  1. ;
  1. S SDDA=0
  1. S SDASK=0
  1. S SDCOALBF=""
  1. S SDCOACT="CO"
  1. S SDLNE=""
  1. S SDQUIET=1
  1. K APIERR
  1. S APIERR=0
  1. ;
  1. ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
  1. ;
  1. N SDATA,SDDA,SDCIHDL ;
  1. S SDDA=$$FIND(DFN,SDT,SDCL),SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1) ;
  1. ;
  1. ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
  1. ;
  1. D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
  1. ;
  1. D CO^SDEC25A(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,.SDCOALBF,SDECAPTID,SDQUIET,VPRV,.APIERR) ;Appt Check Out
  1. ;
  1. ; Skip event driver actions if error occurred checking appointment out. - wtc SD*5.3*717 10/25/2018
  1. ;
  1. I 'APIERR D ;
  1. . ;
  1. . ; Event driver "AFTER" actions - wtc SD*5.3*717 10/25/18
  1. . ;
  1. . D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
  1. . ;
  1. . ; Execute event driver. 5=check out (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
  1. . ;
  1. . D EVT^SDAMEVT(.SDATA,5,2,SDCIHDL) ;
  1. ;
  1. ;ERROR(S) FOUND
  1. I APIERR>0 D
  1. . S CNT=""
  1. . F S CNT=$O(APIERR(CNT)) Q:CNT="" S ERR=APIERR(CNT) S SDECI=SDECI+1 D ERR(ERR)
  1. ;NO ERROR
  1. I APIERR<1 D
  1. . S SDECI=SDECI+1
  1. . S ^TMP("SDEC",$J,SDECI)="0"_$C(30)
  1. . S SDECI=SDECI+1
  1. . S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q
  1. ;
  1. ;CHECK OUT APPOINTMENT - RPC
  1. CANCKOUT(SDECY,SDECAPTID) ;Cancel Check Out appointment
  1. ;CANCKOUT(SDECY,SDECAPTID) external parameter tag is in SDEC
  1. ; Returns SDECY
  1. ; Input -- SDECAPTID - Appointment ID
  1. N APS,DA,DFN,DIE,DR,RES
  1. N SDCL,SDN,SDOE,SDT,SDV
  1. N SDECI,SDECNOD,RPCPERM
  1. S SDECI=0
  1. K ^TMP("SDEC",$J)
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. S ^TMP("SDEC",$J,0)="T00020ERRORID"_$C(30)
  1. S RPCPERM=""
  1. S RPCPERM=$$KCHK^XUSRB("SD SUPERVISOR",DUZ) I RPCPERM=0 D ERR("THE SD SUPERVISOR KEY IS REQUIRED TO PERFORM THIS ACTION.") Q
  1. I '+SDECAPTID D ERR("Invalid Appointment ID.") Q
  1. I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR("Invalid Appointment ID.") Q
  1. S SDECNOD=^SDEC(409.84,SDECAPTID,0)
  1. S APS=$P(SDECNOD,U,19)
  1. S DFN=$P(SDECNOD,U,5)
  1. S SDT=$P(SDECNOD,U)
  1. S RES=$P(SDECNOD,U,7)
  1. S SDCL=$P(^SDEC(409.831,RES,0),U,4)
  1. I $P(SDECNOD,U,14)="" D ERR("Appointment is not Checked Out.") Q
  1. ;
  1. ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
  1. ;
  1. N SDATA,SDDA,SDCIHDL ;
  1. S SDDA=$$FIND(DFN,SDT,SDCL),SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1) ;
  1. ;
  1. ; Event driver "BEFORE" actions - wtc SD*5.3*717 10/25/18
  1. ;
  1. D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
  1. ;
  1. ; ^SDECAPPT: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
  1. S DIE="^SDEC(409.84,"
  1. S DA=SDECAPTID
  1. S DR=".14////@;.08///"_DUZ
  1. D ^DIE
  1. ; ^SC file 44: clear piece C;3: CHECKED OUT; clear piece C;4: CHECK OUT USER; clear C;6: CHECK OUT ENTERED
  1. S DIE="^SC("_SDCL_",""S"","_SDT_",1,"
  1. S DA(2)=SDCL,DA(1)=SDT,(DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT)
  1. S DR="303///@;304///@;306///@"
  1. D ^DIE
  1. ; ^AUPNVSIT file 9000010: clear piece 18: CHECK OUT DATE&TIME
  1. S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
  1. S SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
  1. I +SDV D
  1. . S DIE="^AUPNVSIT(",DA=SDV
  1. . S DR=".18///@"
  1. . D ^DIE
  1. ; ^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
  1. I +APS D
  1. . S DIE=409.68,DA=SDOE,DR=".07///@;.12///"_APS_";101///"_DUZ_";102///"_$$NOW^XLFDT
  1. . D ^DIE
  1. ;
  1. ; Event driver "AFTER" actions - wtc SD*5.3*717 10/25/18
  1. ;
  1. D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
  1. ;
  1. ; Execute event driver. 5=check out (see #409.66), 2=non-interactive - wtc SD*5.3*717 10/25/18
  1. ;
  1. D EVT^SDAMEVT(.SDATA,5,2,SDCIHDL) ;
  1. ;
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)="0"_$C(30)
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q
  1. ;
  1. CANAPPT(SDECAPTID) ;external call to cancel check out in SDEC APPOINTMENT called by SDCODEL for VistA Delete Check Out
  1. N APS,DA,DIE,DR,DFN,RES,SDCL,SDT
  1. N SDECNOD
  1. I '+$G(SDECAPTID) Q
  1. I '$D(^SDEC(409.84,+SDECAPTID,0)) Q
  1. S SDECNOD=^SDEC(409.84,SDECAPTID,0)
  1. S APS=$P(SDECNOD,U,19)
  1. S DFN=$P(SDECNOD,U,5)
  1. S SDT=$P(SDECNOD,U)
  1. S RES=$P(SDECNOD,U,7)
  1. S SDCL=$P(^SDEC(409.831,RES,0),U,4)
  1. I $P(SDECNOD,U,14)="" Q
  1. ; ^SDEC(409.84: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
  1. S DIE="^SDEC(409.84,"
  1. S DA=SDECAPTID
  1. S DR=".14////@;.08///"_DUZ
  1. D ^DIE
  1. Q
  1. ;
  1. ERROR ;
  1. D ERR("VISTA Error")
  1. Q
  1. ;
  1. ERR(ERRNO) ;Error processing
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=ERRNO_$C(30)
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q