SDES2SETCHECKOUT ;ALB/JAS,LAB,ANU - SDES2 SET APPT CHECKOUT DATE/TIME ; MAY 20,2024
;;5.3;Scheduling;**867,877,880**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
; Documented API's and Integration Agreements:
;
; 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
; Reference to DUZ^XUP is supported by IA #4129
;
; RPC: SDES2 SET APPT CHECKOUT
;
; SDCONTEXT("ACHERON AUDIT ID") = 36 character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action on the calling application.
; SDCONTEXT("USER SECID") = The name of the user taking action on the calling application.
; SDCONTEXT("PATIENT DFN") = The DFN of the Veteran/user taking action on the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the Veteran/user taking action on the calling application.
;
; PARAMS("APPT IEN") = IEN of SDEC APPOINTMENT (#409.84) file record to be Checked Out (required)
; PARAMS("CHECKOUT DATE") = Checkout date/time in ISO format (required)
;
SETCHECKOUT(JSONRETURN,SDCONTEXT,PARAMS) ; Set Checkout Date/Time for Appointment
;
N APPTDATA,APPTIENS,CKOUTUSER,CLINICIEN,RESOURCE,SDASK,SDCOACT,SDDA,DFN,SDERRORS,SDLNE,SDQUIET,SDRETURN
;
; Validate SDCONTEXT
;
D VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Checkout",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
S CKOUTUSER=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
; Validate APPT IEN
;
S APPTIEN=$G(PARAMS("APPT IEN"))
S APPTIENS=$$VALAPPTIEN(APPTIEN,.SDERRORS)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Checkout",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
; Get APPT data
;
D GETS^DIQ(409.84,APPTIENS,".01;.03;.05;.07;.12;.16","I","APPTDATA")
I $G(APPTDATA(409.84,APPTIENS,.12,"I")) D Q
. D ERRLOG^SDES2JSON(.SDERRORS,322) M SDRETURN=SDERRORS S SDRETURN("Checkout",1)=""
. D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
;
S APPTDTTM=$G(APPTDATA(409.84,APPTIENS,.01,"I"))
S CHKIN=$G(APPTDATA(409.84,APPTIENS,.03,"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")
;
; Validate Checkout Date/Time
;
S CHKOUTDT=$G(PARAMS("CHECKOUT DATE"))
S CHKOUTDT=$$VALCHCKOUT(CHKOUTDT,CHKIN,CLINICIEN,.SDERRORS)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Checkout",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
S SDDA=0,SDASK=0,SDCOACT="CO",SDLNE="",SDQUIET=1
;
; Event driver "BEFORE" actions
;
N SDATA,SDDA,SDCIHDL ;
S SDDA=$$FIND(DFN,APPTDTTM,CLINICIEN)
I 'SDDA D Q
. D ERRLOG^SDES2JSON(.SDERRORS,317) M SDRETURN=SDERRORS S SDRETURN("Checkout",1)=""
. D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
I '$$GET1^DIQ(44.003,SDDA_","_APPTDTTM_","_CLINICIEN_",",309,"I") D Q
. D ERRLOG^SDES2JSON(.SDERRORS,318) M SDRETURN=SDERRORS S SDRETURN("Checkout",1)=""
. D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
;
S SDATA=SDDA_U_DFN_U_APPTDTTM_U_CLINICIEN
S SDCIHDL=$$HANDLE^SDAMEVT(1) ;
; Event driver "BEFORE" actions
D BEFORE^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL) ;
; Appointment checkout
D CHKOUT(DFN,APPTDTTM,CLINICIEN,SDDA,SDASK,CHKOUTDT,SDCOACT,SDLNE,APPTIEN,SDQUIET,VPRV,.SDERRORS)
; Skip event driver actions if error occurred checking appointment out.
I $D(SDERRORS) D Q
. M SDRETURN=SDERRORS S SDRETURN("Checkout",1)=""
. D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
; Event driver "AFTER" actions
D AFTER^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL) ;
; Execute event driver. 5=Checkout (see #409.66), 2=non-interactive
D EVT^SDAMEVT(.SDATA,5,2,SDCIHDL) ;
S SDRETURN("Checkout",1)="Checked Out."
D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
Q
;
VALAPPTIEN(APPTIEN,SDERRORS) ; Validate Appt IEN
;
N VALRET
D VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,APPTIEN,1,0,14,15)
Q APPTIEN_","
;
VALCHCKOUT(CHKOUTDT,CHKIN,CLINICIEN,SDERRORS) ; Validate and Process Checkout Date/Time
;
N CHKOUTDTFM S CHKOUTDTFM=""
S CHKOUTDTFM=$$VALISODTTM^SDES2VALISODTTM(.SDERRORS,CHKOUTDT,CLINICIEN,1,23,24)
I $D(SDERRORS) Q 0
; checkout time must be included
I $P(CHKOUTDTFM,".",2)="" D ERRLOG^SDES2JSON(.SDERRORS,321) Q 0
; checkout time cannot be in the future
I CHKOUTDTFM>$$NOW^XLFDT D ERRLOG^SDES2JSON(.SDERRORS,320) Q 0
; make sure checkout time is after checkin time
I CHKOUTDTFM'>CHKIN D ERRLOG^SDES2JSON(.SDERRORS,52,"Checkout time must be at least 1 minute after the Check-In time of "_$TR($$FMTE^XLFDT(CHKIN),"@"," ")_".") Q 0
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) ; return valid appt.
; 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,SDERRORS) ;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 Checkout Date/Time [Optional]
; CHKOUTDT Date/Time of Checkout [Optional]
; SDCOACT Appt Mgmt Checkout Action [Optional]
; SDLNE Appt Mgmt Line Number [Optional]
; SDECAPTID Appointment ID
; SDQUIET No Terminal output 0=allow display 1=do not allow
; VPRV V Provider IEN - pointer to V PROVIDER file
; SDERRORS 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
.S SDOE=$$GETAPT(DFN,APPTDTTM,CLINICIEN,.SDERRORS)
.I $D(SDERRORS) 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^SDES2JSON(.SDERRORS,319)
.D CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,.SDERRORS)
Q
CODT(DFN,SDT,SDCL,SDDA) ; does appt have co date
Q $$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",303,"I")
;
NEW(DATE) ; This function will 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,SDERRORS) ;Look-up Outpatient Encounter IEN for Appt
; 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),.SDERRORS)
I $D(SDERRORS) Q +$G(Y)
I '$D(SDERRORS) 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,SDERRORS) ; 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
I '$$LOCK(.SDLOCK) D ERRLOG^SDES2JSON(.SDERRORS,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
.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
; Return Status = 1 if success, 0 if fail
LOCK(SDLOCK) ; lock "ADFN" node
N SDC
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
S SDTR=9999999-$P(SDT,".")
I SDT["." S SDTR=SDTR_"."_$P(SDT,".",2)
I '$D(SDVSIT("PAR")),$G(SDVIEN)="" D
.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 HOSPITAL LOCATION
..; 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(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)
; consider bringing SDVSIT0 calls 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
; SDOE=encounter ien
; SDCL0=zeroeth node of HOSPITAL LOCATION file record
; SDVSIT=visit data array
; 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(CKOUTUSER) ; editing user
S SDLOG("DATE/TIME")=$$NOW^XLFDT() ; last edited
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
Q:'SDVIEN
; quit is no encounter
Q:'$D(^SCE(+SDOE,0))
; set visit ien if vien not already set
N SDFDA,SDERR
I '$$GET1^DIQ(409.68,+SDOE,.05,"I") D
.K SDFDA,SDERR
.S SDFDA(409.68,SDOE_",",.05)=SDVIEN
.D FILE^DIE("","SDFDA","SDERR")
I '$$GET1^DIQ(409.68,+SDOE,.04,"I") D
.N DIE,DA,DR,SDLOC
.S SDLOC=$$GET1^DIQ(9000010,SDVIEN,.22,"I")
.I SDLOC D
..K SDFDA,SDERR
..S SDFDA(409.68,SDOE_",",.04)=SDLOC
..D FILE^DIE("","SDFDA","SDERR")
Q
;
CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,SDERRORS) ;EP; called to ask check-out date/time
; SDOE = Outpatient Encounter IEN
; DFN = Patient IEN
; APPTDTTM = Appointment Date/Time
; CLINICIEN = Clinic IEN
; CHKOUTDT = APPOINTMENT CHECKOUT TIME [OPTIONAL - USED WHEN SDQUIET=1] USER ENTERED FORMAT
; SDECAPTID = APPOINTMENT 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
; SDERRORS = Returned Array of errors
;
N DIE,DA,DR,SDECNOD,SDN,SDV,AUPNVSIT,PROVIEN40984,PSTAT,SDFDA,SDERR,IENS44
K SDFDA,SDERR
S (DA,SDN)=$$SCIEN(DFN,CLINICIEN,APPTDTTM)
S IENS44=$$GET44RECORDIENS^SDESCANCELAPPTS(CLINICIEN,APPTDTTM,DFN)
S SDFDA(44.003,IENS44,303)=CHKOUTDT
S SDFDA(44.003,IENS44,304)=DUZ
S SDFDA(44.003,IENS44,306)=$$NOW^XLFDT
D FILE^DIE(,"SDFDA","SDERR")
;
; if checked out and status not updated
I $$GET1^DIQ(44.003,DA_","_APPTDTTM_","_CLINICIEN_",",303,"I")]"" D
.;UPDATE APPOINTMENT SCHEDULE GLOBAL ^SDEC(409.84
.I $G(SDECAPTID) D
..S PSTAT=$$GET1^DIQ(409.68,SDOE,.12,"I")
..K SDFDA,SDERR
..S SDFDA(409.84,SDECAPTID_",",.14)=$G(CHKOUTDT)
..S SDFDA(409.84,SDECAPTID_",",.19)=PSTAT
..D FILE^DIE("","SDFDA","SDERR")
..; 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 appointment schedule
...K SDFDA,SDERR
...S SDFDA(9000010.06,PROVIEN40984_",",.01)=VPRV
...D FILE^DIE("","SDFDA","SDERR")
.Q:$$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"
.K SDFDA,SDERR
.S SDFDA(409.68,SDOE_",",.12)=14
.S SDFDA(409.68,SDOE_",",.101)=CKOUTUSER
.S SDFDA(409.68,SDOE_",",.102)=$$NOW^XLFDT
.D FILE^DIE("","SDFDA","SDERR")
.; 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
.K SDFDA,SDERR
.S SDFDA(9000010,SDV_",",.18)=$$GET1^DIQ(44.003,SDN_","_APPTDTTM_","_CLINICIEN_",",303,"I")
.D FILE^DIE("","SDFDA","SDERR")
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 ^ checkout 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 Checkout 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[HSDES2SETCHECKOUT 19645 printed Nov 22, 2024@18:04:34 Page 2
SDES2SETCHECKOUT ;ALB/JAS,LAB,ANU - SDES2 SET APPT CHECKOUT DATE/TIME ; MAY 20,2024
+1 ;;5.3;Scheduling;**867,877,880**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; Documented API's and Integration Agreements:
+7 ;
+8 ; Reference to MAS PARAMETERS in ICR #483
+9 ; Reference to WARD LOCATION in ICR #1377
+10 ; Reference to MAS PARAMETERS in ICR #2296
+11 ; Reference to VISIT in ICR #2028
+12 ; Reference to DUZ^XUP is supported by IA #4129
+13 ;
+14 ; RPC: SDES2 SET APPT CHECKOUT
+15 ;
+16 ; SDCONTEXT("ACHERON AUDIT ID") = 36 character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+17 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action on the calling application.
+18 ; SDCONTEXT("USER SECID") = The name of the user taking action on the calling application.
+19 ; SDCONTEXT("PATIENT DFN") = The DFN of the Veteran/user taking action on the calling application.
+20 ; SDCONTEXT("PATIENT ICN") = The ICN of the Veteran/user taking action on the calling application.
+21 ;
+22 ; PARAMS("APPT IEN") = IEN of SDEC APPOINTMENT (#409.84) file record to be Checked Out (required)
+23 ; PARAMS("CHECKOUT DATE") = Checkout date/time in ISO format (required)
+24 ;
SETCHECKOUT(JSONRETURN,SDCONTEXT,PARAMS) ; Set Checkout Date/Time for Appointment
+1 ;
+2 NEW APPTDATA,APPTIENS,CKOUTUSER,CLINICIEN,RESOURCE,SDASK,SDCOACT,SDDA,DFN,SDERRORS,SDLNE,SDQUIET,SDRETURN
+3 ;
+4 ; Validate SDCONTEXT
+5 ;
+6 DO VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
+7 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Checkout",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+8 SET CKOUTUSER=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
+9 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+10 ;
+11 ; Validate APPT IEN
+12 ;
+13 SET APPTIEN=$GET(PARAMS("APPT IEN"))
+14 SET APPTIENS=$$VALAPPTIEN(APPTIEN,.SDERRORS)
+15 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Checkout",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+16 ;
+17 ; Get APPT data
+18 ;
+19 DO GETS^DIQ(409.84,APPTIENS,".01;.03;.05;.07;.12;.16","I","APPTDATA")
+20 IF $GET(APPTDATA(409.84,APPTIENS,.12,"I"))
Begin DoDot:1
+21 DO ERRLOG^SDES2JSON(.SDERRORS,322)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Checkout",1)=""
+22 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
End DoDot:1
QUIT
+23 ;
+24 SET APPTDTTM=$GET(APPTDATA(409.84,APPTIENS,.01,"I"))
+25 SET CHKIN=$GET(APPTDATA(409.84,APPTIENS,.03,"I"))
+26 SET DFN=$GET(APPTDATA(409.84,APPTIENS,.05,"I"))
+27 SET RESOURCE=$GET(APPTDATA(409.84,APPTIENS,.07,"I"))
+28 SET VPRV=$GET(APPTDATA(409.84,APPTIENS,.16,"I"))
+29 SET CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+30 ;
+31 ; Validate Checkout Date/Time
+32 ;
+33 SET CHKOUTDT=$GET(PARAMS("CHECKOUT DATE"))
+34 SET CHKOUTDT=$$VALCHCKOUT(CHKOUTDT,CHKIN,CLINICIEN,.SDERRORS)
+35 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Checkout",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+36 ;
+37 SET SDDA=0
SET SDASK=0
SET SDCOACT="CO"
SET SDLNE=""
SET SDQUIET=1
+38 ;
+39 ; Event driver "BEFORE" actions
+40 ;
+41 ;
NEW SDATA,SDDA,SDCIHDL
+42 SET SDDA=$$FIND(DFN,APPTDTTM,CLINICIEN)
+43 IF 'SDDA
Begin DoDot:1
+44 DO ERRLOG^SDES2JSON(.SDERRORS,317)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Checkout",1)=""
+45 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
End DoDot:1
QUIT
+46 IF '$$GET1^DIQ(44.003,SDDA_","_APPTDTTM_","_CLINICIEN_",",309,"I")
Begin DoDot:1
+47 DO ERRLOG^SDES2JSON(.SDERRORS,318)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Checkout",1)=""
+48 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
End DoDot:1
QUIT
+49 ;
+50 SET SDATA=SDDA_U_DFN_U_APPTDTTM_U_CLINICIEN
+51 ;
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+52 ; Event driver "BEFORE" actions
+53 ;
DO BEFORE^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
+54 ; Appointment checkout
+55 DO CHKOUT(DFN,APPTDTTM,CLINICIEN,SDDA,SDASK,CHKOUTDT,SDCOACT,SDLNE,APPTIEN,SDQUIET,VPRV,.SDERRORS)
+56 ; Skip event driver actions if error occurred checking appointment out.
+57 IF $DATA(SDERRORS)
Begin DoDot:1
+58 MERGE SDRETURN=SDERRORS
SET SDRETURN("Checkout",1)=""
+59 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
End DoDot:1
QUIT
+60 ; Event driver "AFTER" actions
+61 ;
DO AFTER^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
+62 ; Execute event driver. 5=Checkout (see #409.66), 2=non-interactive
+63 ;
DO EVT^SDAMEVT(.SDATA,5,2,SDCIHDL)
+64 SET SDRETURN("Checkout",1)="Checked Out."
+65 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
+66 QUIT
+67 ;
VALAPPTIEN(APPTIEN,SDERRORS) ; Validate Appt IEN
+1 ;
+2 NEW VALRET
+3 DO VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,APPTIEN,1,0,14,15)
+4 QUIT APPTIEN_","
+5 ;
VALCHCKOUT(CHKOUTDT,CHKIN,CLINICIEN,SDERRORS) ; Validate and Process Checkout Date/Time
+1 ;
+2 NEW CHKOUTDTFM
SET CHKOUTDTFM=""
+3 SET CHKOUTDTFM=$$VALISODTTM^SDES2VALISODTTM(.SDERRORS,CHKOUTDT,CLINICIEN,1,23,24)
+4 IF $DATA(SDERRORS)
QUIT 0
+5 ; checkout time must be included
+6 IF $PIECE(CHKOUTDTFM,".",2)=""
DO ERRLOG^SDES2JSON(.SDERRORS,321)
QUIT 0
+7 ; checkout time cannot be in the future
+8 IF CHKOUTDTFM>$$NOW^XLFDT
DO ERRLOG^SDES2JSON(.SDERRORS,320)
QUIT 0
+9 ; make sure checkout time is after checkin time
+10 IF CHKOUTDTFM'>CHKIN
DO ERRLOG^SDES2JSON(.SDERRORS,52,"Checkout time must be at least 1 minute after the Check-In time of "_$TRANSLATE($$FMTE^XLFDT(CHKIN),"@"," ")_".")
QUIT 0
+11 QUIT CHKOUTDTFM
+12 ;
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) ; return valid appt.
+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,SDERRORS) ;Appt Check Out
+1 ; Input
+2 ; DFN Patient file IEN
+3 ; APPTDTTM Appointment Date/Time
+4 ; CLINICIEN Hospital Location file IEN for Appt
+5 ; SDDA IEN in ^SC multiple or null [Optional]
+6 ; SDASK Ask Checkout Date/Time [Optional]
+7 ; CHKOUTDT Date/Time of Checkout [Optional]
+8 ; SDCOACT Appt Mgmt Checkout Action [Optional]
+9 ; SDLNE Appt Mgmt Line Number [Optional]
+10 ; SDECAPTID Appointment ID
+11 ; SDQUIET No Terminal output 0=allow display 1=do not allow
+12 ; VPRV V Provider IEN - pointer to V PROVIDER file
+13 ; SDERRORS Returned Array of errors
+14 ;
+15 NEW SDCOQUIT,SDOE,SDATA
+16 SET SDATA=$GET(^DPT(DFN,"S",APPTDTTM,0))
+17 ; if new encounter, pass to PCE
+18 IF $$NEW(APPTDTTM)
Begin DoDot:1
+19 NEW SDCOED
+20 SET SDOE=$$GETAPT(DFN,APPTDTTM,CLINICIEN,.SDERRORS)
+21 IF $DATA(SDERRORS)
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^SDES2JSON(.SDERRORS,319)
End DoDot:2
QUIT
+27 DO CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,.SDERRORS)
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) ; This function will 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,SDERRORS) ;Look-up Outpatient Encounter IEN for Appt
+1 ; This utility will return the existing IEN for an Outpatient
+2 ; Encounter. If it fails to find an existing encounter,
+3 ; it will create a new Encounter and return the new IEN.
+4 ;
+5 ; Input: DFN Patient file IEN
+6 ; SDT Appointment Date/Time
+7 ; SDCL Hospital Location file IEN for Appt
+8 ; SDVIEN Visit file pointer [optional]
+9 ; Output Outpatient Encounter file IEN
+10 NEW Y
+11 SET Y=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
+12 IF 'Y
DO APPT(DFN,SDT,SDCL,$GET(SDVIEN),.SDERRORS)
+13 IF $DATA(SDERRORS)
QUIT +$GET(Y)
+14 IF '$DATA(SDERRORS)
SET Y=$$GET1^DIQ(2.98,SDT_","_DFN_",",21,"I")
+15 ;
+16 IF Y
DO VIEN(Y,$GET(SDVIEN))
+17 QUIT +$GET(Y)
+18 ;
+19 ; FROM APPT^SDVSIT
APPT(DFN,SDT,SDCL,SDVIEN,SDERRORS) ; 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 IF '$$LOCK(.SDLOCK)
DO ERRLOG^SDES2JSON(.SDERRORS,174)
QUIT
+12 ;
+13 ; set node vars
+14 SET SDPT=$GET(^DPT(DFN,"S",SDT,0))
+15 SET SDCL0=$GET(^SC(SDCL,0))
SET SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
+16 SET SDSC=$GET(^SC(SDCL,"S",SDT,1,SDDA,0))
+17 SET SDVSIT("CLN")=$PIECE(SDCL0,U,7)
SET SDVSIT("DIV")=$$DIV($PIECE(SDCL0,U,15))
+18 ;
+19 ; do checks
+20 IF 'SDPT!('SDSC)!($PIECE(SDCL0,U,3)'="C")
DO UNLOCK(.SDLOCK)
QUIT
+21 IF SDCL
IF +SDPT'=SDCL
DO UNLOCK(.SDLOCK)
QUIT
+22 IF $PIECE(SDPT,U,20)
DO UNLOCK(.SDLOCK)
QUIT
+23 IF 'SDVSIT("CLN")!('SDVSIT("DIV"))
DO UNLOCK(.SDLOCK)
+24 ;
+25 ; set the rest
+26 SET SDVSIT("DFN")=DFN
SET SDVSIT("LOC")=SDCL
+27 if $PIECE(SDSC,U,10)
SET SDVSIT("ELG")=$PIECE(SDSC,U,10)
+28 if $PIECE(SDPT,U,16)
SET SDVSIT("TYP")=$PIECE(SDPT,U,16)
+29 ;
+30 ; call logic to add opt encounter(s)
+31 SET SDVSIT("ORG")=1
SET SDVSIT("REF")=SDDA
SET SDOE=$$SDOE(SDT,.SDVSIT,$GET(SDVIEN))
+32 IF SDOE
Begin DoDot:1
+33 NEW FDAIENS,ERR298,FDA298
+34 SET FDAIENS=SDT_","_DFN_","
+35 SET FDA298(2.98,FDAIENS,21)=SDOE
+36 DO FILE^DIE(,"FDA298","ERR298")
+37 ;
End DoDot:1
+38 ;Process credit stop if applicable
DO CSTOP(SDOE,SDCL,.SDVSIT,SDT)
+39 DO UNLOCK(.SDLOCK)
+40 QUIT
+41 ; FROM LOCK^SDVSIT
+42 ; Return Status = 1 if success, 0 if fail
LOCK(SDLOCK) ; lock "ADFN" node
+1 NEW SDC
+2 FOR SDC=1:1:5
LOCK +^SCE("ADFN",+$GET(SDLOCK("DFN")),+$GET(SDLOCK("EVENT DATE/TIME"))):$GET(DILOCKTM,3)
if $TEST
QUIT
+3 IF $TEST
QUIT 1
+4 QUIT 0
+5 ; 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 NEW SDTR,SDI
+2 SET SDTR=9999999-$PIECE(SDT,".")
+3 IF SDT["."
SET SDTR=SDTR_"."_$PIECE(SDT,".",2)
+4 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 HOSPITAL LOCATION
+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 if SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$SELECT($GET(SDVSIT("SVC"))]""
QUIT
+11 if SDVISARR(9000010,SDVIEN1_",",.08,"I")'=$GET(SDVSIT("CLN"))
QUIT
+12 if SDVISARR(9000010,SDVIEN1_",",.22,"I")'=$GET(SDVSIT("LOC"))
QUIT
+13 if SDVISARR(9000010,SDVIEN1_",",15003,"I")'="P"
QUIT
+14 SET SDVIEN=SDVIEN1
End DoDot:2
if $GET(SDVIEN)]""
QUIT
End DoDot:1
+15 SET SDVSIT("VST")=$GET(SDVIEN)
+16 ; consider bringing SDVSIT0 calls into SDES* namespace in the future
+17 IF 'SDVSIT("VST")
DO VISIT^SDVSIT0(SDT,.SDVSIT)
+18 QUIT $$NEW^SDVSIT0(SDT,.SDVSIT)
+19 ;
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 ; SDOE=encounter ien
+2 ; SDCL0=zeroeth node of HOSPITAL LOCATION file record
+3 ; SDVSIT=visit data array
+4 ; 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 ; editing user
SET SDLOG("USER")=$GET(CKOUTUSER)
+3 ; last edited
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 scheduling turned on in Visit Tracking
+2 ; Required input SDOE = Outpatient Encounter pointer
+3 ; SDVIEN = Visit file pointer or null or zero
+4 ;
+5 ; quit if no vien
+6 if 'SDVIEN
QUIT
+7 ; quit is no encounter
+8 if '$DATA(^SCE(+SDOE,0))
QUIT
+9 ; set visit ien if vien not already set
+10 NEW SDFDA,SDERR
+11 IF '$$GET1^DIQ(409.68,+SDOE,.05,"I")
Begin DoDot:1
+12 KILL SDFDA,SDERR
+13 SET SDFDA(409.68,SDOE_",",.05)=SDVIEN
+14 DO FILE^DIE("","SDFDA","SDERR")
End DoDot:1
+15 IF '$$GET1^DIQ(409.68,+SDOE,.04,"I")
Begin DoDot:1
+16 NEW DIE,DA,DR,SDLOC
+17 SET SDLOC=$$GET1^DIQ(9000010,SDVIEN,.22,"I")
+18 IF SDLOC
Begin DoDot:2
+19 KILL SDFDA,SDERR
+20 SET SDFDA(409.68,SDOE_",",.04)=SDLOC
+21 DO FILE^DIE("","SDFDA","SDERR")
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
CHKOUT2(SDOE,DFN,APPTDTTM,CLINICIEN,CHKOUTDT,SDECAPTID,SDQUIET,VPRV,SDERRORS) ;EP; called to ask check-out date/time
+1 ; SDOE = Outpatient Encounter IEN
+2 ; DFN = Patient IEN
+3 ; APPTDTTM = Appointment Date/Time
+4 ; CLINICIEN = Clinic IEN
+5 ; CHKOUTDT = APPOINTMENT CHECKOUT TIME [OPTIONAL - USED WHEN SDQUIET=1] USER ENTERED FORMAT
+6 ; SDECAPTID = APPOINTMENT ID - POINTER TO ^SDECAPPT
+7 ; SDQUIET = ALLOW NO TERMINAL INPUT/OUTPUT 0=ALLOW; 1=DO NOT ALLOW
+8 ; VPRV = V Provider IEN - pointer to V PROVIDER file
+9 ; SDERRORS = Returned Array of errors
+10 ;
+11 NEW DIE,DA,DR,SDECNOD,SDN,SDV,AUPNVSIT,PROVIEN40984,PSTAT,SDFDA,SDERR,IENS44
+12 KILL SDFDA,SDERR
+13 SET (DA,SDN)=$$SCIEN(DFN,CLINICIEN,APPTDTTM)
+14 SET IENS44=$$GET44RECORDIENS^SDESCANCELAPPTS(CLINICIEN,APPTDTTM,DFN)
+15 SET SDFDA(44.003,IENS44,303)=CHKOUTDT
+16 SET SDFDA(44.003,IENS44,304)=DUZ
+17 SET SDFDA(44.003,IENS44,306)=$$NOW^XLFDT
+18 DO FILE^DIE(,"SDFDA","SDERR")
+19 ;
+20 ; if checked out and status not updated
+21 IF $$GET1^DIQ(44.003,DA_","_APPTDTTM_","_CLINICIEN_",",303,"I")]""
Begin DoDot:1
+22 ;UPDATE APPOINTMENT SCHEDULE GLOBAL ^SDEC(409.84
+23 IF $GET(SDECAPTID)
Begin DoDot:2
+24 SET PSTAT=$$GET1^DIQ(409.68,SDOE,.12,"I")
+25 KILL SDFDA,SDERR
+26 SET SDFDA(409.84,SDECAPTID_",",.14)=$GET(CHKOUTDT)
+27 SET SDFDA(409.84,SDECAPTID_",",.19)=PSTAT
+28 DO FILE^DIE("","SDFDA","SDERR")
+29 ; possibly update VProvider
+30 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+31 SET PROVIEN40984=$$GET1^DIQ(409.84,SDECAPTID,.15,"I")
+32 IF $GET(VPRV)
IF PROVIEN40984
Begin DoDot:3
+33 ; get SDEC appointment schedule
+34 KILL SDFDA,SDERR
+35 SET SDFDA(9000010.06,PROVIEN40984_",",.01)=VPRV
+36 DO FILE^DIE("","SDFDA","SDERR")
End DoDot:3
End DoDot:2
+37 if $$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"
QUIT
+38 KILL SDFDA,SDERR
+39 SET SDFDA(409.68,SDOE_",",.12)=14
+40 SET SDFDA(409.68,SDOE_",",.101)=CKOUTUSER
+41 SET SDFDA(409.68,SDOE_",",.102)=$$NOW^XLFDT
+42 DO FILE^DIE("","SDFDA","SDERR")
+43 ; if visit pointer stored, update visit checkout date/time
+44 SET SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
if 'SDV
QUIT
+45 if '$DATA(^AUPNVSIT(SDV,0))
QUIT
if $$GET1^DIQ(9000010,SDV,.05,"I")'=DFN
QUIT
+46 ;deleted
if $$GET1^DIQ(9000010,SDV,.11,"I")=1
QUIT
+47 KILL SDFDA,SDERR
+48 SET SDFDA(9000010,SDV_",",.18)=$$GET1^DIQ(44.003,SDN_","_APPTDTTM_","_CLINICIEN_",",303,"I")
+49 DO FILE^DIE("","SDFDA","SDERR")
End DoDot:1
+50 QUIT
+51 ;
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 ;
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 ^ checkout 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 Checkout 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
