SDAPIAP ;ALB/MJK - Outpatient API/Appointments ;JAN 15, 2016
;;5.3;Scheduling;**27,132,627**;08/13/93;Build 249
;
EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
N SDDA,SDOE
S SDOE=0
; -- verify that check-out can occur
D CHECK(DFN,SDT,SDCL,.SDDA) I $$ERRCHK^SDAPIER() G ENQ
;
; -- file check-out data ; get encounter ien
S SDOE=$$FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,$G(SDVIEN))
;
ENQ Q SDOE
;
CHECK(DFN,SDT,SDCL,SDDA) ; -- check if event can occur/allowed
N SDATA,STATUS
; -- error if appt node doesn't exist
S SDATA=$G(^DPT(DFN,"S",SDT,0))
I SDATA="" D ERRFILE^SDAPIER(100,SDT_U_DFN) G CHECKQ
;
; -- error if different clinic
I +SDATA'=SDCL D ERRFILE^SDAPIER(101,+SDATA_U_SDCL) G CHECKQ
;
; -- error if no slot for appt
S SDDA=$$FIND^SDAM2(DFN,SDT,SDCL) I 'SDDA D ERRFILE^SDAPIER(102,SDT_U_SDCL) G CHECKQ
;
; -- get appt status data
S STATUS=$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA)
;
; -- error if current status won't allow checking-out
I '$D(^SD(409.63,"ACO",1,+STATUS)) D ERRFILE^SDAPIER(103,$P(STATUS,";",2)) G CHECKQ
;
; -- warning if already checked-out
I $P(STATUS,";",2)="CHECKED OUT" D ERRFILE^SDAPIER(1100)
;
; -- error if appt date if after today
I SDT>(DT+.2359) D ERRFILE^SDAPIER(104,SDT) G CHECKQ
CHECKQ Q
;
FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,SDVIEN) ; -- file data
N SDATA,SDHDL,SDOE,SDCOMPF,SDLOG
S SDOE=""
;
; -- setup event driver data
D BEFORE^SDCO1(.SDATA,DFN,SDT,SDCL,SDDA,.SDHDL)
;
; -- set elig for appt
D ELIG^SDCO1(DFN,SDT,SDCL,SDDA) ; may need to expand
;
; -- get encounter ien ; error if none returned
S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL,$G(SDVIEN))
I 'SDOE D ERRFILE^SDAPIER(110) G FILEQ
;
; -- time stamp check-out and log data
D DT(DFN,SDT,SDCL,SDDA,$G(@SDROOT@("DATE/TIME")))
D LOGDATA(SDOE)
;
; -- update SDEC APPOINTMENT ;alb/sat 627
I $G(@SDROOT@("DATE/TIME")) D
.N SDECAPPT,SDECVPRV
.S SDECAPPT=$$APPTGET^SDECUTL(DFN,SDT,SDCL) ;get SDEC APPOINTMENT ien
.S SDECVPRV=$O(^AUPNVPRV("AD",+$G(SDVIEN),0))
.D CO1^SDEC25B(SDECAPPT,@SDROOT@("DATE/TIME"),SDOE,SDECVPRV) ;call update
;end addition/modification ;alb/sat 627
;
; -- process data
D FILE^SDAPICO(SDOE,SDUZ)
;
; -- update check-out completion
D EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
;
; -- set visit change flag for event driver
D CHANGE^SDAMEVT4(.SDHDL,$P($G(^SCE(SDOE,0)),U,8),$G(@SDROOT@("VISIT CHANGE FLAGS")))
;
; -- get after values and invoke event driver
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
D EVT^SDAMEVT(.SDATA,5,SDMODE,SDHDL)
;
; -- cleanup event driver vars
D CLEAN^SDAMEVT(SDHDL)
;
FILEQ Q SDOE
;
DT(DFN,SDT,SDCL,SDDA,SDCODT) ; -- time stamp check out date
; -- NOTE: this code duplicates at DT^SDCO1 but silent
N %DT,DR,SDCIDT,X,DIE,DA
S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"
S X=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")),SDCIDT=+X
;IF $P(X,U,3) G DTQ
S DR="" IF $G(SDCODT) S DR="303R////"_$S(SDCODT<SDCIDT:SDCIDT,1:SDCODT)
IF DR]"" D DIE^SDCO1(SDCL,SDT,SDDA,DR)
DTQ Q
;
LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data
N DIE,DA,DR,Y,X
S SDLOG("USER")=$S(+$G(SDUZ):+SDUZ,1:$G(DUZ)) ; -- editing user
S SDLOG("DATE/TIME")=$$NOW^XLFDT() ; -- last edited
S DIE="^SCE(",DA=SDOE,DR="[SD ENCOUNTER LOG]" D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAPIAP 3344 printed Dec 13, 2024@02:48:26 Page 2
SDAPIAP ;ALB/MJK - Outpatient API/Appointments ;JAN 15, 2016
+1 ;;5.3;Scheduling;**27,132,627**;08/13/93;Build 249
+2 ;
EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
+1 NEW SDDA,SDOE
+2 SET SDOE=0
+3 ; -- verify that check-out can occur
+4 DO CHECK(DFN,SDT,SDCL,.SDDA)
IF $$ERRCHK^SDAPIER()
GOTO ENQ
+5 ;
+6 ; -- file check-out data ; get encounter ien
+7 SET SDOE=$$FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,$GET(SDVIEN))
+8 ;
ENQ QUIT SDOE
+1 ;
CHECK(DFN,SDT,SDCL,SDDA) ; -- check if event can occur/allowed
+1 NEW SDATA,STATUS
+2 ; -- error if appt node doesn't exist
+3 SET SDATA=$GET(^DPT(DFN,"S",SDT,0))
+4 IF SDATA=""
DO ERRFILE^SDAPIER(100,SDT_U_DFN)
GOTO CHECKQ
+5 ;
+6 ; -- error if different clinic
+7 IF +SDATA'=SDCL
DO ERRFILE^SDAPIER(101,+SDATA_U_SDCL)
GOTO CHECKQ
+8 ;
+9 ; -- error if no slot for appt
+10 SET SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
IF 'SDDA
DO ERRFILE^SDAPIER(102,SDT_U_SDCL)
GOTO CHECKQ
+11 ;
+12 ; -- get appt status data
+13 SET STATUS=$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA)
+14 ;
+15 ; -- error if current status won't allow checking-out
+16 IF '$DATA(^SD(409.63,"ACO",1,+STATUS))
DO ERRFILE^SDAPIER(103,$PIECE(STATUS,";",2))
GOTO CHECKQ
+17 ;
+18 ; -- warning if already checked-out
+19 IF $PIECE(STATUS,";",2)="CHECKED OUT"
DO ERRFILE^SDAPIER(1100)
+20 ;
+21 ; -- error if appt date if after today
+22 IF SDT>(DT+.2359)
DO ERRFILE^SDAPIER(104,SDT)
GOTO CHECKQ
CHECKQ QUIT
+1 ;
FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,SDVIEN) ; -- file data
+1 NEW SDATA,SDHDL,SDOE,SDCOMPF,SDLOG
+2 SET SDOE=""
+3 ;
+4 ; -- setup event driver data
+5 DO BEFORE^SDCO1(.SDATA,DFN,SDT,SDCL,SDDA,.SDHDL)
+6 ;
+7 ; -- set elig for appt
+8 ; may need to expand
DO ELIG^SDCO1(DFN,SDT,SDCL,SDDA)
+9 ;
+10 ; -- get encounter ien ; error if none returned
+11 SET SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL,$GET(SDVIEN))
+12 IF 'SDOE
DO ERRFILE^SDAPIER(110)
GOTO FILEQ
+13 ;
+14 ; -- time stamp check-out and log data
+15 DO DT(DFN,SDT,SDCL,SDDA,$GET(@SDROOT@("DATE/TIME")))
+16 DO LOGDATA(SDOE)
+17 ;
+18 ; -- update SDEC APPOINTMENT ;alb/sat 627
+19 IF $GET(@SDROOT@("DATE/TIME"))
Begin DoDot:1
+20 NEW SDECAPPT,SDECVPRV
+21 ;get SDEC APPOINTMENT ien
SET SDECAPPT=$$APPTGET^SDECUTL(DFN,SDT,SDCL)
+22 SET SDECVPRV=$ORDER(^AUPNVPRV("AD",+$GET(SDVIEN),0))
+23 ;call update
DO CO1^SDEC25B(SDECAPPT,@SDROOT@("DATE/TIME"),SDOE,SDECVPRV)
End DoDot:1
+24 ;end addition/modification ;alb/sat 627
+25 ;
+26 ; -- process data
+27 DO FILE^SDAPICO(SDOE,SDUZ)
+28 ;
+29 ; -- update check-out completion
+30 DO EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
+31 ;
+32 ; -- set visit change flag for event driver
+33 DO CHANGE^SDAMEVT4(.SDHDL,$PIECE($GET(^SCE(SDOE,0)),U,8),$GET(@SDROOT@("VISIT CHANGE FLAGS")))
+34 ;
+35 ; -- get after values and invoke event driver
+36 DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
+37 DO EVT^SDAMEVT(.SDATA,5,SDMODE,SDHDL)
+38 ;
+39 ; -- cleanup event driver vars
+40 DO CLEAN^SDAMEVT(SDHDL)
+41 ;
FILEQ QUIT SDOE
+1 ;
DT(DFN,SDT,SDCL,SDDA,SDCODT) ; -- time stamp check out date
+1 ; -- NOTE: this code duplicates at DT^SDCO1 but silent
+2 NEW %DT,DR,SDCIDT,X,DIE,DA
+3 if '$DATA(^SC(SDCL,"S",0))
SET ^(0)="^44.001DA^^"
+4 SET X=$GET(^SC(SDCL,"S",SDT,1,SDDA,"C"))
SET SDCIDT=+X
+5 ;IF $P(X,U,3) G DTQ
+6 SET DR=""
IF $GET(SDCODT)
SET DR="303R////"_$SELECT(SDCODT<SDCIDT:SDCIDT,1:SDCODT)
+7 IF DR]""
DO DIE^SDCO1(SDCL,SDT,SDDA,DR)
DTQ QUIT
+1 ;
LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data
+1 NEW DIE,DA,DR,Y,X
+2 ; -- editing user
SET SDLOG("USER")=$SELECT(+$GET(SDUZ):+SDUZ,1:$GET(DUZ))
+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 ;
