- 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 Feb 19, 2025@00:22:16 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