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

SDESAPTREQ44.m

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