SDESAPTREQ44 ;ALB/ANU,KML - APPOINTMENT REQUEST CREATE/UPDATE IN FILE44 ;Feb 16, 2022
;;5.3;Scheduling;**805,809**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; This entry point is used for both the SDES SET APT REQ 44 CREATE and SDES SET APT REQ 44 UPDATE RPCs.
; The parameter list for each RPC must be kept in sync. This includes in the Remote Procedure file definition.
;
ARSET(RETURN,ARUPD,ARIEN,DFN,ARDAPTDT,ARLEN,ARRSN,ARUSER,ARODT,PATELG,AROVR) ; Create/Update Appointment Request
; INP - Input parameters array
; ARUPD = (integer) 1 for Update and 0 for Create Appointment
; ARIEN = (integer) IEN point to HOSPTIAL LOCATION file 44
; If null, a new entry will be added
; DFN = (text) DFN Pointer to the PATIENT file 2
; ARDAPTDT = (date/time) APPOINTMENT DATE/TIME in ISO8601 extended format (e.g. 2021-12-22T20:30-0500) ;vse-2097
; ARLEN = (integer) Appointment length in minutes (5 - 120)
; ARRSN = (text) Reason for Appointment upto 150 characters
; ARUSER = (text) Originating User name - NAME field in NEW PERSON file 200
; ARODT = (date ONLY) DATE APPOINTMENT MADE in ISO8601 extended format (e.g. 2021-12-22)
; PATELG = (text) Eligibility of Visit
; AROVR = (integer) Overbook flag - 1=yes
;
N POP,SDAPTREQ,ARORIGDT,AUDF,FNUM
;
D VALIDATE
I 'POP D
.I +ARUPD=1 D UPDATE Q
.I +ARUPD=0 D CREATE Q
D BUILDER
Q
;
VALIDATE ;
S POP=0,AUDF=0,FNUM=44
;
;
I ARUPD'=1,ARUPD'=0 S SDAPTREQ("Error",1)="Invalid Update Flag." Q
;
; Clinic IEN
S ARIEN=$G(ARIEN,"")
I ARIEN="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,18) Q
I '$D(^SC(+ARIEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,19) Q
I $$INACTIVE^SDEC32(+ARIEN) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,19) Q
;
; Patient DFN
S DFN=$G(DFN,"")
I DFN="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,1) Q
I DFN'="",'$D(^DPT(+DFN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,2) Q
;
; Desired date/time of appt
S ARDAPTDT=$G(ARDAPTDT,"")
I ARDAPTDT="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,57) Q
S ARDAPTDT=$$ISOTFM^SDAMUTDT(ARDAPTDT,ARIEN) ; vse-2397 clinic time zone
I ARDAPTDT=-1 S ARDAPTDT="",POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,58) Q
I ARUPD=0,ARDAPTDT<DT S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,59) Q ;Only validate on Create
;
; Originating Dt/Tm
S ARODT=$G(ARODT,"")
I ARODT'="" S ARODT=$$ISOTFM^SDAMUTDT(ARODT) ;vse-2397 date only, NO TIME
I ARODT=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,49) Q
I ARODT="" S ARODT=$$DT^XLFDT ;vse-2397 ARODT is date only; stored at DATE APPOINTMENT MADE field (44.003,8)
;
; Appointment Length in Minutes
S ARLEN=$G(ARLEN,"")
I ARUPD=0,ARLEN="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,115) Q
I ARLEN'="",((+ARLEN<5)!(+ARLEN>120)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,116) Q
;
; Appointment Reason
S ARRSN=$G(ARRSN,"")
S ARRSN=$TR($G(ARRSN),"^"," ")
;
; Requesting User
S ARUSER=$G(ARUSER,"")
I '$D(^VA(200,+$G(ARUSER),0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,44) Q
;
; Overbook
S AROVR=$G(AROVR,"")
I AROVR'="" D
. I AROVR'=1,AROVR'=0 S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,112) Q
;
; Patient Eligibility
S PATELG=$G(PATELG,"")
I PATELG'="",'$D(^DIC(8,+PATELG,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,143) Q
;
Q
;
CREATE ;Build FDA array to creat a new entry in 44
; add appt to file 44
N IEN
S IEN=$$SCIEN^SDECU2(DFN,ARIEN,ARDAPTDT)
I IEN S SDAPTREQ("Error",1)="Appointment already exists." Q
I '$D(^SC(ARIEN,"S",0)) S ^SC(ARIEN,"S",0)="^44.001DA^^"
I '$D(^SC(ARIEN,"S",ARDAPTDT,0)) S ^SC(ARIEN,"S",ARDAPTDT,0)=ARDAPTDT,^(1,0)="^44.003PA^^"
K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
S DIC="^SC("_ARIEN_",""S"","_ARDAPTDT_",1,"
S DA(2)=ARIEN,DA(1)=ARDAPTDT,X=DFN
S DIC("DR")="1////"_ARLEN_";3///"_$E($G(ARRSN),1,150)_";7////"_ARUSER_";8////"_ARODT_";30////"_PATELG_$S(+AROVR:";9////O",1:"")
S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
D FILE^DICN
I Y<0 S SDAPTREQ("Error",1)="Error in creating Appointment." Q
S SDAPTREQ("Success")="Appointment is successfully created."
Q
;
UPDATE ;Find ien for appt in file 44
N IEN,SDFDA,SDERR
S IEN=$$SCIEN^SDECU2(DFN,ARIEN,ARDAPTDT)
I 'IEN S SDAPTREQ("Error",1)="Error trying to find appointment to update." Q
S SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",1)=ARLEN
S SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",3)=ARRSN
S SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",30)=PATELG
S SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",9)=AROVR
S SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",7)=ARUSER
S SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",8)=ARODT
K SDERR D UPDATE^DIE("","SDFDA","","SDERR")
I $D(SDERR) S SDAPTREQ("Error",1)="Error trying to find appointment to update." Q
S SDAPTREQ("Success")="Appointment is successfully updated."
Q
;
BUILDER ;Convert data to JSON
N JSONERR
S JSONERR=""
D ENCODE^SDESJSON(.SDAPTREQ,.RETURN,.JSONERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESAPTREQ44 4999 printed Oct 16, 2024@18:56:09 Page 2
SDESAPTREQ44 ;ALB/ANU,KML - APPOINTMENT REQUEST CREATE/UPDATE IN FILE44 ;Feb 16, 2022
+1 ;;5.3;Scheduling;**805,809**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ; This entry point is used for both the SDES SET APT REQ 44 CREATE and SDES SET APT REQ 44 UPDATE RPCs.
+6 ; The parameter list for each RPC must be kept in sync. This includes in the Remote Procedure file definition.
+7 ;
ARSET(RETURN,ARUPD,ARIEN,DFN,ARDAPTDT,ARLEN,ARRSN,ARUSER,ARODT,PATELG,AROVR) ; Create/Update Appointment Request
+1 ; INP - Input parameters array
+2 ; ARUPD = (integer) 1 for Update and 0 for Create Appointment
+3 ; ARIEN = (integer) IEN point to HOSPTIAL LOCATION file 44
+4 ; If null, a new entry will be added
+5 ; DFN = (text) DFN Pointer to the PATIENT file 2
+6 ; ARDAPTDT = (date/time) APPOINTMENT DATE/TIME in ISO8601 extended format (e.g. 2021-12-22T20:30-0500) ;vse-2097
+7 ; ARLEN = (integer) Appointment length in minutes (5 - 120)
+8 ; ARRSN = (text) Reason for Appointment upto 150 characters
+9 ; ARUSER = (text) Originating User name - NAME field in NEW PERSON file 200
+10 ; ARODT = (date ONLY) DATE APPOINTMENT MADE in ISO8601 extended format (e.g. 2021-12-22)
+11 ; PATELG = (text) Eligibility of Visit
+12 ; AROVR = (integer) Overbook flag - 1=yes
+13 ;
+14 NEW POP,SDAPTREQ,ARORIGDT,AUDF,FNUM
+15 ;
+16 DO VALIDATE
+17 IF 'POP
Begin DoDot:1
+18 IF +ARUPD=1
DO UPDATE
QUIT
+19 IF +ARUPD=0
DO CREATE
QUIT
End DoDot:1
+20 DO BUILDER
+21 QUIT
+22 ;
VALIDATE ;
+1 SET POP=0
SET AUDF=0
SET FNUM=44
+2 ;
+3 ;
+4 IF ARUPD'=1
IF ARUPD'=0
SET SDAPTREQ("Error",1)="Invalid Update Flag."
QUIT
+5 ;
+6 ; Clinic IEN
+7 SET ARIEN=$GET(ARIEN,"")
+8 IF ARIEN=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,18)
QUIT
+9 IF '$DATA(^SC(+ARIEN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,19)
QUIT
+10 IF $$INACTIVE^SDEC32(+ARIEN)
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,19)
QUIT
+11 ;
+12 ; Patient DFN
+13 SET DFN=$GET(DFN,"")
+14 IF DFN=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,1)
QUIT
+15 IF DFN'=""
IF '$DATA(^DPT(+DFN,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,2)
QUIT
+16 ;
+17 ; Desired date/time of appt
+18 SET ARDAPTDT=$GET(ARDAPTDT,"")
+19 IF ARDAPTDT=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,57)
QUIT
+20 ; vse-2397 clinic time zone
SET ARDAPTDT=$$ISOTFM^SDAMUTDT(ARDAPTDT,ARIEN)
+21 IF ARDAPTDT=-1
SET ARDAPTDT=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,58)
QUIT
+22 ;Only validate on Create
IF ARUPD=0
IF ARDAPTDT<DT
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,59)
QUIT
+23 ;
+24 ; Originating Dt/Tm
+25 SET ARODT=$GET(ARODT,"")
+26 ;vse-2397 date only, NO TIME
IF ARODT'=""
SET ARODT=$$ISOTFM^SDAMUTDT(ARODT)
+27 IF ARODT=-1
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,49)
QUIT
+28 ;vse-2397 ARODT is date only; stored at DATE APPOINTMENT MADE field (44.003,8)
IF ARODT=""
SET ARODT=$$DT^XLFDT
+29 ;
+30 ; Appointment Length in Minutes
+31 SET ARLEN=$GET(ARLEN,"")
+32 IF ARUPD=0
IF ARLEN=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,115)
QUIT
+33 IF ARLEN'=""
IF ((+ARLEN<5)!(+ARLEN>120))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,116)
QUIT
+34 ;
+35 ; Appointment Reason
+36 SET ARRSN=$GET(ARRSN,"")
+37 SET ARRSN=$TRANSLATE($GET(ARRSN),"^"," ")
+38 ;
+39 ; Requesting User
+40 SET ARUSER=$GET(ARUSER,"")
+41 IF '$DATA(^VA(200,+$GET(ARUSER),0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,44)
QUIT
+42 ;
+43 ; Overbook
+44 SET AROVR=$GET(AROVR,"")
+45 IF AROVR'=""
Begin DoDot:1
+46 IF AROVR'=1
IF AROVR'=0
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,112)
QUIT
End DoDot:1
+47 ;
+48 ; Patient Eligibility
+49 SET PATELG=$GET(PATELG,"")
+50 IF PATELG'=""
IF '$DATA(^DIC(8,+PATELG,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,143)
QUIT
+51 ;
+52 QUIT
+53 ;
CREATE ;Build FDA array to creat a new entry in 44
+1 ; add appt to file 44
+2 NEW IEN
+3 SET IEN=$$SCIEN^SDECU2(DFN,ARIEN,ARDAPTDT)
+4 IF IEN
SET SDAPTREQ("Error",1)="Appointment already exists."
QUIT
+5 IF '$DATA(^SC(ARIEN,"S",0))
SET ^SC(ARIEN,"S",0)="^44.001DA^^"
+6 IF '$DATA(^SC(ARIEN,"S",ARDAPTDT,0))
SET ^SC(ARIEN,"S",ARDAPTDT,0)=ARDAPTDT
SET ^(1,0)="^44.003PA^^"
+7 KILL DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
+8 SET DIC="^SC("_ARIEN_",""S"","_ARDAPTDT_",1,"
+9 SET DA(2)=ARIEN
SET DA(1)=ARDAPTDT
SET X=DFN
+10 SET DIC("DR")="1////"_ARLEN_";3///"_$EXTRACT($GET(ARRSN),1,150)_";7////"_ARUSER_";8////"_ARODT_";30////"_PATELG_$SELECT(+AROVR:";9////O",1:"")
+11 SET DIC("P")="44.003PA"
SET DIC(0)="L"
SET DLAYGO=44.003
+12 DO FILE^DICN
+13 IF Y<0
SET SDAPTREQ("Error",1)="Error in creating Appointment."
QUIT
+14 SET SDAPTREQ("Success")="Appointment is successfully created."
+15 QUIT
+16 ;
UPDATE ;Find ien for appt in file 44
+1 NEW IEN,SDFDA,SDERR
+2 SET IEN=$$SCIEN^SDECU2(DFN,ARIEN,ARDAPTDT)
+3 IF 'IEN
SET SDAPTREQ("Error",1)="Error trying to find appointment to update."
QUIT
+4 SET SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",1)=ARLEN
+5 SET SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",3)=ARRSN
+6 SET SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",30)=PATELG
+7 SET SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",9)=AROVR
+8 SET SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",7)=ARUSER
+9 SET SDFDA(44.003,IEN_","_ARDAPTDT_","_ARIEN_",",8)=ARODT
+10 KILL SDERR
DO UPDATE^DIE("","SDFDA","","SDERR")
+11 IF $DATA(SDERR)
SET SDAPTREQ("Error",1)="Error trying to find appointment to update."
QUIT
+12 SET SDAPTREQ("Success")="Appointment is successfully updated."
+13 QUIT
+14 ;
BUILDER ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.SDAPTREQ,.RETURN,.JSONERR)
+4 QUIT
