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

SDESAPPTREQ40984.m

Go to the documentation of this file.
SDESAPPTREQ40984  ;ALB/ANU,MGD - VISTA SCHEDULING RPCS GET MISSION ELIGIBILITY ; June 16, 2022@15:20
 ;;5.3;Scheduling;**813,819**;Aug 13, 1993;Build 5
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 ;External References
 ;-------------------
 ; Reference to $$GETS^DIQ in ICR #2056
 ; Reference to $$GETS1^DIQ in ICR #2056
 ; Reference to $$SITE^VASITE in ICR #10112
 ; Reference to $$FIND1^DIC in ICR #2051
 ; Reference to ^%DT in ICR #10003
 ;
 Q
 ;
 ; This entry point is used for both the SDES SET APT REQ 40984 CREATE and SDES SET APT REQ 40984 UPDATE RPCs.
 ; The parameter list for each RPC must be kept in sync. This includes in the Remote Procedure file definition.
 ;
ARSET(APTRETURN,SDAPPTSTARTDTTM,SDAPPTENDDTTM,SDPATIENTDFN,SDRESOURCE,SDATYPID,SDDDTTM,SDEXTID,SDAPPTREQTYPE,SDPROVIEN,SDCLNID,SDNOTE,SDAPPTYPE,SDEESTAT,SDAPPTLENGTH,SDEAS) ; Create/Update Appointment Request
 ; This RPC creates an entry in SDEC APPOINTMENT file #409.84.
 ; Input:
 ;
 ; SDAPPTSTARTDTTM    - [required] - Appointment Start Date and time in ISO 8601 extended format (e.g. 2022-01-19T09:00-04:00)
 ; SDAPPTENDDTTM      - [required] - Appointment End Date and time in ISO 8601 extended format (e.g. 2022-01-19T09:00-04:00)
 ; SDPATIENTDFN       - [required] - ien of patient file 2
 ; SDRESOURCE         - [required] - Resource, Pointer to SDEC Resource File
 ; SDATYPID           - [optional] - Access Type ID used for 2 purposes:
 ;                      if SDATYPID - "WALKIN" then create a walkin appt.
 ;                      if SDATYPID - a number, then it is the access type id (used for rebooking)
 ; SDDDTTM            - [optional] - Desired date of Appointment Date and time in ISO 8601 extended format (e.g. 2022-01-19T09:00-04:00)
 ; SDEXTID            - [optional] - External ID (free format)
 ; SDAPPTREQTYPE      - [required] - Appt Request type - variable pointer pointer to one of these files:
 ;                      APPT REQ - A|<REQ IEN> A|123
 ;                      SD WAIT LIST - E|<WL IEN> E|123
 ;                      REQUEST/CONSULTATION - C|<CONSULT IEN> C|123
 ;                      RECALL REMINDERS - R|^<RECALL IEN> R|123
 ; SDPROVIEN          -  [optional] - Provider Pointer to NEW PERSON file #200
 ; SDCLNID            - [required] - Clinic ID pointer to HOSPITAL LOCATION file 44
 ; SDNOTE             - [optional] - Represents a note, Only the 1st 150 characters are used
 ; SDAPPTYPE         - [optional] - Appointment Type, Pointer to #409.1.  Only used for Consults
 ; SDEESTAT           - [optional] - This is the flag for either "N"ew or "E"stablished status regarding the SD WAIT LIST (#409.3) file.
 ; SDAPPTLENGTH       - [optional] - Appointment length in minutes (5 - 120)
 ; SDEAS              - [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
 ;
 N HASVLDERRORS,RETURN,HASFIELDS,ELGFIELDSARRAY,VLDERRORS
 N SDSAVESTRT,SDRESOURCED,SDECRNOD,SDECWKIN
 S (RETURN,VLDERRORS,APTFIELDSARRAY,HASFIELDS)=""
 ;
 S HASVLDERRORS=$$VALIDATE(.VLDERRORS,.SDAPPTSTARTDTTM,.SDAPPTENDDTTM,.SDPATIENTDFN,.SDRESOURCE,.SDATYPID,.SDDDTTM,.SDEXTID,.SDAPPTREQTYPE,.SDPROVIEN,.SDCLNID,.SDNOTE,.SDAPPTYPE,.SDEESTAT,.SDAPPTLENGTH,.SDEAS)
 I HASVLDERRORS M RETURN=VLDERRORS
 I 'HASVLDERRORS S HASFIELDS=$$CRTAPPT(.APTFIELDSARRAY,SDAPPTSTARTDTTM,SDAPPTENDDTTM,SDPATIENTDFN,SDRESOURCE,SDATYPID,SDDDTTM,SDEXTID,SDAPPTREQTYPE,SDPROVIEN,SDCLNID,SDNOTE,SDAPPTYPE,SDEESTAT,SDAPPTLENGTH,SDEAS)
 I HASFIELDS M RETURN=APTFIELDSARRAY
 ;
 D BUILDJSON(.APTRETURN,.RETURN)
 D CLEANUP
 Q
 ;
VALIDATE(ERRORS,SDAPPTSTARTDTTM,SDAPPTENDDTTM,SDPATIENTDFN,SDRESOURCE,SDATYPID,SDDDTTM,SDEXTID,SDAPPTREQTYPE,SDPROVIEN,SDCLNID,SDNOTE,SDAPPTYPE,SDEESTAT,SDAPPTLENGTH,SDEAS) ; Validate input
 N ERRORFLAG,SDECTMP,SDECERR
 ;
 ; Appointment Start Date and Time
 S SDAPPTSTARTDTTM=$G(SDAPPTSTARTDTTM,"")
 I SDAPPTSTARTDTTM="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,165) Q $D(ERRORFLAG)
 S SDAPPTSTARTDTTM=$$ISOTFM^SDAMUTDT(SDAPPTSTARTDTTM,SDCLNID)
 I SDAPPTSTARTDTTM=-1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,166) Q $D(ERRORFLAG)
 S SDSAVESTRT=SDAPPTSTARTDTTM ;save date/time for consult request
 ;
 ; Appointment End Date and Time
 S SDAPPTENDDTTM=$G(SDAPPTENDDTTM,"")
 I SDAPPTENDDTTM="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,167) Q $D(ERRORFLAG)
 S SDAPPTENDDTTM=$$ISOTFM^SDAMUTDT(SDAPPTENDDTTM,SDCLNID)
 I SDAPPTENDDTTM=-1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,168) Q $D(ERRORFLAG)
 I $L(SDAPPTENDDTTM,".")=1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,168) Q $D(ERRORFLAG)
 I SDAPPTSTARTDTTM>SDAPPTENDDTTM S SDECTMP=SDAPPTENDDTTM,SDAPPTENDDTTM=SDAPPTSTARTDTTM,SDAPPTSTARTDTTM=SDECTMP
 ;
 ; Patient DFN
 S SDPATIENTDFN=$G(SDPATIENTDFN,"")
 I SDPATIENTDFN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,1) Q $D(ERRORFLAG)
 I SDPATIENTDFN'="",'$D(^DPT(+SDPATIENTDFN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,2) Q $D(ERRORFLAG)
 ;
 ; Resource
 S SDECERR=0
 S SDRESOURCE=$G(SDRESOURCE,"")
 I SDRESOURCE="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,69) Q $D(ERRORFLAG)
 I +SDRESOURCE,'$D(^SDEC(409.831,SDRESOURCE,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,70) Q $D(ERRORFLAG)
 I '+SDRESOURCE,'$D(^SDEC(409.831,"B",SDRESOURCE)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,70) Q $D(ERRORFLAG)
 S SDRESOURCED=$S(+SDRESOURCE:+SDRESOURCE,1:$O(^SDEC(409.831,"B",SDRESOURCE,0)))
 S SDECRNOD=$G(^SDEC(409.831,SDRESOURCED,0))
 I SDECRNOD="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,70) Q $D(ERRORFLAG)
 ;
 ; Access Type ID
 S SDECWKIN=0
 S SDATYPID=$G(SDATYPID,"")
 I SDATYPID="WALKIN" S SDECWKIN=1
 I SDATYPID'?.N&(SDATYPID'="WALKIN") S SDATYPID=""
 ;
 ; Desired Date of Appointment
 S SDDDTTM=$G(SDDDTTM,"")
 I SDDDTTM'="" S SDDDTTM=$$ISOTFM^SDAMUTDT(SDDDTTM,SDCLNID)
 I SDDDTTM=-1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,58) Q $D(ERRORFLAG)
 I SDDDTTM="",SDATYPID'="WALKIN" S SDDDTTM=$P(SDAPPTSTARTDTTM,".",1)
 ;
 ; appt request type
 S SDAPPTREQTYPE=$G(SDAPPTREQTYPE,"")
 I SDAPPTREQTYPE="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,60) Q $D(ERRORFLAG)
 I ";E;R;C;A;"'[(";"_$P(SDAPPTREQTYPE,"|",1)_";") S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,61) Q $D(ERRORFLAG)
 I +$P(SDAPPTREQTYPE,"|",2)=0 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,61) Q $D(ERRORFLAG)
 I SDAPPTREQTYPE'="" D
 .I $P(SDAPPTREQTYPE,"|",1)="E" I '$D(^SDWL(409.3,+$P(SDAPPTREQTYPE,"|",2),0)) S SDAPPTREQTYPE=""
 .I $P(SDAPPTREQTYPE,"|",1)="R" I '$D(^SD(403.5,+$P(SDAPPTREQTYPE,"|",2),0)) S SDAPPTREQTYPE=""
 .I $P(SDAPPTREQTYPE,"|",1)="C" I '$D(^GMR(123,+$P(SDAPPTREQTYPE,"|",2),0)) S SDAPPTREQTYPE=""
 .I $P(SDAPPTREQTYPE,"|",1)="A" I '$D(^SDEC(409.85,+$P(SDAPPTREQTYPE,"|",2),0)) S SDAPPTREQTYPE=""
 I SDAPPTREQTYPE="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,61) Q $D(ERRORFLAG)
 ;
 ; Clinic IEN
 S SDCLNID=$G(SDCLNID,"")
 I SDCLNID="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,18) Q $D(ERRORFLAG)
 I '$D(^SC(+SDCLNID,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,19) Q $D(ERRORFLAG)
 ;
 ; Note
 S SDNOTE=$G(SDNOTE,"") S:SDNOTE'="" SDNOTE=$TR($E(SDNOTE,1,150),"^"," ")
 ;
 ; APPTYPE
 S SDAPPTYPE=$G(SDAPPTYPE,"") I SDAPPTYPE'="",'$D(^SD(409.1,+SDAPPTYPE,0)) S SDAPPTYPE=""
 ;
 ; Patient Status
 S SDEESTAT=$G(SDEESTAT)
 I SDEESTAT="" D
 .I $P(SDAPPTREQTYPE,"|",1)="E" S SDEESTAT=$$GET1^DIQ(409.3,$P(SDAPPTREQTYPE,"|",2)_",",27,"I")
 .I $P(SDAPPTREQTYPE,"|",1)="A" S SDEESTAT=$$GET1^DIQ(409.3,$P(SDAPPTREQTYPE,"|",2)_",",.02,"I")
 S SDEESTAT=$S(SDEESTAT="N":"N",SDEESTAT="NEW":"N",SDEESTAT="E":"E",SDEESTAT="ESTABLISHED":"E",1:"")
 ;
 ; Appt length - if passed in, must be 5-120
 S SDAPPTLENGTH=$G(SDAPPTLENGTH)
 I ((SDAPPTLENGTH'="")&((+SDAPPTLENGTH<5)!(+SDAPPTLENGTH>120))) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,116) Q $D(ERRORFLAG)
 ;
 ; validate EAS
 S SDEAS=$G(SDEAS,"")
 I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
 I SDEAS=-1 S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,142) Q $D(ERRORFLAG)
 ;
 ; validate provider
 I '$D(^VA(200,+$G(SDPROVIEN),0)) S SDPROVIEN=""
 S SDEXTID=$G(SDEXTID,"")
 ;
 Q $D(ERRORFLAG)
 ;
CRTAPPT(ELGARRAY,SDAPPTSTARTDTTM,SDAPPTENDDTTM,SDPATIENTDFN,SDRESOURCE,SDATYPID,SDDDTTM,SDEXTID,SDAPPTREQTYPE,SDPROVIEN,SDCLNID,SDNOTE,SDAPPTYPE,SDEESTAT,SDAPPTLENGTH,SDEAS) ; Create Appt
 N HASDATA,SDECAPPTID
 S SDECAPPTID=""
 S ELGARRAY("Appointment","Code")="0"
 S ELGARRAY("Appointment","Message")="Unable to add appointment to SDEC APPOINTMENT file."
 S SDECAPPTID=$$SDECADD^SDEC07(SDAPPTSTARTDTTM,SDAPPTENDDTTM,SDPATIENTDFN,SDRESOURCED,SDATYPID,SDDDTTM,SDEXTID,SDAPPTREQTYPE,SDPROVIEN,SDCLNID,SDNOTE,SDSAVESTRT,SDRESOURCE,SDAPPTYPE,SDEESTAT,1,+SDAPPTLENGTH,SDEAS)
 I SDECAPPTID D
 .S ELGARRAY("Appointment","Code")="1"
 .S ELGARRAY("Appointment","IEN")=SDECAPPTID
 .S ELGARRAY("Appointment","Message")="Created an appointment in SDEC APPOINTMENT file."
 S HASDATA=($D(ELGARRAY)>1)
 Q HASDATA
 ;
BUILDJSON(JSONRETURN,INPUT) ; Build JSON format
 S JSONERROR=""
 D ENCODE^XLFJSON("INPUT","JSONRETURN","JSONERROR")
 Q
 ;
CLEANUP ; Cleanup
 K HASVLDERRORS,RETURN,HASFIELDS,APTFIELDSARRAY,SDSAVESTRT,SDRESOURCED,SDECRNOD,SDECWKIN
 K ERRORFLAG
 K HASDATA
 K JSONERROR
 Q