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

SDAPIAP.m

Go to the documentation of this file. 
  1. SDAPIAP ;ALB/MJK - Outpatient API/Appointments ;JAN 15, 2016
  1.  ;;5.3;Scheduling;**27,132,627**;08/13/93;Build 249
  1.  ;
  1. EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
  1.  N SDDA,SDOE
  1.  S SDOE=0
  1.  ; -- verify that check-out can occur
  1.  D CHECK(DFN,SDT,SDCL,.SDDA) I $$ERRCHK^SDAPIER() G ENQ
  1.  ;
  1.  ; -- file check-out data ; get encounter ien
  1.  S SDOE=$$FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,$G(SDVIEN))
  1.  ;
  1. ENQ Q SDOE
  1.  ;
  1. CHECK(DFN,SDT,SDCL,SDDA) ; -- check if event can occur/allowed
  1.  N SDATA,STATUS
  1.  ; -- error if appt node doesn't exist
  1.  S SDATA=$G(^DPT(DFN,"S",SDT,0))
  1.  I SDATA="" D ERRFILE^SDAPIER(100,SDT_U_DFN) G CHECKQ
  1.  ;
  1.  ; -- error if different clinic
  1.  I +SDATA'=SDCL D ERRFILE^SDAPIER(101,+SDATA_U_SDCL) G CHECKQ
  1.  ;
  1.  ; -- error if no slot for appt
  1.  S SDDA=$$FIND^SDAM2(DFN,SDT,SDCL) I 'SDDA D ERRFILE^SDAPIER(102,SDT_U_SDCL) G CHECKQ
  1.  ;
  1.  ; -- get appt status data
  1.  S STATUS=$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA)
  1.  ;
  1.  ; -- error if current status won't allow checking-out
  1.  I '$D(^SD(409.63,"ACO",1,+STATUS)) D ERRFILE^SDAPIER(103,$P(STATUS,";",2)) G CHECKQ
  1.  ;
  1.  ; -- warning if already checked-out
  1.  I $P(STATUS,";",2)="CHECKED OUT" D ERRFILE^SDAPIER(1100)
  1.  ;
  1.  ; -- error if appt date if after today
  1.  I SDT>(DT+.2359) D ERRFILE^SDAPIER(104,SDT) G CHECKQ
  1. CHECKQ Q
  1.  ;
  1. FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,SDVIEN) ; -- file data
  1.  N SDATA,SDHDL,SDOE,SDCOMPF,SDLOG
  1.  S SDOE=""
  1.  ;
  1.  ; -- setup event driver data
  1.  D BEFORE^SDCO1(.SDATA,DFN,SDT,SDCL,SDDA,.SDHDL)
  1.  ;
  1.  ; -- set elig for appt
  1.  D ELIG^SDCO1(DFN,SDT,SDCL,SDDA) ; may need to expand
  1.  ;
  1.  ; -- get encounter ien ; error if none returned
  1.  S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL,$G(SDVIEN))
  1.  I 'SDOE D ERRFILE^SDAPIER(110) G FILEQ
  1.  ;
  1.  ; -- time stamp check-out and log data
  1.  D DT(DFN,SDT,SDCL,SDDA,$G(@SDROOT@("DATE/TIME")))
  1.  D LOGDATA(SDOE)
  1.  ;
  1.  ; -- update SDEC APPOINTMENT  ;alb/sat 627
  1.  I $G(@SDROOT@("DATE/TIME")) D
  1.  .N SDECAPPT,SDECVPRV
  1.  .S SDECAPPT=$$APPTGET^SDECUTL(DFN,SDT,SDCL)  ;get SDEC APPOINTMENT ien
  1.  .S SDECVPRV=$O(^AUPNVPRV("AD",+$G(SDVIEN),0))
  1.  .D CO1^SDEC25B(SDECAPPT,@SDROOT@("DATE/TIME"),SDOE,SDECVPRV)  ;call update
  1.  ;end addition/modification  ;alb/sat 627
  1.  ;
  1.  ; -- process data
  1.  D FILE^SDAPICO(SDOE,SDUZ)
  1.  ;
  1.  ; -- update check-out completion
  1.  D EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
  1.  ;
  1.  ; -- set visit change flag for event driver
  1.  D CHANGE^SDAMEVT4(.SDHDL,$P($G(^SCE(SDOE,0)),U,8),$G(@SDROOT@("VISIT CHANGE FLAGS")))
  1.  ;
  1.  ; -- get after values and invoke event driver
  1.  D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
  1.  D EVT^SDAMEVT(.SDATA,5,SDMODE,SDHDL)
  1.  ;
  1.  ; -- cleanup event driver vars
  1.  D CLEAN^SDAMEVT(SDHDL)
  1.  ;
  1. FILEQ Q SDOE
  1.  ;
  1. DT(DFN,SDT,SDCL,SDDA,SDCODT) ; -- time stamp check out date
  1.  ; -- NOTE: this code duplicates at DT^SDCO1 but silent
  1.  N %DT,DR,SDCIDT,X,DIE,DA
  1.  S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"
  1.  S X=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")),SDCIDT=+X
  1.  ;IF $P(X,U,3) G DTQ
  1.  S DR="" IF $G(SDCODT) S DR="303R////"_$S(SDCODT<SDCIDT:SDCIDT,1:SDCODT)
  1.  IF DR]"" D DIE^SDCO1(SDCL,SDT,SDDA,DR)
  1. DTQ Q
  1.  ;
  1. LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data
  1.  N DIE,DA,DR,Y,X
  1.  S SDLOG("USER")=$S(+$G(SDUZ):+SDUZ,1:$G(DUZ)) ; -- editing user
  1.  S SDLOG("DATE/TIME")=$$NOW^XLFDT()            ; -- last edited
  1.  S DIE="^SCE(",DA=SDOE,DR="[SD ENCOUNTER LOG]" D ^DIE
  1.  Q
  1.  ;