SDESCHECKOUT ;ALB/BWF,CGP,JAS,ANU - Checkout Appointment - VISTA SCHEDULING RPCS ;JAN 11, 2024
;;5.3;Scheduling;**826,827,836,853,867,869**;Aug 13, 1993;Build 13
;;Per VHA Directive 6402, this routine should not be modified
; Reference to MAS PARAMETERS in ICR #483
; Reference to WARD LOCATION in ICR #1377
; Reference to MAS PARAMETERS in ICR #2296
; Reference to VISIT in ICR #2028
;
Q
CHECKOUT(SDECY,APPTIEN,CHKOUTDT) ;Check Out appt
; Returns SDECY
; Input -- APPTIEN Appt IEN from 409.84
; CHKOUTDT Appt Checkout Date/Time in ISO
;
N CLINICIEN,SDASK,SDCOACT,SDDA,SDLNE,SDQUIET,APPTIENS,RESOURCE,ERRORS,DFN,APPTDATA,DFN,RESOURCE,CLINICIEN,CHKOUT
S APPTIEN=$G(APPTIEN),CHKOUTDT=$G(CHKOUTDT)
D VALAPPTIEN^SDESVALUTIL(.ERRORS,APPTIEN)
S APPTIENS=APPTIEN_","
D GETS^DIQ(409.84,APPTIENS,".01;.05;.07;.12;.16","I","APPTDATA")
I $G(APPTDATA(409.84,APPTIENS,.12,"I")) D ERRLOG^SDESJSON(.ERRORS,322)
S APPTDTTM=$G(APPTDATA(409.84,APPTIENS,.01,"I"))
S DFN=$G(APPTDATA(409.84,APPTIENS,.05,"I"))
S RESOURCE=$G(APPTDATA(409.84,APPTIENS,.07,"I"))
S VPRV=$G(APPTDATA(409.84,APPTIENS,.16,"I"))
S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
S CHKOUTDT=$$VALCHKOUTDT(.ERRORS,CHKOUTDT,CLINICIEN)
I $D(ERRORS) S ERRORS("CheckOut",1)="" D BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS) Q
;
S SDDA=0
S SDASK=0
S SDCOACT="CO"
S SDLNE=""
S SDQUIET=1
; Event driver "BEFORE" actions - from SD*5.3*717 10/25/18
N SDATA,SDDA,SDCIHDL ;
S SDDA=$$FIND(DFN,APPTDTTM,CLINICIEN)
I 'SDDA D Q
.D ERRLOG^SDESJSON(.ERRORS,317)
.S ERRORS("CheckOut",1)="" D BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS)
I '$$GET1^DIQ(44.003,SDDA_","_APPTDTTM_","_CLINICIEN_",",309,"I") D Q
.D ERRLOG^SDESJSON(.ERRORS,318)
.S ERRORS("CheckOut",1)="" D BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS)
;
S SDATA=SDDA_U_DFN_U_APPTDTTM_U_CLINICIEN
S SDCIHDL=$$HANDLE^SDAMEVT(1) ;
; Event driver "BEFORE"
D BEFORE^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL) ;
; Appointment checkout
D CHKOUT(DFN,APPTDTTM,CLINICIEN,SDDA,SDASK,CHKOUTDT,SDCOACT,SDLNE,APPTIEN,SDQUIET,VPRV,.ERRORS)
; Skip event driver actions if err occurred checking appointment out. - wtc SD*5.3*717 10/25/2018
I $D(ERRORS) S ERRORS("CheckOut",1)="" D BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS) Q
; Event driver "AFTER"
D AFTER^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL) ;
; Execute event driver. 5=check out (see #409.66), 2=non-interactive
D EVT^SDAMEVT(.SDATA,5,2,SDCIHDL) ;
S CHKOUT("CheckOut",1)="Checked Out." D BUILDJSON^SDESBUILDJSON(.SDECY,.CHKOUT)
Q
VALCHKOUTDT(ERRORS,CHKOUTDT,CLINIC) ;
N CHKOUTDTFM,CHKIN
S CHKIN=$$GET1^DIQ(409.84,APPTIEN,.03,"I")
S CHKOUTDTFM=""
I CHKOUTDT="" D ERRLOG^SDESJSON(.ERRORS,23) Q CHKOUTDTFM
S CHKOUTDTFM=$$ISOTFM^SDAMUTDT(CHKOUTDT,CLINIC)
I CHKOUTDTFM<0 D ERRLOG^SDESJSON(.ERRORS,24) Q CHKOUTDTFM
I $P(CHKOUTDTFM,".",2)="" D ERRLOG^SDESJSON(.ERRORS,321) Q CHKOUTDTFM
; checkout time cannot be in the future
I CHKOUTDTFM>$$NOW^XLFDT D ERRLOG^SDESJSON(.ERRORS,320) Q CHKOUTDTFM
; checkout time is after checkin time
I CHKOUTDTFM'>CHKIN D ERRLOG^SDESJSON(.ERRORS,52,"Check Out time must be at least 1 minute after the Check In time of "_$TR($$FMTE^XLFDT(CHKIN),"@"," ")_".")
Q CHKOUTDTFM
;
FIND(DFN,APPTDTTM,CLINICIEN) ; -- return appt ifn for pat
; input: DFN := ifn of pat.
; APPTDTTM := appt d/t
; CLINICIEN := ifn of clinic
; output: [returned] := ifn if pat has appt on date/time
;
N Y,FOUND,RET
S RET=""
S (Y,FOUND)=0
F S Y=$O(^SC(CLINICIEN,"S",APPTDTTM,1,Y)) Q:'Y!(FOUND) D
.I '$D(^SC(CLINICIEN,"S",APPTDTTM,1,Y,0)) Q
.I DFN'=$$GET1^DIQ(44.003,Y_","_APPTDTTM_","_CLINICIEN_",",.01,"I") Q
.I $D(^DPT(DFN,"S",APPTDTTM,0)),$$VALID(DFN,CLINICIEN,APPTDTTM,Y) S FOUND=1,RET=Y Q
Q RET
;
VALID(DFN,CLINICIEN,APPTDTTM,SDDA) ;
; input: DFN := ifn of pat.
; APPTDTTM := appt d/t
; CLINICIEN := ifn of clinic
; SDDA := ifn of appt
; output: [returned] := 1 for valid appt., 0 for not valid
N APPTCAN44,APPTCAN2
S APPTCAN44=$$GET1^DIQ(44.003,SDDA_","_APPTDTTM_","_CLINICIEN_",",310,"I")
S APPTCAN2=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")
Q $S(APPTCAN44'="C":1,APPTCAN2["C":1,1:0)
;
; from CO^SDEC25A
CHKOUT(DFN,APPTDTTM,CLINICIEN,SDDA,SDASK,CHKOUTDT,SDCOACT,SDLNE,SDECAPTID,SDQUIET,VPRV,ERRORS) ;Appt Check Out
; Input -- DFN Patient file IEN
; APPTDTTM Appointment Date/Time
; CLINICIEN Hospital Location file IEN for Appt
; SDDA IEN in ^SC multiple or null [Optional]
; SDASK Ask Check Out Date/Time [Optional]
; CHKOUTDT Date/Time of Check Out [Optional]
; SDCOACT Appt Mgmt Check Out Action [Optional]
; SDLNE Appt Mgmt Line Number [Optional]
; Input -- SDECAPTID Appointment ID
; SDQUIET No Terminal output 0=allow display 1=do not allow
; VPRV V Provider IEN - pointer to V PROVIDER file
; ERRORS Returned Array of errors
;
N SDCOQUIT,SDOE,SDATA
S SDATA=$G(^DPT(DFN,"S",APPTDTTM,0))
;-- if new encounter, pass to PCE
I $$NEW(APPTDTTM) D Q
.N SDCOED
.;ANU - Add ERRORS
.S SDOE=$$GETAPT(DFN,APPTDTTM,CLINICIEN,.ERRORS)
.I $D(ERRORS) Q
.;
.S SDCOED=$$CHK($TR($$STATUS(DFN,APPTDTTM,CLINICIEN,SDATA,SDDA),";","^"))
.; -- appt has already been checked out
.I $$CODT(DFN,APPTDTTM,CLINICIEN,SDDA)!(SDCOED) D Q
..D ERRLOG^SDESJSON(.ERRORS,319)
.D CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,.ERRORS)
Q
CODT(DFN,SDT,SDCL,SDDA) ; -- does appt have co date
Q $$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",303,"I")
;
NEW(DATE) ;-- return 1 if SD is turned on for
; Visit Tracking and optionally check if the date is past
; the cut over date for the new PCE interface.
; INPUT : DATE (Optional) Date to check for cut over.
; OUTPUT: 1 Yes, 0 No
N SDRES,SDX,SDY
I '$G(DATE) S DATE=DT
;-- is Scheduling on ?
S SDRES=0,SDY=$$PKGON^VSIT("SD")
;-- if date is it pass cut over?
S SDX=1 I $G(DATE) S SDX=$$SWITCHCK^PXAPI(DATE)
;-- And together
I SDX,SDY S SDRES=1
Q SDRES
;
GETAPT(DFN,SDT,SDCL,SDVIEN,ERRORS) ;
; ANU - Added ERRORS
; This utility will return the existing IEN for an Outpatient
; Encounter. If it fails to find an existing encounter,
; it will create a new Encounter and return the new IEN.
;
; Input -- DFN Patient file IEN
; SDT Appointment Date/Time
; SDCL Hospital Location file IEN for Appt
; SDVIEN Visit file pointer [optional]
; Output -- Outpatient Encounter file IEN
N Y
S Y=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
I 'Y D APPT(DFN,SDT,SDCL,$G(SDVIEN),.ERRORS)
I $D(ERRORS) Q +$G(Y)
I '$D(ERRORS) S Y=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
;
I Y D VIEN(Y,$G(SDVIEN))
Q +$G(Y)
;
; FROM APPT^SDVSIT
APPT(DFN,SDT,SDCL,SDVIEN,ERRORS) ; -- process appt
; input DFN = ien of patient file entry
; SDT = visit date internal format
; SDCL = ien of hospital location file entry
; SDVIEN = Visit file pointer [optional]
;
N SDVSIT,SDOE,DA,DIE,DR,SDPT,SDSC,SDCL0,SDDA,SDLOCK,SDLCKS
;
; -- set lock data and lock
S SDLOCK("DFN")=DFN
S SDLOCK("EVENT DATE/TIME")=SDT
;ANU
;D LOCK(.SDLOCK)
I '$$LOCK(.SDLOCK) D ERRLOG^SDESJSON(.ERRORS,174) Q
;
; -- set node vars
S SDPT=$G(^DPT(DFN,"S",SDT,0))
S SDCL0=$G(^SC(SDCL,0)),SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
S SDSC=$G(^SC(SDCL,"S",SDT,1,SDDA,0))
S SDVSIT("CLN")=$P(SDCL0,U,7),SDVSIT("DIV")=$$DIV($P(SDCL0,U,15))
;
; -- do checks
I 'SDPT!('SDSC)!($P(SDCL0,U,3)'="C") D UNLOCK(.SDLOCK) Q
I SDCL,+SDPT'=SDCL D UNLOCK(.SDLOCK) Q
I $P(SDPT,U,20) D UNLOCK(.SDLOCK) Q
I 'SDVSIT("CLN")!('SDVSIT("DIV")) D UNLOCK(.SDLOCK)
;
; -- set the rest
S SDVSIT("DFN")=DFN,SDVSIT("LOC")=SDCL
S:$P(SDSC,U,10) SDVSIT("ELG")=$P(SDSC,U,10)
S:$P(SDPT,U,16) SDVSIT("TYP")=$P(SDPT,U,16)
;
; -- call logic to add opt encounter(s)
S SDVSIT("ORG")=1,SDVSIT("REF")=SDDA,SDOE=$$SDOE(SDT,.SDVSIT,$G(SDVIEN))
I SDOE D
.;869 - Convert ///
.;N DA,DIE,DR
.;S DA=SDT,DA(1)=DFN,DR="21////"_SDOE,DIE="^DPT("_DFN_",""S""," D ^DIE
.N FDAIENS,ERR298,FDA298
.S FDAIENS=SDT_","_DFN_","
.S FDA298(2.98,FDAIENS,21)=SDOE
.D FILE^DIE(,"FDA298","ERR298")
.;
D CSTOP(SDOE,SDCL,.SDVSIT,SDT) ;Process credit stop if applicable
D UNLOCK(.SDLOCK)
Q
; FROM LOCK^SDVSIT
; Anu - function to return lock error
; Status = 1 if success, 0 if fail
LOCK(SDLOCK) ; -- lock "ADFN" node
N SDC
;F L +^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME"))):$G(DILOCKTM,3) Q:$T ;LLS - 05-JAN-15 - SD*5.3*630 added timeout on lock
F SDC=1:1:5 L +^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME"))):$G(DILOCKTM,3) Q:$T
I $T Q 1
Q 0
; FROM UNLOCK^SDVSIT
UNLOCK(SDLOCK) ; -- unlock "ADFN" node
L -^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME")))
Q
; FROM SDOE^SDVSIT
SDOE(SDT,SDVSIT,SDVIEN,SDOEP) ; -- get visit & encounter
N SDTR,SDI ;LLS 22-DEC-2014 - SD*5.3*630 - added
S SDTR=9999999-$P(SDT,".") ;LLS 22-DEC-2014 - SD*5.3*630 - added
I SDT["." S SDTR=SDTR_"."_$P(SDT,".",2) ;LLS 22-DEC-2014 - SD*5.3*630 - added
I '$D(SDVSIT("PAR")),$G(SDVIEN)="" D ;LLS 22-DEC-2014 - SD*5.3*630 - added the following section
.N SDVISARR,SDVIEN1
.S SDVIEN1="" F S SDVIEN1=$O(^AUPNVSIT("AA",DFN,SDTR,SDVIEN1)) Q:SDVIEN1="" D Q:$G(SDVIEN)]""
..; COMPARE VISIT: SERVICE CATEGORY, POINTER TO CLINIC STOP FILE, POINTER TO #44
..; FILE, & ENCOUNTER TYPE BEFORE SELECTING EXISTING VISIT INSTEAD OF CREATING A NEW ONE
..D GETS^DIQ(9000010,SDVIEN1_",",".07;.08;.22;15003","I","SDVISARR")
..;Q:SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$S($G(SDVSIT("SVC"))]"":SDVSIT("SVC"),$$INP^SDAM2(DFN,SDTR)="I":"I",1:"A")
..Q:SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$S($G(SDVSIT("SVC"))]"":SDVSIT("SVC"),$$INP(DFN,SDTR)="I":"I",1:"A")
..Q:SDVISARR(9000010,SDVIEN1_",",.08,"I")'=$G(SDVSIT("CLN"))
..Q:SDVISARR(9000010,SDVIEN1_",",.22,"I")'=$G(SDVSIT("LOC"))
..Q:SDVISARR(9000010,SDVIEN1_",",15003,"I")'="P"
..S SDVIEN=SDVIEN1
S SDVSIT("VST")=$G(SDVIEN)
; bwf - SD*826 - leaving calls to SDVSIT0 - consider bringing into SDES* namespace in the future
I 'SDVSIT("VST") D VISIT^SDVSIT0(SDT,.SDVSIT)
Q $$NEW^SDVSIT0(SDT,.SDVSIT)
;
INP(DFN,VDATE) ; -- determine inpatient status ; dom is not an inpatient appt
N SDINP,VAINDT,VADMVT,WARDLOC
S SDINP="",VAINDT=VDATE D ADM^VADPT2 I 'VADMVT Q SDINP
S WARDLOC=$$GET1^DIQ(405,VADMVT,.06,"I")
I $$GET1^DIQ(43,1,16,"I"),$$GET1^DIQ(42,WARDLOC,.03,"I")="D" Q SDINP
S SDINP="I"
Q SDINP
;
DIV(DIV) ; -- determine med div
; multi-div
I $$GET1^DIQ(43,1,11,"I"),$D(^DG(40.8,+DIV,0)) Q DIV
S DIV=+$O(^DG(40.8,0))
Q DIV
;
; FROM CSTOP^SDVSIT
CSTOP(SDOE,SDCL,SDVSIT,SDT) ;Process credit stop
;Input: SDOE=encounter ien
;Input: SDCL0=zeroeth node of HOSPITAL LOCATION file record
;Input: SDVSIT=visit data array (pass by reference)
;Input: SDT=encounter date/time
; -- does clinic have a credit stop code?
; -- process only if non non-count and not equal to credit
;
N CREDSCODE,NONCOUNT,CLINSTOPCODE,CSTOPINACTDT,IENS,CLINDAT
S IENS=SDCL_","
D GETS^DIQ(44,IENS,"8;2502;2503","I","CLINDAT","ERR")
S CREDSCODE=$G(CLINDAT(44,IENS,2503,"I"))
S NONCOUNT=$G(CLINDAT(44,IENS,2502,"I"))
S CLINSTOPCODE=$G(CLINDAT(44,IENS,8,"I"))
S CSTOPINACTDT=$$GET1^DIQ(40.7,CLINSTOPCODE,2,"I")
I SDOE,CREDSCODE,(CREDSCODE'=SDVSIT("CLN")),NONCOUNT'="Y" D
.N X,SDVIENSV,SDVIENOR
.; -- is stop code active?
.I $S('CSTOPINACTDT:1,1:SDT<CSTOPINACTDT) D
..S SDVSIT("CLN")=CREDSCODE
..S SDVIENOR=$G(SDVSIT("ORG"))
..S SDVSIT("ORG")=4
..S SDVSIT("PAR")=SDOE
..S SDVIENSV=$G(SDVSIT("VST"))
..K SDVSIT("VST")
..S X=$$SDOE(SDT,.SDVSIT)
..I X D LOGDATA(X)
..; -- restore SDVSIT
..S SDVSIT("CLN")=CLINSTOPCODE
..S SDVSIT("ORG")=SDVIENOR
..S SDVSIT("VST")=SDVIENSV
..K SDVSIT("PAR")
..Q
.Q
Q
LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data
N DIE,DA,DR,Y,X
S SDLOG("USER")=$G(DUZ)
S SDLOG("DATE/TIME")=$$NOW^XLFDT()
S DIE="^SCE(",DA=SDOE,DR="[SD ENCOUNTER LOG]" D ^DIE
Q
;
VIEN(SDOE,SDVIEN) ; -- stuff in Visit IEN if not already set
; -- needed for those sites that don't have
; scheduling turned on in Visit Tracking
; Required input SDOE = Outpatient Encounter pointer
; SDVIEN = Visit file pointer or null or zero
;
; -- quit if no vien passed
Q:'SDVIEN
; -- quit is no encounter
Q:'$D(^SCE(+SDOE,0))
; -- set visit ien if vien not already set
I '$$GET1^DIQ(409.68,+SDOE,.05,"I") D
.;869 - Convert ////
.;S DIE="^SCE(",DA=SDOE,DR=".05////"_SDVIEN D ^DIE
.N FDA40968,ERR40968
.S FDA40968(409.68,SDOE_",",.05)=SDVIEN
.D FILE^DIE(,"FDA40968","ERR40968") K FDA40968
.;
I '$$GET1^DIQ(409.68,+SDOE,.04,"I") D
.;869 - Converting ////
.N SDLOC,FDA40968,ERR40968
.S SDLOC=$$GET1^DIQ(9000010,SDVIEN,.22,"I")
.;I SDLOC S DIE="^SCE(",DA=SDOE,DR=".04////"_SDLOC D ^DIE
.I SDLOC D
..S FDA40968(409.68,SDOE_",",.04)=SDLOC
..D FILE^DIE(,"FDA40968","ERR40968")
Q
;
;CO^SDEC25B
CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,ERRORS) ;EP; called to ask check-out date/time ;SAT ADDED PARAMETERS CHKOUTDT, SDECAPTID, & SDQUIET
; Called by SDCO1
; SDOE = Outpatient Encounter IEN
; DFN = Patient IEN
; APPTDTTM = Appt Date/Time
; CLINICIEN = Clinic IEN
; CHKOUTDT = APPT CHECKOUT TIME [OPTIONAL - USED WHEN SDQUIET=1] USER ENTERED FORMAT
; SDECAPTID = APPT ID - POINTER TO ^SDECAPPT
; SDQUIET = ALLOW NO TERMINAL INPUT/OUTPUT 0=ALLOW; 1=DO NOT ALLOW
; VPRV = V Provider IEN - pointer to V PROVIDER file
; ERRORS = Returned Array of errors
;
N DIE,DA,DR,SDECNOD,SDN,SDV,AUPNVSIT,PROVIEN40984,PSTAT
;
; 869 - Convert ///
;S DR="303///"_CHKOUTDT_";304///`"_DUZ_";306///"_$$NOW^XLFDT
;D ^DIE
;S DIE="^SC("_CLINICIEN_",""S"","_APPTDTTM_",1,"
;S DA(2)=CLINICIEN,DA(1)=APPTDTTM
N IENS44,ERR44003,FDA
S (DA,SDN)=$$SCIEN(DFN,CLINICIEN,APPTDTTM)
S IENS44=$$GET44RECORDIENS^SDESCANCELAPPTS(CLINICIEN,APPTDTTM,DFN)
S FDA(44.003,IENS44,303)=CHKOUTDT
S FDA(44.003,IENS44,304)=DUZ
S FDA(44.003,IENS44,306)=$$NOW^XLFDT
D FILE^DIE(,"FDA","ERR44003") K ERR44003
;
; if checked out and status not updated, do it now
I $$GET1^DIQ(44.003,DA_","_APPTDTTM_","_CLINICIEN_",",303,"I")]"" D
.;UPDATE APPT SCHEDULE GLOBAL ^SDEC(409.84
.I $G(SDECAPTID) D
..S PSTAT=$$GET1^DIQ(409.68,SDOE,.12,"I")
..;869 - Convert ///
..;S DA=SDECAPTID
..;S DR=".14///"_$G(CHKOUTDT)_";.19///"_PSTAT
..;D ^DIE
..N FDA40984,ERR40984
..S FDA40984(409.84,SDECAPTID_",",.14)=$G(CHKOUTDT)
..S FDA40984(409.84,SDECAPTID_",",.19)=$G(PSTAT)
..D FILE^DIE(,"FDA40984","ERR40984")
..;
..;possibly update VProvider
..S SDECNOD=^SDEC(409.84,SDECAPTID,0)
..S PROVIEN40984=$$GET1^DIQ(409.84,SDECAPTID,.15,"I")
..I $G(VPRV),PROVIEN40984 D
...;get SDEC appt schedule
...;869 - Convert ///
...;S DA=PROVIEN40984 ;S DR=".01///"_VPRV
...;D ^DIE
...N FDA91006,ERR91006
...S FDA91006(9000010.06,PROVIEN40984_",",.01)=VPRV
...D FILE^DIE(,"FDA91006","ERR91006") K FDA91006
.;
.Q:$$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"
.;869 - Convert ///
.;S DIE=409.68,DA=SDOE,DR=".12///14;101///"_DUZ_";102///"_$$NOW^XLFDT
.;D ^DIE
.N FDA40968,ERR40968
.S FDA40968(409.68,SDOE_",",.12)=14
.S FDA40968(409.68,SDOE_",",101)=DUZ
.S FDA40968(409.68,SDOE_",",102)=$$NOW^XLFDT
.D FILE^DIE(,"FDA40968","ERR40968")
.;
.; if visit pointer stored, update visit checkout date/time
.S SDV=$$GET1^DIQ(409.68,SDOE,.05,"I") Q:'SDV
.Q:'$D(^AUPNVSIT(SDV,0)) Q:$$GET1^DIQ(9000010,SDV,.05,"I")'=DFN
.Q:$$GET1^DIQ(9000010,SDV,.11,"I")=1 ;deleted
.;cmi/maw 5/1/2009 PATCH 1010 RQMT 34
.;869 - Convert ///
.;S DIE="^AUPNVSIT(",DA=SDV
.;S DR=".18///"_$$GET1^DIQ(44.003,SDN_","_APPTDTTM_","_CLINICIEN_",",303,"I")
.;D ^DIE
.N FDA9000010,ERR9000010
.S FDA9000010(9000010,SDV_",",.18)=$$GET1^DIQ(44.003,SDN_","_APPTDTTM_","_CLINICIEN_",",303,"I")
.D FILE^DIE(,"FDA9000010","ERR9000010") K FDA9000010
.;
Q
;
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
NEW X,IEN
S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
. Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
Q $G(IEN)
;
;
CHK(SDSTB) ; -- is appointment checked out
N Y
I "^2^8^12^"[("^"_+SDSTB_"^"),$P(SDSTB,"^",3)["CHECKED OUT" S Y=1
Q +$G(Y)
;
STATUS(DFN,SDT,SDCL,SDATA,SDDA) ; -- return appt status
; input: DFN := ifn of pat.
; SDT := appt d/t
; SDCL := ifn of clinic
; SDATA := 0th node of pat appt entry
; SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
; output: [returned] := appt status ifn ^ status name ^ print status ^
; check in d/t ^ check out d/t ^ adm mvt ifn
;
;S = status ; C = ci/co indicator ; Y = 'C' node ; P = print status
N S,C,Y,P,VADMVT,VAINDT,STATUS,SDSCE,SDIEN,CHKINDT,CHKOUTDT
;
; -- get data for evaluation
S:'$G(SDDA) SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
S CHKINDT=$$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",309,"I")
S CHKOUTDT=$$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",303,"I")
;retrieve CHECK OUT from OUTPATIENT ENCOUNTER file if not in Hospital Location file/PURGED or edited
S SDSCE=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
I SDSCE D ;pointer to OE
.I CHKOUTDT="" S CHKOUTDT=$$GET1^DIQ(409.68,SDSCE,.07,"I")
.S SDIEN=SDSCE_"," S STATUS=$$GET1^DIQ(409.68,SDIEN,.12)
;
; -- set initial status value ; non-count clinic?
S S=$S($P(SDATA,"^",2)]"":$P($P($P(^DD(2.98,3,0),"^",3),$P(SDATA,"^",2)_":",2),";"),$P($G(^SC(SDCL,0)),U,17)="Y":"NON-COUNT",1:"")
I SDSCE&(S="NO ACTION TAKEN") S S=""
;
; -- inpatient?
S VAINDT=SDT D ADM^VADPT2
I S["INPATIENT",$S('VADMVT:1,'$P(^DG(43,1,0),U,21):0,1:$P($G(^DIC(42,+$P($G(^DGPM(VADMVT,0)),U,6),0)),U,3)="D") S S=""
;
; -- determine ci/co indicator
S C=$S(CHKOUTDT:"CHECKED OUT",CHKINDT:"CHECKED IN",S]"":"",SDT>(DT+.2359):"FUTURE",1:"NO ACTION TAKEN") S:S="" S=C
;
I S="NO ACTION TAKEN",$P(SDT,".")=DT,C'["CHECKED" S C="TODAY"
; -- $$REQ & $$COCMP in SDM1A not used for speed
I S="CHECKED OUT"!(S="CHECKED IN"),SDT'<$P(^DG(43,1,"SCLR"),U,23),'$P(SDATA,U,20) S S="NO ACTION TAKEN"
;
; -- determine print status
S P=$S(S=C!(C=""):S,1:"")
I P="" D
.I S["INPATIENT",$P($G(^SC(SDCL,0)),U,17)'="Y",$P($G(^SCE(+$P(SDATA,U,20),0)),U,7)="" S P=$P(S," ")_"/ACT REQ" Q
.I S="NO ACTION TAKEN",C="CHECKED OUT"!(C="CHECKED IN") S P="ACT REQ/"_C D Q
..I SDSCE I $P($G(^SCE(SDSCE,0)),U,7) S P="CHECKED OUT"
.S P=$S(S="NO ACTION TAKEN":S,1:$P(S," "))_"/"_C
I S["INPATIENT",C="" D
.I SDT>(DT+.2359) S P=$P(S," ")_"/FUTURE" Q
.S P=$P(S," ")_"/NO ACT TAKN"
I S["INPATIENT" Q +$O(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_CHKINDT_";"_CHKOUTDT_";"_+VADMVT
I S["NO-SHOW" Q +$O(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_CHKINDT_";"_CHKOUTDT_";"_+VADMVT
I $G(SDSCE) I $D(^SCE(SDSCE,0)) D
.I $G(STATUS)="NON-COUNT" D Q
..I CHKOUTDT S P="NON-COUNT/CHECKED OUT" Q
..I CHKINDT S P="NON-COUNT/CHECKED IN"
.I $G(STATUS)="CHECKED OUT" S P="CHECKED OUT" Q
.I CHKOUTDT S P="ACT REQ/CHECKED OUT" D Q
..I $G(STATUS)="ACTION REQUIRED" S S="NO ACTION TAKEN" Q
..I $G(STATUS)="" I $P($G(^SCE(SDSCE,0)),U,7) S P="CHECKED OUT"
.I CHKINDT S P="ACT REQ/CHECKED IN" D
..I $G(STATUS)="ACTION REQUIRED" S S="NO ACTION TAKEN"
Q +$O(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_CHKINDT_";"_CHKOUTDT_";"_+VADMVT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCHECKOUT 19871 printed Apr 09, 2024@22:04:27 Page 2
SDESCHECKOUT ;ALB/BWF,CGP,JAS,ANU - Checkout Appointment - VISTA SCHEDULING RPCS ;JAN 11, 2024
+1 ;;5.3;Scheduling;**826,827,836,853,867,869**;Aug 13, 1993;Build 13
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ; Reference to MAS PARAMETERS in ICR #483
+4 ; Reference to WARD LOCATION in ICR #1377
+5 ; Reference to MAS PARAMETERS in ICR #2296
+6 ; Reference to VISIT in ICR #2028
+7 ;
+8 QUIT
CHECKOUT(SDECY,APPTIEN,CHKOUTDT) ;Check Out appt
+1 ; Returns SDECY
+2 ; Input -- APPTIEN Appt IEN from 409.84
+3 ; CHKOUTDT Appt Checkout Date/Time in ISO
+4 ;
+5 NEW CLINICIEN,SDASK,SDCOACT,SDDA,SDLNE,SDQUIET,APPTIENS,RESOURCE,ERRORS,DFN,APPTDATA,DFN,RESOURCE,CLINICIEN,CHKOUT
+6 SET APPTIEN=$GET(APPTIEN)
SET CHKOUTDT=$GET(CHKOUTDT)
+7 DO VALAPPTIEN^SDESVALUTIL(.ERRORS,APPTIEN)
+8 SET APPTIENS=APPTIEN_","
+9 DO GETS^DIQ(409.84,APPTIENS,".01;.05;.07;.12;.16","I","APPTDATA")
+10 IF $GET(APPTDATA(409.84,APPTIENS,.12,"I"))
DO ERRLOG^SDESJSON(.ERRORS,322)
+11 SET APPTDTTM=$GET(APPTDATA(409.84,APPTIENS,.01,"I"))
+12 SET DFN=$GET(APPTDATA(409.84,APPTIENS,.05,"I"))
+13 SET RESOURCE=$GET(APPTDATA(409.84,APPTIENS,.07,"I"))
+14 SET VPRV=$GET(APPTDATA(409.84,APPTIENS,.16,"I"))
+15 SET CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+16 SET CHKOUTDT=$$VALCHKOUTDT(.ERRORS,CHKOUTDT,CLINICIEN)
+17 IF $DATA(ERRORS)
SET ERRORS("CheckOut",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS)
QUIT
+18 ;
+19 SET SDDA=0
+20 SET SDASK=0
+21 SET SDCOACT="CO"
+22 SET SDLNE=""
+23 SET SDQUIET=1
+24 ; Event driver "BEFORE" actions - from SD*5.3*717 10/25/18
+25 ;
NEW SDATA,SDDA,SDCIHDL
+26 SET SDDA=$$FIND(DFN,APPTDTTM,CLINICIEN)
+27 IF 'SDDA
Begin DoDot:1
+28 DO ERRLOG^SDESJSON(.ERRORS,317)
+29 SET ERRORS("CheckOut",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS)
End DoDot:1
QUIT
+30 IF '$$GET1^DIQ(44.003,SDDA_","_APPTDTTM_","_CLINICIEN_",",309,"I")
Begin DoDot:1
+31 DO ERRLOG^SDESJSON(.ERRORS,318)
+32 SET ERRORS("CheckOut",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS)
End DoDot:1
QUIT
+33 ;
+34 SET SDATA=SDDA_U_DFN_U_APPTDTTM_U_CLINICIEN
+35 ;
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+36 ; Event driver "BEFORE"
+37 ;
DO BEFORE^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
+38 ; Appointment checkout
+39 DO CHKOUT(DFN,APPTDTTM,CLINICIEN,SDDA,SDASK,CHKOUTDT,SDCOACT,SDLNE,APPTIEN,SDQUIET,VPRV,.ERRORS)
+40 ; Skip event driver actions if err occurred checking appointment out. - wtc SD*5.3*717 10/25/2018
+41 IF $DATA(ERRORS)
SET ERRORS("CheckOut",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDECY,.ERRORS)
QUIT
+42 ; Event driver "AFTER"
+43 ;
DO AFTER^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
+44 ; Execute event driver. 5=check out (see #409.66), 2=non-interactive
+45 ;
DO EVT^SDAMEVT(.SDATA,5,2,SDCIHDL)
+46 SET CHKOUT("CheckOut",1)="Checked Out."
DO BUILDJSON^SDESBUILDJSON(.SDECY,.CHKOUT)
+47 QUIT
VALCHKOUTDT(ERRORS,CHKOUTDT,CLINIC) ;
+1 NEW CHKOUTDTFM,CHKIN
+2 SET CHKIN=$$GET1^DIQ(409.84,APPTIEN,.03,"I")
+3 SET CHKOUTDTFM=""
+4 IF CHKOUTDT=""
DO ERRLOG^SDESJSON(.ERRORS,23)
QUIT CHKOUTDTFM
+5 SET CHKOUTDTFM=$$ISOTFM^SDAMUTDT(CHKOUTDT,CLINIC)
+6 IF CHKOUTDTFM<0
DO ERRLOG^SDESJSON(.ERRORS,24)
QUIT CHKOUTDTFM
+7 IF $PIECE(CHKOUTDTFM,".",2)=""
DO ERRLOG^SDESJSON(.ERRORS,321)
QUIT CHKOUTDTFM
+8 ; checkout time cannot be in the future
+9 IF CHKOUTDTFM>$$NOW^XLFDT
DO ERRLOG^SDESJSON(.ERRORS,320)
QUIT CHKOUTDTFM
+10 ; checkout time is after checkin time
+11 IF CHKOUTDTFM'>CHKIN
DO ERRLOG^SDESJSON(.ERRORS,52,"Check Out time must be at least 1 minute after the Check In time of "_$TRANSLATE($$FMTE^XLFDT(CHKIN),"@"," ")_".")
+12 QUIT CHKOUTDTFM
+13 ;
FIND(DFN,APPTDTTM,CLINICIEN) ; -- return appt ifn for pat
+1 ; input: DFN := ifn of pat.
+2 ; APPTDTTM := appt d/t
+3 ; CLINICIEN := ifn of clinic
+4 ; output: [returned] := ifn if pat has appt on date/time
+5 ;
+6 NEW Y,FOUND,RET
+7 SET RET=""
+8 SET (Y,FOUND)=0
+9 FOR
SET Y=$ORDER(^SC(CLINICIEN,"S",APPTDTTM,1,Y))
if 'Y!(FOUND)
QUIT
Begin DoDot:1
+10 IF '$DATA(^SC(CLINICIEN,"S",APPTDTTM,1,Y,0))
QUIT
+11 IF DFN'=$$GET1^DIQ(44.003,Y_","_APPTDTTM_","_CLINICIEN_",",.01,"I")
QUIT
+12 IF $DATA(^DPT(DFN,"S",APPTDTTM,0))
IF $$VALID(DFN,CLINICIEN,APPTDTTM,Y)
SET FOUND=1
SET RET=Y
QUIT
End DoDot:1
+13 QUIT RET
+14 ;
VALID(DFN,CLINICIEN,APPTDTTM,SDDA) ;
+1 ; input: DFN := ifn of pat.
+2 ; APPTDTTM := appt d/t
+3 ; CLINICIEN := ifn of clinic
+4 ; SDDA := ifn of appt
+5 ; output: [returned] := 1 for valid appt., 0 for not valid
+6 NEW APPTCAN44,APPTCAN2
+7 SET APPTCAN44=$$GET1^DIQ(44.003,SDDA_","_APPTDTTM_","_CLINICIEN_",",310,"I")
+8 SET APPTCAN2=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")
+9 QUIT $SELECT(APPTCAN44'="C":1,APPTCAN2["C":1,1:0)
+10 ;
+11 ; from CO^SDEC25A
CHKOUT(DFN,APPTDTTM,CLINICIEN,SDDA,SDASK,CHKOUTDT,SDCOACT,SDLNE,SDECAPTID,SDQUIET,VPRV,ERRORS) ;Appt Check Out
+1 ; Input -- DFN Patient file IEN
+2 ; APPTDTTM Appointment Date/Time
+3 ; CLINICIEN Hospital Location file IEN for Appt
+4 ; SDDA IEN in ^SC multiple or null [Optional]
+5 ; SDASK Ask Check Out Date/Time [Optional]
+6 ; CHKOUTDT Date/Time of Check Out [Optional]
+7 ; SDCOACT Appt Mgmt Check Out Action [Optional]
+8 ; SDLNE Appt Mgmt Line Number [Optional]
+9 ; Input -- SDECAPTID Appointment ID
+10 ; SDQUIET No Terminal output 0=allow display 1=do not allow
+11 ; VPRV V Provider IEN - pointer to V PROVIDER file
+12 ; ERRORS Returned Array of errors
+13 ;
+14 NEW SDCOQUIT,SDOE,SDATA
+15 SET SDATA=$GET(^DPT(DFN,"S",APPTDTTM,0))
+16 ;-- if new encounter, pass to PCE
+17 IF $$NEW(APPTDTTM)
Begin DoDot:1
+18 NEW SDCOED
+19 ;ANU - Add ERRORS
+20 SET SDOE=$$GETAPT(DFN,APPTDTTM,CLINICIEN,.ERRORS)
+21 IF $DATA(ERRORS)
QUIT
+22 ;
+23 SET SDCOED=$$CHK($TRANSLATE($$STATUS(DFN,APPTDTTM,CLINICIEN,SDATA,SDDA),";","^"))
+24 ; -- appt has already been checked out
+25 IF $$CODT(DFN,APPTDTTM,CLINICIEN,SDDA)!(SDCOED)
Begin DoDot:2
+26 DO ERRLOG^SDESJSON(.ERRORS,319)
End DoDot:2
QUIT
+27 DO CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,.ERRORS)
End DoDot:1
QUIT
+28 QUIT
CODT(DFN,SDT,SDCL,SDDA) ; -- does appt have co date
+1 QUIT $$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",303,"I")
+2 ;
NEW(DATE) ;-- return 1 if SD is turned on for
+1 ; Visit Tracking and optionally check if the date is past
+2 ; the cut over date for the new PCE interface.
+3 ; INPUT : DATE (Optional) Date to check for cut over.
+4 ; OUTPUT: 1 Yes, 0 No
+5 NEW SDRES,SDX,SDY
+6 IF '$GET(DATE)
SET DATE=DT
+7 ;-- is Scheduling on ?
+8 SET SDRES=0
SET SDY=$$PKGON^VSIT("SD")
+9 ;-- if date is it pass cut over?
+10 SET SDX=1
IF $GET(DATE)
SET SDX=$$SWITCHCK^PXAPI(DATE)
+11 ;-- And together
+12 IF SDX
IF SDY
SET SDRES=1
+13 QUIT SDRES
+14 ;
GETAPT(DFN,SDT,SDCL,SDVIEN,ERRORS) ;
+1 ; ANU - Added ERRORS
+2 ; This utility will return the existing IEN for an Outpatient
+3 ; Encounter. If it fails to find an existing encounter,
+4 ; it will create a new Encounter and return the new IEN.
+5 ;
+6 ; Input -- DFN Patient file IEN
+7 ; SDT Appointment Date/Time
+8 ; SDCL Hospital Location file IEN for Appt
+9 ; SDVIEN Visit file pointer [optional]
+10 ; Output -- Outpatient Encounter file IEN
+11 NEW Y
+12 SET Y=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
+13 IF 'Y
DO APPT(DFN,SDT,SDCL,$GET(SDVIEN),.ERRORS)
+14 IF $DATA(ERRORS)
QUIT +$GET(Y)
+15 IF '$DATA(ERRORS)
SET Y=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
+16 ;
+17 IF Y
DO VIEN(Y,$GET(SDVIEN))
+18 QUIT +$GET(Y)
+19 ;
+20 ; FROM APPT^SDVSIT
APPT(DFN,SDT,SDCL,SDVIEN,ERRORS) ; -- process appt
+1 ; input DFN = ien of patient file entry
+2 ; SDT = visit date internal format
+3 ; SDCL = ien of hospital location file entry
+4 ; SDVIEN = Visit file pointer [optional]
+5 ;
+6 NEW SDVSIT,SDOE,DA,DIE,DR,SDPT,SDSC,SDCL0,SDDA,SDLOCK,SDLCKS
+7 ;
+8 ; -- set lock data and lock
+9 SET SDLOCK("DFN")=DFN
+10 SET SDLOCK("EVENT DATE/TIME")=SDT
+11 ;ANU
+12 ;D LOCK(.SDLOCK)
+13 IF '$$LOCK(.SDLOCK)
DO ERRLOG^SDESJSON(.ERRORS,174)
QUIT
+14 ;
+15 ; -- set node vars
+16 SET SDPT=$GET(^DPT(DFN,"S",SDT,0))
+17 SET SDCL0=$GET(^SC(SDCL,0))
SET SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
+18 SET SDSC=$GET(^SC(SDCL,"S",SDT,1,SDDA,0))
+19 SET SDVSIT("CLN")=$PIECE(SDCL0,U,7)
SET SDVSIT("DIV")=$$DIV($PIECE(SDCL0,U,15))
+20 ;
+21 ; -- do checks
+22 IF 'SDPT!('SDSC)!($PIECE(SDCL0,U,3)'="C")
DO UNLOCK(.SDLOCK)
QUIT
+23 IF SDCL
IF +SDPT'=SDCL
DO UNLOCK(.SDLOCK)
QUIT
+24 IF $PIECE(SDPT,U,20)
DO UNLOCK(.SDLOCK)
QUIT
+25 IF 'SDVSIT("CLN")!('SDVSIT("DIV"))
DO UNLOCK(.SDLOCK)
+26 ;
+27 ; -- set the rest
+28 SET SDVSIT("DFN")=DFN
SET SDVSIT("LOC")=SDCL
+29 if $PIECE(SDSC,U,10)
SET SDVSIT("ELG")=$PIECE(SDSC,U,10)
+30 if $PIECE(SDPT,U,16)
SET SDVSIT("TYP")=$PIECE(SDPT,U,16)
+31 ;
+32 ; -- call logic to add opt encounter(s)
+33 SET SDVSIT("ORG")=1
SET SDVSIT("REF")=SDDA
SET SDOE=$$SDOE(SDT,.SDVSIT,$GET(SDVIEN))
+34 IF SDOE
Begin DoDot:1
+35 ;869 - Convert ///
+36 ;N DA,DIE,DR
+37 ;S DA=SDT,DA(1)=DFN,DR="21////"_SDOE,DIE="^DPT("_DFN_",""S""," D ^DIE
+38 NEW FDAIENS,ERR298,FDA298
+39 SET FDAIENS=SDT_","_DFN_","
+40 SET FDA298(2.98,FDAIENS,21)=SDOE
+41 DO FILE^DIE(,"FDA298","ERR298")
+42 ;
End DoDot:1
+43 ;Process credit stop if applicable
DO CSTOP(SDOE,SDCL,.SDVSIT,SDT)
+44 DO UNLOCK(.SDLOCK)
+45 QUIT
+46 ; FROM LOCK^SDVSIT
+47 ; Anu - function to return lock error
+48 ; Status = 1 if success, 0 if fail
LOCK(SDLOCK) ; -- lock "ADFN" node
+1 NEW SDC
+2 ;F L +^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME"))):$G(DILOCKTM,3) Q:$T ;LLS - 05-JAN-15 - SD*5.3*630 added timeout on lock
+3 FOR SDC=1:1:5
LOCK +^SCE("ADFN",+$GET(SDLOCK("DFN")),+$GET(SDLOCK("EVENT DATE/TIME"))):$GET(DILOCKTM,3)
if $TEST
QUIT
+4 IF $TEST
QUIT 1
+5 QUIT 0
+6 ; FROM UNLOCK^SDVSIT
UNLOCK(SDLOCK) ; -- unlock "ADFN" node
+1 LOCK -^SCE("ADFN",+$GET(SDLOCK("DFN")),+$GET(SDLOCK("EVENT DATE/TIME")))
+2 QUIT
+3 ; FROM SDOE^SDVSIT
SDOE(SDT,SDVSIT,SDVIEN,SDOEP) ; -- get visit & encounter
+1 ;LLS 22-DEC-2014 - SD*5.3*630 - added
NEW SDTR,SDI
+2 ;LLS 22-DEC-2014 - SD*5.3*630 - added
SET SDTR=9999999-$PIECE(SDT,".")
+3 ;LLS 22-DEC-2014 - SD*5.3*630 - added
IF SDT["."
SET SDTR=SDTR_"."_$PIECE(SDT,".",2)
+4 ;LLS 22-DEC-2014 - SD*5.3*630 - added the following section
IF '$DATA(SDVSIT("PAR"))
IF $GET(SDVIEN)=""
Begin DoDot:1
+5 NEW SDVISARR,SDVIEN1
+6 SET SDVIEN1=""
FOR
SET SDVIEN1=$ORDER(^AUPNVSIT("AA",DFN,SDTR,SDVIEN1))
if SDVIEN1=""
QUIT
Begin DoDot:2
+7 ; COMPARE VISIT: SERVICE CATEGORY, POINTER TO CLINIC STOP FILE, POINTER TO #44
+8 ; FILE, & ENCOUNTER TYPE BEFORE SELECTING EXISTING VISIT INSTEAD OF CREATING A NEW ONE
+9 DO GETS^DIQ(9000010,SDVIEN1_",",".07;.08;.22;15003","I","SDVISARR")
+10 ;Q:SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$S($G(SDVSIT("SVC"))]"":SDVSIT("SVC"),$$INP^SDAM2(DFN,SDTR)="I":"I",1:"A")
+11 if SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$SELECT($GET(SDVSIT("SVC"))]""
QUIT
+12 if SDVISARR(9000010,SDVIEN1_",",.08,"I")'=$GET(SDVSIT("CLN"))
QUIT
+13 if SDVISARR(9000010,SDVIEN1_",",.22,"I")'=$GET(SDVSIT("LOC"))
QUIT
+14 if SDVISARR(9000010,SDVIEN1_",",15003,"I")'="P"
QUIT
+15 SET SDVIEN=SDVIEN1
End DoDot:2
if $GET(SDVIEN)]""
QUIT
End DoDot:1
+16 SET SDVSIT("VST")=$GET(SDVIEN)
+17 ; bwf - SD*826 - leaving calls to SDVSIT0 - consider bringing into SDES* namespace in the future
+18 IF 'SDVSIT("VST")
DO VISIT^SDVSIT0(SDT,.SDVSIT)
+19 QUIT $$NEW^SDVSIT0(SDT,.SDVSIT)
+20 ;
INP(DFN,VDATE) ; -- determine inpatient status ; dom is not an inpatient appt
+1 NEW SDINP,VAINDT,VADMVT,WARDLOC
+2 SET SDINP=""
SET VAINDT=VDATE
DO ADM^VADPT2
IF 'VADMVT
QUIT SDINP
+3 SET WARDLOC=$$GET1^DIQ(405,VADMVT,.06,"I")
+4 IF $$GET1^DIQ(43,1,16,"I")
IF $$GET1^DIQ(42,WARDLOC,.03,"I")="D"
QUIT SDINP
+5 SET SDINP="I"
+6 QUIT SDINP
+7 ;
DIV(DIV) ; -- determine med div
+1 ; multi-div
+2 IF $$GET1^DIQ(43,1,11,"I")
IF $DATA(^DG(40.8,+DIV,0))
QUIT DIV
+3 SET DIV=+$ORDER(^DG(40.8,0))
+4 QUIT DIV
+5 ;
+6 ; FROM CSTOP^SDVSIT
CSTOP(SDOE,SDCL,SDVSIT,SDT) ;Process credit stop
+1 ;Input: SDOE=encounter ien
+2 ;Input: SDCL0=zeroeth node of HOSPITAL LOCATION file record
+3 ;Input: SDVSIT=visit data array (pass by reference)
+4 ;Input: SDT=encounter date/time
+5 ; -- does clinic have a credit stop code?
+6 ; -- process only if non non-count and not equal to credit
+7 ;
+8 NEW CREDSCODE,NONCOUNT,CLINSTOPCODE,CSTOPINACTDT,IENS,CLINDAT
+9 SET IENS=SDCL_","
+10 DO GETS^DIQ(44,IENS,"8;2502;2503","I","CLINDAT","ERR")
+11 SET CREDSCODE=$GET(CLINDAT(44,IENS,2503,"I"))
+12 SET NONCOUNT=$GET(CLINDAT(44,IENS,2502,"I"))
+13 SET CLINSTOPCODE=$GET(CLINDAT(44,IENS,8,"I"))
+14 SET CSTOPINACTDT=$$GET1^DIQ(40.7,CLINSTOPCODE,2,"I")
+15 IF SDOE
IF CREDSCODE
IF (CREDSCODE'=SDVSIT("CLN"))
IF NONCOUNT'="Y"
Begin DoDot:1
+16 NEW X,SDVIENSV,SDVIENOR
+17 ; -- is stop code active?
+18 IF $SELECT('CSTOPINACTDT:1,1:SDT<CSTOPINACTDT)
Begin DoDot:2
+19 SET SDVSIT("CLN")=CREDSCODE
+20 SET SDVIENOR=$GET(SDVSIT("ORG"))
+21 SET SDVSIT("ORG")=4
+22 SET SDVSIT("PAR")=SDOE
+23 SET SDVIENSV=$GET(SDVSIT("VST"))
+24 KILL SDVSIT("VST")
+25 SET X=$$SDOE(SDT,.SDVSIT)
+26 IF X
DO LOGDATA(X)
+27 ; -- restore SDVSIT
+28 SET SDVSIT("CLN")=CLINSTOPCODE
+29 SET SDVSIT("ORG")=SDVIENOR
+30 SET SDVSIT("VST")=SDVIENSV
+31 KILL SDVSIT("PAR")
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 QUIT
LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data
+1 NEW DIE,DA,DR,Y,X
+2 SET SDLOG("USER")=$GET(DUZ)
+3 SET SDLOG("DATE/TIME")=$$NOW^XLFDT()
+4 SET DIE="^SCE("
SET DA=SDOE
SET DR="[SD ENCOUNTER LOG]"
DO ^DIE
+5 QUIT
+6 ;
VIEN(SDOE,SDVIEN) ; -- stuff in Visit IEN if not already set
+1 ; -- needed for those sites that don't have
+2 ; scheduling turned on in Visit Tracking
+3 ; Required input SDOE = Outpatient Encounter pointer
+4 ; SDVIEN = Visit file pointer or null or zero
+5 ;
+6 ; -- quit if no vien passed
+7 if 'SDVIEN
QUIT
+8 ; -- quit is no encounter
+9 if '$DATA(^SCE(+SDOE,0))
QUIT
+10 ; -- set visit ien if vien not already set
+11 IF '$$GET1^DIQ(409.68,+SDOE,.05,"I")
Begin DoDot:1
+12 ;869 - Convert ////
+13 ;S DIE="^SCE(",DA=SDOE,DR=".05////"_SDVIEN D ^DIE
+14 NEW FDA40968,ERR40968
+15 SET FDA40968(409.68,SDOE_",",.05)=SDVIEN
+16 DO FILE^DIE(,"FDA40968","ERR40968")
KILL FDA40968
+17 ;
End DoDot:1
+18 IF '$$GET1^DIQ(409.68,+SDOE,.04,"I")
Begin DoDot:1
+19 ;869 - Converting ////
+20 NEW SDLOC,FDA40968,ERR40968
+21 SET SDLOC=$$GET1^DIQ(9000010,SDVIEN,.22,"I")
+22 ;I SDLOC S DIE="^SCE(",DA=SDOE,DR=".04////"_SDLOC D ^DIE
+23 IF SDLOC
Begin DoDot:2
+24 SET FDA40968(409.68,SDOE_",",.04)=SDLOC
+25 DO FILE^DIE(,"FDA40968","ERR40968")
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
+28 ;CO^SDEC25B
CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,ERRORS) ;EP; called to ask check-out date/time ;SAT ADDED PARAMETERS CHKOUTDT, SDECAPTID, & SDQUIET
+1 ; Called by SDCO1
+2 ; SDOE = Outpatient Encounter IEN
+3 ; DFN = Patient IEN
+4 ; APPTDTTM = Appt Date/Time
+5 ; CLINICIEN = Clinic IEN
+6 ; CHKOUTDT = APPT CHECKOUT TIME [OPTIONAL - USED WHEN SDQUIET=1] USER ENTERED FORMAT
+7 ; SDECAPTID = APPT ID - POINTER TO ^SDECAPPT
+8 ; SDQUIET = ALLOW NO TERMINAL INPUT/OUTPUT 0=ALLOW; 1=DO NOT ALLOW
+9 ; VPRV = V Provider IEN - pointer to V PROVIDER file
+10 ; ERRORS = Returned Array of errors
+11 ;
+12 NEW DIE,DA,DR,SDECNOD,SDN,SDV,AUPNVSIT,PROVIEN40984,PSTAT
+13 ;
+14 ; 869 - Convert ///
+15 ;S DR="303///"_CHKOUTDT_";304///`"_DUZ_";306///"_$$NOW^XLFDT
+16 ;D ^DIE
+17 ;S DIE="^SC("_CLINICIEN_",""S"","_APPTDTTM_",1,"
+18 ;S DA(2)=CLINICIEN,DA(1)=APPTDTTM
+19 NEW IENS44,ERR44003,FDA
+20 SET (DA,SDN)=$$SCIEN(DFN,CLINICIEN,APPTDTTM)
+21 SET IENS44=$$GET44RECORDIENS^SDESCANCELAPPTS(CLINICIEN,APPTDTTM,DFN)
+22 SET FDA(44.003,IENS44,303)=CHKOUTDT
+23 SET FDA(44.003,IENS44,304)=DUZ
+24 SET FDA(44.003,IENS44,306)=$$NOW^XLFDT
+25 DO FILE^DIE(,"FDA","ERR44003")
KILL ERR44003
+26 ;
+27 ; if checked out and status not updated, do it now
+28 IF $$GET1^DIQ(44.003,DA_","_APPTDTTM_","_CLINICIEN_",",303,"I")]""
Begin DoDot:1
+29 ;UPDATE APPT SCHEDULE GLOBAL ^SDEC(409.84
+30 IF $GET(SDECAPTID)
Begin DoDot:2
+31 SET PSTAT=$$GET1^DIQ(409.68,SDOE,.12,"I")
+32 ;869 - Convert ///
+33 ;S DA=SDECAPTID
+34 ;S DR=".14///"_$G(CHKOUTDT)_";.19///"_PSTAT
+35 ;D ^DIE
+36 NEW FDA40984,ERR40984
+37 SET FDA40984(409.84,SDECAPTID_",",.14)=$GET(CHKOUTDT)
+38 SET FDA40984(409.84,SDECAPTID_",",.19)=$GET(PSTAT)
+39 DO FILE^DIE(,"FDA40984","ERR40984")
+40 ;
+41 ;possibly update VProvider
+42 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+43 SET PROVIEN40984=$$GET1^DIQ(409.84,SDECAPTID,.15,"I")
+44 IF $GET(VPRV)
IF PROVIEN40984
Begin DoDot:3
+45 ;get SDEC appt schedule
+46 ;869 - Convert ///
+47 ;S DA=PROVIEN40984 ;S DR=".01///"_VPRV
+48 ;D ^DIE
+49 NEW FDA91006,ERR91006
+50 SET FDA91006(9000010.06,PROVIEN40984_",",.01)=VPRV
+51 DO FILE^DIE(,"FDA91006","ERR91006")
KILL FDA91006
End DoDot:3
End DoDot:2
+52 ;
+53 if $$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"
QUIT
+54 ;869 - Convert ///
+55 ;S DIE=409.68,DA=SDOE,DR=".12///14;101///"_DUZ_";102///"_$$NOW^XLFDT
+56 ;D ^DIE
+57 NEW FDA40968,ERR40968
+58 SET FDA40968(409.68,SDOE_",",.12)=14
+59 SET FDA40968(409.68,SDOE_",",101)=DUZ
+60 SET FDA40968(409.68,SDOE_",",102)=$$NOW^XLFDT
+61 DO FILE^DIE(,"FDA40968","ERR40968")
+62 ;
+63 ; if visit pointer stored, update visit checkout date/time
+64 SET SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
if 'SDV
QUIT
+65 if '$DATA(^AUPNVSIT(SDV,0))
QUIT
if $$GET1^DIQ(9000010,SDV,.05,"I")'=DFN
QUIT
+66 ;deleted
if $$GET1^DIQ(9000010,SDV,.11,"I")=1
QUIT
+67 ;cmi/maw 5/1/2009 PATCH 1010 RQMT 34
+68 ;869 - Convert ///
+69 ;S DIE="^AUPNVSIT(",DA=SDV
+70 ;S DR=".18///"_$$GET1^DIQ(44.003,SDN_","_APPTDTTM_","_CLINICIEN_",",303,"I")
+71 ;D ^DIE
+72 NEW FDA9000010,ERR9000010
+73 SET FDA9000010(9000010,SDV_",",.18)=$$GET1^DIQ(44.003,SDN_","_APPTDTTM_","_CLINICIEN_",",303,"I")
+74 DO FILE^DIE(,"FDA9000010","ERR9000010")
KILL FDA9000010
+75 ;
End DoDot:1
+76 QUIT
+77 ;
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
+1 NEW X,IEN
+2 SET X=0
FOR
SET X=$ORDER(^SC(CLINIC,"S",DATE,1,X))
if 'X
QUIT
if $GET(IEN)
QUIT
Begin DoDot:1
+3 ;cancelled
if $PIECE($GET(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C"
QUIT
+4 IF +$GET(^SC(CLINIC,"S",DATE,1,X,0))=PAT
SET IEN=X
End DoDot:1
+5 QUIT $GET(IEN)
+6 ;
+7 ;
CHK(SDSTB) ; -- is appointment checked out
+1 NEW Y
+2 IF "^2^8^12^"[("^"_+SDSTB_"^")
IF $PIECE(SDSTB,"^",3)["CHECKED OUT"
SET Y=1
+3 QUIT +$GET(Y)
+4 ;
STATUS(DFN,SDT,SDCL,SDATA,SDDA) ; -- return appt status
+1 ; input: DFN := ifn of pat.
+2 ; SDT := appt d/t
+3 ; SDCL := ifn of clinic
+4 ; SDATA := 0th node of pat appt entry
+5 ; SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
+6 ; output: [returned] := appt status ifn ^ status name ^ print status ^
+7 ; check in d/t ^ check out d/t ^ adm mvt ifn
+8 ;
+9 ;S = status ; C = ci/co indicator ; Y = 'C' node ; P = print status
+10 NEW S,C,Y,P,VADMVT,VAINDT,STATUS,SDSCE,SDIEN,CHKINDT,CHKOUTDT
+11 ;
+12 ; -- get data for evaluation
+13 if '$GET(SDDA)
SET SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
+14 SET CHKINDT=$$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",309,"I")
+15 SET CHKOUTDT=$$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",303,"I")
+16 ;retrieve CHECK OUT from OUTPATIENT ENCOUNTER file if not in Hospital Location file/PURGED or edited
+17 SET SDSCE=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
+18 ;pointer to OE
IF SDSCE
Begin DoDot:1
+19 IF CHKOUTDT=""
SET CHKOUTDT=$$GET1^DIQ(409.68,SDSCE,.07,"I")
+20 SET SDIEN=SDSCE_","
SET STATUS=$$GET1^DIQ(409.68,SDIEN,.12)
End DoDot:1
+21 ;
+22 ; -- set initial status value ; non-count clinic?
+23 SET S=$SELECT($PIECE(SDATA,"^",2)]"":$PIECE($PIECE($PIECE(^DD(2.98,3,0),"^",3),$PIECE(SDATA,"^",2)_":",2),";"),$PIECE($GET(^SC(SDCL,0)),U,17)="Y":"NON-COUNT",1:"")
+24 IF SDSCE&(S="NO ACTION TAKEN")
SET S=""
+25 ;
+26 ; -- inpatient?
+27 SET VAINDT=SDT
DO ADM^VADPT2
+28 IF S["INPATIENT"
IF $SELECT('VADMVT:1,'$PIECE(^DG(43,1,0),U,21):0,1:$PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(VADMVT,0)),U,6),0)),U,3)="D")
SET S=""
+29 ;
+30 ; -- determine ci/co indicator
+31 SET C=$SELECT(CHKOUTDT:"CHECKED OUT",CHKINDT:"CHECKED IN",S]"":"",SDT>(DT+.2359):"FUTURE",1:"NO ACTION TAKEN")
if S=""
SET S=C
+32 ;
+33 IF S="NO ACTION TAKEN"
IF $PIECE(SDT,".")=DT
IF C'["CHECKED"
SET C="TODAY"
+34 ; -- $$REQ & $$COCMP in SDM1A not used for speed
+35 IF S="CHECKED OUT"!(S="CHECKED IN")
IF SDT'<$PIECE(^DG(43,1,"SCLR"),U,23)
IF '$PIECE(SDATA,U,20)
SET S="NO ACTION TAKEN"
+36 ;
+37 ; -- determine print status
+38 SET P=$SELECT(S=C!(C=""):S,1:"")
+39 IF P=""
Begin DoDot:1
+40 IF S["INPATIENT"
IF $PIECE($GET(^SC(SDCL,0)),U,17)'="Y"
IF $PIECE($GET(^SCE(+$PIECE(SDATA,U,20),0)),U,7)=""
SET P=$PIECE(S," ")_"/ACT REQ"
QUIT
+41 IF S="NO ACTION TAKEN"
IF C="CHECKED OUT"!(C="CHECKED IN")
SET P="ACT REQ/"_C
Begin DoDot:2
+42 IF SDSCE
IF $PIECE($GET(^SCE(SDSCE,0)),U,7)
SET P="CHECKED OUT"
End DoDot:2
QUIT
+43 SET P=$SELECT(S="NO ACTION TAKEN":S,1:$PIECE(S," "))_"/"_C
End DoDot:1
+44 IF S["INPATIENT"
IF C=""
Begin DoDot:1
+45 IF SDT>(DT+.2359)
SET P=$PIECE(S," ")_"/FUTURE"
QUIT
+46 SET P=$PIECE(S," ")_"/NO ACT TAKN"
End DoDot:1
+47 IF S["INPATIENT"
QUIT +$ORDER(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_CHKINDT_";"_CHKOUTDT_";"_+VADMVT
+48 IF S["NO-SHOW"
QUIT +$ORDER(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_CHKINDT_";"_CHKOUTDT_";"_+VADMVT
+49 IF $GET(SDSCE)
IF $DATA(^SCE(SDSCE,0))
Begin DoDot:1
+50 IF $GET(STATUS)="NON-COUNT"
Begin DoDot:2
+51 IF CHKOUTDT
SET P="NON-COUNT/CHECKED OUT"
QUIT
+52 IF CHKINDT
SET P="NON-COUNT/CHECKED IN"
End DoDot:2
QUIT
+53 IF $GET(STATUS)="CHECKED OUT"
SET P="CHECKED OUT"
QUIT
+54 IF CHKOUTDT
SET P="ACT REQ/CHECKED OUT"
Begin DoDot:2
+55 IF $GET(STATUS)="ACTION REQUIRED"
SET S="NO ACTION TAKEN"
QUIT
+56 IF $GET(STATUS)=""
IF $PIECE($GET(^SCE(SDSCE,0)),U,7)
SET P="CHECKED OUT"
End DoDot:2
QUIT
+57 IF CHKINDT
SET P="ACT REQ/CHECKED IN"
Begin DoDot:2
+58 IF $GET(STATUS)="ACTION REQUIRED"
SET S="NO ACTION TAKEN"
End DoDot:2
End DoDot:1
+59 QUIT +$ORDER(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_CHKINDT_";"_CHKOUTDT_";"_+VADMVT
