SDESCREATEAPPT ;ALB/BLB,MGD,DJS,ANU,BLB,TJB,BLB/TJB,LAB,TJB - CREATE APPOINTMENT RPC; JUN 17, 2024
;;5.3;Scheduling;**814,823,826,827,828,842,843,846,847,851,853,869,877,881**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
;----------------- ----------------- ----------
;
Q
;
; create appt in file 409.84. Called from wrapper level SDESCRTAPPTWRAP. See SDESCRTAPPTWRAP for required inputs.
;
VALIDATE(ERRORS,ARY84,ARY44) ; Validate input
N MAXDAYS,SDECRNOD,RESOURCED,ENCOUNTER,REQUESTIEN,SDCONERR,SDAPPTSTARTDATE,IEN,TYPEIEN,TIMEDIFF
;
; appointment Start Date and Time
S ARY84("SDAPPTSTARTDTTM")=$G(ARY84("SDAPPTSTARTDTTM"),"")
I ARY84("SDAPPTSTARTDTTM")="" D ERRLOG^SDESJSON(.ERRORS,165) Q
I $P($G(ARY84("SDAPPTSTARTDTTM")),"T",2)="" D ERRLOG^SDESJSON(.ERRORS,166) Q ;ISSUE INVALID ERROR MESSAGE IF NO TIME ENTERED
S ARY84("SDAPPTSTARTDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDAPPTSTARTDTTM"),ARY84("CLINICIEN"))
I ARY84("SDAPPTSTARTDTTM")=-1 D ERRLOG^SDESJSON(.ERRORS,166) Q
;
; appointment End Date and Time
S ARY84("SDAPPTENDDTTM")=$G(ARY84("SDAPPTENDDTTM"),"")
I ARY84("SDAPPTENDDTTM")="" D ERRLOG^SDESJSON(.ERRORS,167) Q
I $P($G(ARY84("SDAPPTENDDTTM")),"T",2)="" D ERRLOG^SDESJSON(.ERRORS,168) Q ;ISSUE INVALID ERROR MESSAGE IF NO TIME ENTERED
S ARY84("SDAPPTENDDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDAPPTENDDTTM"),ARY84("CLINICIEN"))
I ARY84("SDAPPTENDDTTM")=-1!($L(ARY84("SDAPPTENDDTTM"),".")=1) D ERRLOG^SDESJSON(.ERRORS,168) Q
I ARY84("SDAPPTSTARTDTTM")>ARY84("SDAPPTENDDTTM") D ERRLOG^SDESJSON(.ERRORS,13) Q
;
; patient DFN
S ARY84("DFN")=$G(ARY84("DFN"),"")
I ARY84("DFN")="" D ERRLOG^SDESJSON(.ERRORS,1) Q
I ARY84("DFN")'="",'$D(^DPT(+ARY84("DFN"),0)) D ERRLOG^SDESJSON(.ERRORS,2) Q
;
; clinic IEN
S ARY84("CLINICIEN")=$G(ARY84("CLINICIEN"),"")
I ARY84("CLINICIEN")="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I '$D(^SC(ARY84("CLINICIEN"),0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
;
; resource
N RESOURCE,SDTYP,MATCH
S ARY84("SDRESOURCE")=$G(ARY84("SDRESOURCE"),"")
I +ARY84("SDRESOURCE"),'$D(^SDEC(409.831,ARY84("SDRESOURCE"),0)) D ERRLOG^SDESJSON(.ERRORS,70) Q
I 'ARY84("SDRESOURCE") D
.S MATCH=0
.S RESOURCE="" F S RESOURCE=$O(^SDEC(409.831,"ALOC",ARY84("CLINICIEN"),RESOURCE)) Q:RESOURCE'>0!(MATCH>0) D
..S SDTYP=$$GET1^DIQ(409.831,RESOURCE_",",.012,"I")
..Q:$P(SDTYP,";",2)'="SC("
..S ARY84("SDRESOURCE")=RESOURCE
..S MATCH=1
;
I $$GET1^DIQ(409.831,$G(ARY84("SDRESOURCE")),.04,"I")'=$G(ARY84("CLINICIEN")) D ERRLOG^SDESJSON(.ERRORS,366) Q
;
; max days in future allowed to schedule in clinic
I $D(^SC(ARY84("CLINICIEN"),"SDP")) D
.S MAXDAYS=$$GET1^DIQ(44,ARY84("CLINICIEN"),2002)
.I MAXDAYS="" S MAXDAYS=390
I ARY84("SDAPPTSTARTDTTM")>$$FMADD^XLFDT($$NOW^XLFDT(),MAXDAYS) D ERRLOG^SDESJSON(.ERRORS,177) Q
;
; access Type ID
N TODAY
S ARY84("WALKIN")=$G(ARY84("WALKIN"),"")
I ARY84("WALKIN")'="",ARY84("WALKIN")'="y",ARY84("WALKIN")'="n" D ERRLOG^SDESJSON(.ERRORS,178) Q
S TODAY=$$NOW^XLFDT(),TODAY=$P(TODAY,"."),ARY84("SDAPPTSTARTDATE")=$P(ARY84("SDAPPTSTARTDTTM"),".") ;Check only the date
; added check for walkin - otherwise can't make appointment that isn't today - BLB - added new error code - DJS
I ARY84("WALKIN")="y",ARY84("SDAPPTSTARTDATE")<TODAY!(ARY84("SDAPPTSTARTDATE")>TODAY) D ERRLOG^SDESJSON(.ERRORS,166) Q
;
; desired Date of Appointment
S ARY84("SDESIREDTTM")=$G(ARY84("SDESIREDTTM"),"")
I ARY84("SDESIREDTTM")'="" S ARY84("SDESIREDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDESIREDTTM"),ARY84("CLINICIEN"))
I ARY84("SDESIREDTTM")=-1 D ERRLOG^SDESJSON(.ERRORS,58) Q
;
; appt request type
S ARY84("SDREQTYPE")=$G(ARY84("SDREQTYPE"),"")
I ARY84("SDREQTYPE")="" D ERRLOG^SDESJSON(.ERRORS,60) Q
I ";E;R;C;A;"'[(";"_$P(ARY84("SDREQTYPE"),"|",1)_";") D ERRLOG^SDESJSON(.ERRORS,61) Q
I +$P(ARY84("SDREQTYPE"),"|",2)=0 D ERRLOG^SDESJSON(.ERRORS,61) Q
I ARY84("SDREQTYPE")'="" D
.I $P(ARY84("SDREQTYPE"),"|",1)="E" I '$D(^SDWL(409.3,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
.I $P(ARY84("SDREQTYPE"),"|",1)="R" I '$D(^SD(403.5,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
.I $P(ARY84("SDREQTYPE"),"|",1)="C" I '$D(^GMR(123,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
.I $P(ARY84("SDREQTYPE"),"|",1)="A" I '$D(^SDEC(409.85,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
I ARY84("SDREQTYPE")="" D ERRLOG^SDESJSON(.ERRORS,61) Q
;ANU
I $P(ARY84("SDREQTYPE"),"|",1)="A",$$GET1^DIQ(409.85,+$P(ARY84("SDREQTYPE"),"|",2)_",",23,"I")="C" D ERRLOG^SDESJSON(.ERRORS,433) Q
I $P(ARY84("SDREQTYPE"),"|",1)="E",$$GET1^DIQ(409.3,+$P(ARY84("SDREQTYPE"),"|",2)_",",23,"I")="C" D ERRLOG^SDESJSON(.ERRORS,433) Q
S SDCONERR=0
I $P(ARY84("SDREQTYPE"),"|",1)="C" D
.I $$GET1^DIQ(123,+$P(ARY84("SDREQTYPE"),"|",2)_",",8,"E")'="PENDING",$$GET1^DIQ(123,+$P(ARY84("SDREQTYPE"),"|",2)_",",8,"E")'="ACTIVE" S SDCONERR=1
;
S IEN=$P(ARY84("SDREQTYPE"),"|",2)
I $P(ARY84("SDREQTYPE"),"|")="A" D
.I ARY84("DFN")'=$$GET1^DIQ(409.85,IEN,.01,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
I $P(ARY84("SDREQTYPE"),"|")="R" D
.I ARY84("DFN")'=$$GET1^DIQ(403.5,IEN,.01,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
I $P(ARY84("SDREQTYPE"),"|")="C" D
.I ARY84("DFN")'=$$GET1^DIQ(123,IEN,.02,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
;
I SDCONERR D ERRLOG^SDESJSON(.ERRORS,433) Q
;
; note
S ARY84("SDNOTE")=$G(ARY84("SDNOTE"),"") S:ARY84("SDNOTE")'="" ARY84("SDNOTE")=$TR($E(ARY84("SDNOTE"),1,150),"^"," ")
;
; appointment Type
I '$G(ARY84("SDAPPTYPE")),'$L($G(ARY84("SDAPPTNAME"))) D ERRLOG^SDESJSON(.ERRORS,306) Q
;
I '$G(ARY84("SDAPPTNAME")),$G(ARY84("SDAPPTYPE")) D
.I '$D(^SD(409.1,ARY84("SDAPPTYPE"),0)) D ERRLOG^SDESJSON(.ERRORS,180) Q
;
I $L($G(ARY84("SDAPPTNAME"))) D
.I '$D(^SD(409.1,"B",$G(ARY84("SDAPPTNAME")))) D ERRLOG^SDESJSON(.ERRORS,446) Q
.S TYPEIEN=0
.S ARY84("SDAPPTYPE")=$O(^SD(409.1,"B",ARY84("SDAPPTNAME"),TYPEIEN))
;
; patient Status
S ARY84("SDPATIENTSTATUS")=$G(ARY84("SDPATIENTSTATUS"))
I ARY84("SDPATIENTSTATUS")="" D
.I $P(ARY84("SDREQTYPE"),"|",1)="A" S ARY84("SDPATIENTSTATUS")=$$GET1^DIQ(409.3,$P(ARY84("SDREQTYPE"),"|",2)_",",.02,"I")
S ARY84("SDPATIENTSTATUS")=$S(ARY84("SDPATIENTSTATUS")="N":"N",ARY84("SDPATIENTSTATUS")="NEW":"N",ARY84("SDPATIENTSTATUS")="E":"E",ARY84("SDPATIENTSTATUS")="ESTABLISHED":"E",1:"")
;
; appt length - if passed in, must be 5-240
S ARY44("SDAPPTLENGTH")=$G(ARY84("SDAPPTLENGTH"),"")
I ARY84("SDAPPTLENGTH")="" D ERRLOG^SDESJSON(.ERRORS,115) Q
I ARY84("SDAPPTLENGTH")'="",((+ARY84("SDAPPTLENGTH")<5)!(+ARY84("SDAPPTLENGTH")>240)) D ERRLOG^SDESJSON(.ERRORS,116) Q
S TIMEDIFF=$$FMDIFF^XLFDT(ARY84("SDAPPTENDDTTM"),ARY84("SDAPPTSTARTDTTM"),2)/60
I TIMEDIFF'=ARY84("SDAPPTLENGTH") D ERRLOG^SDESJSON(.ERRORS,116) Q
;
; validate EAS
S ARY84("SDEAS")=$G(ARY84("SDEAS"),"")
I $L(ARY84("SDEAS")) S ARY84("SDEAS")=$$EASVALIDATE^SDESUTIL(ARY84("SDEAS"))
I $G(ARY84("SDEAS"))=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q
;
; validate provider
I $G(ARY84("SDPROVIEN")),'$D(^VA(200,+$G(ARY84("SDPROVIEN")),0)) D ERRLOG^SDESJSON(.ERRORS,54) Q
I '$G(ARY84("SDPROVIEN")) S ARY84("SDPROVIEN")=$$GETPROVIDER(ARY84("CLINICIEN"),$P(ARY84("SDREQTYPE"),"|",1),$P(ARY84("SDREQTYPE"),"|",2))
;
S ARY84("SDEXTERNALID")=$G(ARY84("SDEXTERNALID"),"")
;
;validate MTRC flag (optional)
S ARY84("SDMRTC")=$G(ARY84("SDMRTC"),"")
S ARY84("SDMRTC")=$$UP^XLFSTR($G(ARY84("SDMRTC")))
S ARY84("SDMRTC")=$S(ARY84("SDMRTC")="TRUE":1,1:0)
;
;validate parent
I ARY84("SDPARENT")'="" D
.I '$D(^SDEC(409.85,ARY84("SDPARENT"))) D ERRLOG^SDESJSON(.ERRORS,179) Q
.;ANU
.I $$GET1^DIQ(409.85,ARY84("SDPARENT")_",",23,"I")="C" D ERRLOG^SDESJSON(.ERRORS,433) Q
;
;validate service connected
S ARY84("SDSERVCONNPERC")=$G(ARY84("SDSERVCONNPERC"),"")
I ARY84("SDSERVCONNPERC")'="" S:(+ARY84("SDSERVCONNPERC")<0)!(+ARY84("SDSERVCONNPERC")>100) ARY84("SDSERVCONNPERC")=""
S ARY84("SDSERVCONN")=$G(ARY84("SDSERVCONN"),"")
S ARY84("SDSERVCONN")=$S(ARY84("SDSERVCONN")=0:0,ARY84("SDSERVCONN")="NO":0,ARY84("SDSERVCONN")=1:1,ARY84("SDSERVCONN")="YES":1,1:"")
;
Q
;
GETPROVIDER(CLINICIEN,REQUESTTYPE,REQUESTIEN) ;
N DEFAULTPROVIEN,PROVIDERIEN
;
I REQUESTTYPE="R" Q $$GET1^DIQ(403.54,$$GET1^DIQ(403.5,REQUESTIEN,4,"I"),.01,"I")
;
S PROVIDERIEN=0,DEFAULTPROVIEN=""
F S PROVIDERIEN=$O(^SC(CLINICIEN,"PR",PROVIDERIEN)) Q:'PROVIDERIEN!($G(DEFAULTPROVIEN)) D
.I $$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.02,"I") S DEFAULTPROVIEN=$$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.01,"I")
;
Q DEFAULTPROVIEN
;
CREATE(ARY84FDA,ARY84) ;
N SDREQTYPE
S SDREQTYPE=ARY84("SDREQTYPE")
S ARY84FDA(409.84,"+1,",.01)=$G(ARY84("SDAPPTSTARTDTTM"))
S ARY84FDA(409.84,"+1,",.02)=$G(ARY84("SDAPPTENDDTTM"))
S ARY84FDA(409.84,"+1,",.05)=$G(ARY84("DFN"))
S ARY84FDA(409.84,"+1,",.06)=$G(ARY84("SDAPPTYPE"))
S ARY84FDA(409.84,"+1,",.07)=$G(ARY84("SDRESOURCE"))
S ARY84FDA(409.84,"+1,",.08)=$G(DUZ)
S ARY84FDA(409.84,"+1,",.09)=$$NOW^XLFDT
S ARY84FDA(409.84,"+1,",.13)=$G(ARY84("WALKIN"))
S ARY84FDA(409.84,"+1,",.16)=$G(ARY84("SDPROVIEN"))
S ARY84FDA(409.84,"+1,",.18)=$G(ARY84("SDAPPTLENGTH"))
S ARY84FDA(409.84,"+1,",.2)=$G(ARY84("SDESIREDTTM"))
S ARY84FDA(409.84,"+1,",.21)=$G(ARY84("SDEXTERNALID"))
S ARY84FDA(409.84,"+1,",.22)=$S(SDREQTYPE'="":$P(SDREQTYPE,"|",2)_";"_$S($P(SDREQTYPE,"|",1)="E":"SDWL(409.3,",$P(SDREQTYPE,"|",1)="C":"GMR(123,",$P(SDREQTYPE,"|",1)="R":"SD(403.5,",$P(SDREQTYPE,"|",1)="A":"SDEC(409.85,",1:""),1:"")
S ARY84FDA(409.84,"+1,",.23)=$G(ARY84("SDPATIENTSTATUS"))
S ARY84FDA(409.84,"+1,",100)=$G(ARY84("SDEAS"))
Q
;
CLEANUP40984(ARY84,NEWIEN40984,APPTMSG) ;
N REQUEST
;file word processing field in NOTE (409.84,1)
K SDECMSG
I ARY84("SDNOTE")'="" N ARR D WP^SDECUTL(.ARR,ARY84("SDNOTE")) D WP^DIE(409.84,NEWIEN40984_",",1,"","ARR","SDECMSG")
S REQUESTIEN=$P(ARY84("SDREQTYPE"),"|",2)
;
;delete recall request if appointment made from recall
I $P(ARY84("SDREQTYPE"),"|",1)="R" D ; VSE-863 ;6/9/2021
.N SDCOMM,SDRET,SDRIEN1,SDRRFTR
.S SDRIEN1=$P(ARY84("SDREQTYPE"),"|",2)
.S SDCOMM=$$GET1^DIQ(403.5,SDRIEN1,2.5)
.S SDRRFTR="APPT SCHEDULED" ; "7"
.D RECDSET^SDEC52A(.SDRET,SDRIEN1,SDRRFTR,SDCOMM)
;
; add MRTC data to parent request
I $P(ARY84("SDREQTYPE"),"|",1)="A" D
.D BUILDAPPTDATA^SDESEDITAPPTREQ(REQUESTIEN,$G(ARY84("SDAPPTSTARTDTTM")),$G(ARY84("CLINICIEN")),$G(ARY84("SDSERVCONNPERC")),$G(ARY84("SDSERVCONN")),$G(ARY84("SDAPPTYPE")),$G(ARY84("SDEAS")),DUZ,.APPTMSG)
I $G(ARY84("SDPARENT")),$G(ARY84("SDMRTC")) D
.S REQUEST("MRTC","PATIENT INDICATED DATE")=$G(ARY84("SDESIREDTTM"))
.S REQUEST("MRTC","CHILD REQUEST")=REQUESTIEN
.S REQUEST("MRTC","MRTC APPOINTMENT")=$G(NEWIEN40984)
.D BUILDMRTCLINKS^SDESEDITAPPTREQ(.REQUEST,$G(ARY84("SDPARENT")))
.D BUILDMRTCPID^SDESEDITAPPTREQ(.REQUEST,$G(ARY84("SDPARENT")))
;
I $P(ARY84("SDREQTYPE"),"|",1)="C" D
.D REQSET^SDEC07A($P($G(ARY84("SDREQTYPE")),"|",2),$G(ARY84("SDPROVIEN")),"",1,"",$G(ARY84("SDNOTE")),$G(ARY84("SDAPPTSTARTDTTM")),$G(ARY84("SDRESOURCE")),$G(ARY84("DFN")))
.D UPDATECONSULTPID^SDES2APPTUTIL($P($G(ARY84("SDREQTYPE")),"|",2),$G(ARY84("SDESIREDTTM")),$G(ARY84("DFN")))
;add entry to OUTPATIENT ENCOUNTER file (#409.68) ;alb/sat 672
I $$NOW^XLFDT>ARY84("SDAPPTSTARTDTTM"),$$NEW^SDPCE(ARY84("SDAPPTSTARTDTTM")) D
.S ENCOUNTER=$$GETAPT^SDVSIT2(ARY84("DFN"),ARY84("SDAPPTSTARTDTTM"),ARY84("CLINICIEN"))
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCREATEAPPT 11542 printed Sep 23, 2025@20:33:11 Page 2
SDESCREATEAPPT ;ALB/BLB,MGD,DJS,ANU,BLB,TJB,BLB/TJB,LAB,TJB - CREATE APPOINTMENT RPC; JUN 17, 2024
+1 ;;5.3;Scheduling;**814,823,826,827,828,842,843,846,847,851,853,869,877,881**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;----------------- ----------------- ----------
+5 ;
+6 QUIT
+7 ;
+8 ; create appt in file 409.84. Called from wrapper level SDESCRTAPPTWRAP. See SDESCRTAPPTWRAP for required inputs.
+9 ;
VALIDATE(ERRORS,ARY84,ARY44) ; Validate input
+1 NEW MAXDAYS,SDECRNOD,RESOURCED,ENCOUNTER,REQUESTIEN,SDCONERR,SDAPPTSTARTDATE,IEN,TYPEIEN,TIMEDIFF
+2 ;
+3 ; appointment Start Date and Time
+4 SET ARY84("SDAPPTSTARTDTTM")=$GET(ARY84("SDAPPTSTARTDTTM"),"")
+5 IF ARY84("SDAPPTSTARTDTTM")=""
DO ERRLOG^SDESJSON(.ERRORS,165)
QUIT
+6 ;ISSUE INVALID ERROR MESSAGE IF NO TIME ENTERED
IF $PIECE($GET(ARY84("SDAPPTSTARTDTTM")),"T",2)=""
DO ERRLOG^SDESJSON(.ERRORS,166)
QUIT
+7 SET ARY84("SDAPPTSTARTDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDAPPTSTARTDTTM"),ARY84("CLINICIEN"))
+8 IF ARY84("SDAPPTSTARTDTTM")=-1
DO ERRLOG^SDESJSON(.ERRORS,166)
QUIT
+9 ;
+10 ; appointment End Date and Time
+11 SET ARY84("SDAPPTENDDTTM")=$GET(ARY84("SDAPPTENDDTTM"),"")
+12 IF ARY84("SDAPPTENDDTTM")=""
DO ERRLOG^SDESJSON(.ERRORS,167)
QUIT
+13 ;ISSUE INVALID ERROR MESSAGE IF NO TIME ENTERED
IF $PIECE($GET(ARY84("SDAPPTENDDTTM")),"T",2)=""
DO ERRLOG^SDESJSON(.ERRORS,168)
QUIT
+14 SET ARY84("SDAPPTENDDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDAPPTENDDTTM"),ARY84("CLINICIEN"))
+15 IF ARY84("SDAPPTENDDTTM")=-1!($LENGTH(ARY84("SDAPPTENDDTTM"),".")=1)
DO ERRLOG^SDESJSON(.ERRORS,168)
QUIT
+16 IF ARY84("SDAPPTSTARTDTTM")>ARY84("SDAPPTENDDTTM")
DO ERRLOG^SDESJSON(.ERRORS,13)
QUIT
+17 ;
+18 ; patient DFN
+19 SET ARY84("DFN")=$GET(ARY84("DFN"),"")
+20 IF ARY84("DFN")=""
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT
+21 IF ARY84("DFN")'=""
IF '$DATA(^DPT(+ARY84("DFN"),0))
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT
+22 ;
+23 ; clinic IEN
+24 SET ARY84("CLINICIEN")=$GET(ARY84("CLINICIEN"),"")
+25 IF ARY84("CLINICIEN")=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+26 IF '$DATA(^SC(ARY84("CLINICIEN"),0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+27 ;
+28 ; resource
+29 NEW RESOURCE,SDTYP,MATCH
+30 SET ARY84("SDRESOURCE")=$GET(ARY84("SDRESOURCE"),"")
+31 IF +ARY84("SDRESOURCE")
IF '$DATA(^SDEC(409.831,ARY84("SDRESOURCE"),0))
DO ERRLOG^SDESJSON(.ERRORS,70)
QUIT
+32 IF 'ARY84("SDRESOURCE")
Begin DoDot:1
+33 SET MATCH=0
+34 SET RESOURCE=""
FOR
SET RESOURCE=$ORDER(^SDEC(409.831,"ALOC",ARY84("CLINICIEN"),RESOURCE))
if RESOURCE'>0!(MATCH>0)
QUIT
Begin DoDot:2
+35 SET SDTYP=$$GET1^DIQ(409.831,RESOURCE_",",.012,"I")
+36 if $PIECE(SDTYP,";",2)'="SC("
QUIT
+37 SET ARY84("SDRESOURCE")=RESOURCE
+38 SET MATCH=1
End DoDot:2
End DoDot:1
+39 ;
+40 IF $$GET1^DIQ(409.831,$GET(ARY84("SDRESOURCE")),.04,"I")'=$GET(ARY84("CLINICIEN"))
DO ERRLOG^SDESJSON(.ERRORS,366)
QUIT
+41 ;
+42 ; max days in future allowed to schedule in clinic
+43 IF $DATA(^SC(ARY84("CLINICIEN"),"SDP"))
Begin DoDot:1
+44 SET MAXDAYS=$$GET1^DIQ(44,ARY84("CLINICIEN"),2002)
+45 IF MAXDAYS=""
SET MAXDAYS=390
End DoDot:1
+46 IF ARY84("SDAPPTSTARTDTTM")>$$FMADD^XLFDT($$NOW^XLFDT(),MAXDAYS)
DO ERRLOG^SDESJSON(.ERRORS,177)
QUIT
+47 ;
+48 ; access Type ID
+49 NEW TODAY
+50 SET ARY84("WALKIN")=$GET(ARY84("WALKIN"),"")
+51 IF ARY84("WALKIN")'=""
IF ARY84("WALKIN")'="y"
IF ARY84("WALKIN")'="n"
DO ERRLOG^SDESJSON(.ERRORS,178)
QUIT
+52 ;Check only the date
SET TODAY=$$NOW^XLFDT()
SET TODAY=$PIECE(TODAY,".")
SET ARY84("SDAPPTSTARTDATE")=$PIECE(ARY84("SDAPPTSTARTDTTM"),".")
+53 ; added check for walkin - otherwise can't make appointment that isn't today - BLB - added new error code - DJS
+54 IF ARY84("WALKIN")="y"
IF ARY84("SDAPPTSTARTDATE")<TODAY!(ARY84("SDAPPTSTARTDATE")>TODAY)
DO ERRLOG^SDESJSON(.ERRORS,166)
QUIT
+55 ;
+56 ; desired Date of Appointment
+57 SET ARY84("SDESIREDTTM")=$GET(ARY84("SDESIREDTTM"),"")
+58 IF ARY84("SDESIREDTTM")'=""
SET ARY84("SDESIREDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDESIREDTTM"),ARY84("CLINICIEN"))
+59 IF ARY84("SDESIREDTTM")=-1
DO ERRLOG^SDESJSON(.ERRORS,58)
QUIT
+60 ;
+61 ; appt request type
+62 SET ARY84("SDREQTYPE")=$GET(ARY84("SDREQTYPE"),"")
+63 IF ARY84("SDREQTYPE")=""
DO ERRLOG^SDESJSON(.ERRORS,60)
QUIT
+64 IF ";E;R;C;A;"'[(";"_$PIECE(ARY84("SDREQTYPE"),"|",1)_";")
DO ERRLOG^SDESJSON(.ERRORS,61)
QUIT
+65 IF +$PIECE(ARY84("SDREQTYPE"),"|",2)=0
DO ERRLOG^SDESJSON(.ERRORS,61)
QUIT
+66 IF ARY84("SDREQTYPE")'=""
Begin DoDot:1
+67 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="E"
IF '$DATA(^SDWL(409.3,+$PIECE(ARY84("SDREQTYPE"),"|",2),0))
SET ARY84("SDREQTYPE")=""
+68 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="R"
IF '$DATA(^SD(403.5,+$PIECE(ARY84("SDREQTYPE"),"|",2),0))
SET ARY84("SDREQTYPE")=""
+69 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="C"
IF '$DATA(^GMR(123,+$PIECE(ARY84("SDREQTYPE"),"|",2),0))
SET ARY84("SDREQTYPE")=""
+70 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="A"
IF '$DATA(^SDEC(409.85,+$PIECE(ARY84("SDREQTYPE"),"|",2),0))
SET ARY84("SDREQTYPE")=""
End DoDot:1
+71 IF ARY84("SDREQTYPE")=""
DO ERRLOG^SDESJSON(.ERRORS,61)
QUIT
+72 ;ANU
+73 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="A"
IF $$GET1^DIQ(409.85,+$PIECE(ARY84("SDREQTYPE"),"|",2)_",",23,"I")="C"
DO ERRLOG^SDESJSON(.ERRORS,433)
QUIT
+74 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="E"
IF $$GET1^DIQ(409.3,+$PIECE(ARY84("SDREQTYPE"),"|",2)_",",23,"I")="C"
DO ERRLOG^SDESJSON(.ERRORS,433)
QUIT
+75 SET SDCONERR=0
+76 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="C"
Begin DoDot:1
+77 IF $$GET1^DIQ(123,+$PIECE(ARY84("SDREQTYPE"),"|",2)_",",8,"E")'="PENDING"
IF $$GET1^DIQ(123,+$PIECE(ARY84("SDREQTYPE"),"|",2)_",",8,"E")'="ACTIVE"
SET SDCONERR=1
End DoDot:1
+78 ;
+79 SET IEN=$PIECE(ARY84("SDREQTYPE"),"|",2)
+80 IF $PIECE(ARY84("SDREQTYPE"),"|")="A"
Begin DoDot:1
+81 IF ARY84("DFN")'=$$GET1^DIQ(409.85,IEN,.01,"I")
DO ERRLOG^SDESJSON(.ERRORS,447)
QUIT
End DoDot:1
+82 IF $PIECE(ARY84("SDREQTYPE"),"|")="R"
Begin DoDot:1
+83 IF ARY84("DFN")'=$$GET1^DIQ(403.5,IEN,.01,"I")
DO ERRLOG^SDESJSON(.ERRORS,447)
QUIT
End DoDot:1
+84 IF $PIECE(ARY84("SDREQTYPE"),"|")="C"
Begin DoDot:1
+85 IF ARY84("DFN")'=$$GET1^DIQ(123,IEN,.02,"I")
DO ERRLOG^SDESJSON(.ERRORS,447)
QUIT
End DoDot:1
+86 ;
+87 IF SDCONERR
DO ERRLOG^SDESJSON(.ERRORS,433)
QUIT
+88 ;
+89 ; note
+90 SET ARY84("SDNOTE")=$GET(ARY84("SDNOTE"),"")
if ARY84("SDNOTE")'=""
SET ARY84("SDNOTE")=$TRANSLATE($EXTRACT(ARY84("SDNOTE"),1,150),"^"," ")
+91 ;
+92 ; appointment Type
+93 IF '$GET(ARY84("SDAPPTYPE"))
IF '$LENGTH($GET(ARY84("SDAPPTNAME")))
DO ERRLOG^SDESJSON(.ERRORS,306)
QUIT
+94 ;
+95 IF '$GET(ARY84("SDAPPTNAME"))
IF $GET(ARY84("SDAPPTYPE"))
Begin DoDot:1
+96 IF '$DATA(^SD(409.1,ARY84("SDAPPTYPE"),0))
DO ERRLOG^SDESJSON(.ERRORS,180)
QUIT
End DoDot:1
+97 ;
+98 IF $LENGTH($GET(ARY84("SDAPPTNAME")))
Begin DoDot:1
+99 IF '$DATA(^SD(409.1,"B",$GET(ARY84("SDAPPTNAME"))))
DO ERRLOG^SDESJSON(.ERRORS,446)
QUIT
+100 SET TYPEIEN=0
+101 SET ARY84("SDAPPTYPE")=$ORDER(^SD(409.1,"B",ARY84("SDAPPTNAME"),TYPEIEN))
End DoDot:1
+102 ;
+103 ; patient Status
+104 SET ARY84("SDPATIENTSTATUS")=$GET(ARY84("SDPATIENTSTATUS"))
+105 IF ARY84("SDPATIENTSTATUS")=""
Begin DoDot:1
+106 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="A"
SET ARY84("SDPATIENTSTATUS")=$$GET1^DIQ(409.3,$PIECE(ARY84("SDREQTYPE"),"|",2)_",",.02,"I")
End DoDot:1
+107 SET ARY84("SDPATIENTSTATUS")=$SELECT(ARY84("SDPATIENTSTATUS")="N":"N",ARY84("SDPATIENTSTATUS")="NEW":"N",ARY84("SDPATIENTSTATUS")="E":"E",ARY84("SDPATIENTSTATUS")="ESTABLISHED":"E",1:"")
+108 ;
+109 ; appt length - if passed in, must be 5-240
+110 SET ARY44("SDAPPTLENGTH")=$GET(ARY84("SDAPPTLENGTH"),"")
+111 IF ARY84("SDAPPTLENGTH")=""
DO ERRLOG^SDESJSON(.ERRORS,115)
QUIT
+112 IF ARY84("SDAPPTLENGTH")'=""
IF ((+ARY84("SDAPPTLENGTH")<5)!(+ARY84("SDAPPTLENGTH")>240))
DO ERRLOG^SDESJSON(.ERRORS,116)
QUIT
+113 SET TIMEDIFF=$$FMDIFF^XLFDT(ARY84("SDAPPTENDDTTM"),ARY84("SDAPPTSTARTDTTM"),2)/60
+114 IF TIMEDIFF'=ARY84("SDAPPTLENGTH")
DO ERRLOG^SDESJSON(.ERRORS,116)
QUIT
+115 ;
+116 ; validate EAS
+117 SET ARY84("SDEAS")=$GET(ARY84("SDEAS"),"")
+118 IF $LENGTH(ARY84("SDEAS"))
SET ARY84("SDEAS")=$$EASVALIDATE^SDESUTIL(ARY84("SDEAS"))
+119 IF $GET(ARY84("SDEAS"))=-1
DO ERRLOG^SDESJSON(.ERRORS,142)
QUIT
+120 ;
+121 ; validate provider
+122 IF $GET(ARY84("SDPROVIEN"))
IF '$DATA(^VA(200,+$GET(ARY84("SDPROVIEN")),0))
DO ERRLOG^SDESJSON(.ERRORS,54)
QUIT
+123 IF '$GET(ARY84("SDPROVIEN"))
SET ARY84("SDPROVIEN")=$$GETPROVIDER(ARY84("CLINICIEN"),$PIECE(ARY84("SDREQTYPE"),"|",1),$PIECE(ARY84("SDREQTYPE"),"|",2))
+124 ;
+125 SET ARY84("SDEXTERNALID")=$GET(ARY84("SDEXTERNALID"),"")
+126 ;
+127 ;validate MTRC flag (optional)
+128 SET ARY84("SDMRTC")=$GET(ARY84("SDMRTC"),"")
+129 SET ARY84("SDMRTC")=$$UP^XLFSTR($GET(ARY84("SDMRTC")))
+130 SET ARY84("SDMRTC")=$SELECT(ARY84("SDMRTC")="TRUE":1,1:0)
+131 ;
+132 ;validate parent
+133 IF ARY84("SDPARENT")'=""
Begin DoDot:1
+134 IF '$DATA(^SDEC(409.85,ARY84("SDPARENT")))
DO ERRLOG^SDESJSON(.ERRORS,179)
QUIT
+135 ;ANU
+136 IF $$GET1^DIQ(409.85,ARY84("SDPARENT")_",",23,"I")="C"
DO ERRLOG^SDESJSON(.ERRORS,433)
QUIT
End DoDot:1
+137 ;
+138 ;validate service connected
+139 SET ARY84("SDSERVCONNPERC")=$GET(ARY84("SDSERVCONNPERC"),"")
+140 IF ARY84("SDSERVCONNPERC")'=""
if (+ARY84("SDSERVCONNPERC")<0)!(+ARY84("SDSERVCONNPERC")>100)
SET ARY84("SDSERVCONNPERC")=""
+141 SET ARY84("SDSERVCONN")=$GET(ARY84("SDSERVCONN"),"")
+142 SET ARY84("SDSERVCONN")=$SELECT(ARY84("SDSERVCONN")=0:0,ARY84("SDSERVCONN")="NO":0,ARY84("SDSERVCONN")=1:1,ARY84("SDSERVCONN")="YES":1,1:"")
+143 ;
+144 QUIT
+145 ;
GETPROVIDER(CLINICIEN,REQUESTTYPE,REQUESTIEN) ;
+1 NEW DEFAULTPROVIEN,PROVIDERIEN
+2 ;
+3 IF REQUESTTYPE="R"
QUIT $$GET1^DIQ(403.54,$$GET1^DIQ(403.5,REQUESTIEN,4,"I"),.01,"I")
+4 ;
+5 SET PROVIDERIEN=0
SET DEFAULTPROVIEN=""
+6 FOR
SET PROVIDERIEN=$ORDER(^SC(CLINICIEN,"PR",PROVIDERIEN))
if 'PROVIDERIEN!($GET(DEFAULTPROVIEN))
QUIT
Begin DoDot:1
+7 IF $$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.02,"I")
SET DEFAULTPROVIEN=$$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.01,"I")
End DoDot:1
+8 ;
+9 QUIT DEFAULTPROVIEN
+10 ;
CREATE(ARY84FDA,ARY84) ;
+1 NEW SDREQTYPE
+2 SET SDREQTYPE=ARY84("SDREQTYPE")
+3 SET ARY84FDA(409.84,"+1,",.01)=$GET(ARY84("SDAPPTSTARTDTTM"))
+4 SET ARY84FDA(409.84,"+1,",.02)=$GET(ARY84("SDAPPTENDDTTM"))
+5 SET ARY84FDA(409.84,"+1,",.05)=$GET(ARY84("DFN"))
+6 SET ARY84FDA(409.84,"+1,",.06)=$GET(ARY84("SDAPPTYPE"))
+7 SET ARY84FDA(409.84,"+1,",.07)=$GET(ARY84("SDRESOURCE"))
+8 SET ARY84FDA(409.84,"+1,",.08)=$GET(DUZ)
+9 SET ARY84FDA(409.84,"+1,",.09)=$$NOW^XLFDT
+10 SET ARY84FDA(409.84,"+1,",.13)=$GET(ARY84("WALKIN"))
+11 SET ARY84FDA(409.84,"+1,",.16)=$GET(ARY84("SDPROVIEN"))
+12 SET ARY84FDA(409.84,"+1,",.18)=$GET(ARY84("SDAPPTLENGTH"))
+13 SET ARY84FDA(409.84,"+1,",.2)=$GET(ARY84("SDESIREDTTM"))
+14 SET ARY84FDA(409.84,"+1,",.21)=$GET(ARY84("SDEXTERNALID"))
+15 SET ARY84FDA(409.84,"+1,",.22)=$SELECT(SDREQTYPE'="":$PIECE(SDREQTYPE,"|",2)_";"_$SELECT($PIECE(SDREQTYPE,"|",1)="E":"SDWL(409.3,",...
... $PIECE(SDREQTYPE,"|",1)="C":"GMR(123,",$PIECE(SDREQTYPE,"|",1)="R":"SD(403.5,",$PIECE(SDREQTYPE,"|",1)="A":"SDEC(409.85,",1:""),1:"")
+16 SET ARY84FDA(409.84,"+1,",.23)=$GET(ARY84("SDPATIENTSTATUS"))
+17 SET ARY84FDA(409.84,"+1,",100)=$GET(ARY84("SDEAS"))
+18 QUIT
+19 ;
CLEANUP40984(ARY84,NEWIEN40984,APPTMSG) ;
+1 NEW REQUEST
+2 ;file word processing field in NOTE (409.84,1)
+3 KILL SDECMSG
+4 IF ARY84("SDNOTE")'=""
NEW ARR
DO WP^SDECUTL(.ARR,ARY84("SDNOTE"))
DO WP^DIE(409.84,NEWIEN40984_",",1,"","ARR","SDECMSG")
+5 SET REQUESTIEN=$PIECE(ARY84("SDREQTYPE"),"|",2)
+6 ;
+7 ;delete recall request if appointment made from recall
+8 ; VSE-863 ;6/9/2021
IF $PIECE(ARY84("SDREQTYPE"),"|",1)="R"
Begin DoDot:1
+9 NEW SDCOMM,SDRET,SDRIEN1,SDRRFTR
+10 SET SDRIEN1=$PIECE(ARY84("SDREQTYPE"),"|",2)
+11 SET SDCOMM=$$GET1^DIQ(403.5,SDRIEN1,2.5)
+12 ; "7"
SET SDRRFTR="APPT SCHEDULED"
+13 DO RECDSET^SDEC52A(.SDRET,SDRIEN1,SDRRFTR,SDCOMM)
End DoDot:1
+14 ;
+15 ; add MRTC data to parent request
+16 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="A"
Begin DoDot:1
+17 DO BUILDAPPTDATA^SDESEDITAPPTREQ(REQUESTIEN,$GET(ARY84("SDAPPTSTARTDTTM")),$GET(ARY84("CLINICIEN")),$GET(ARY84("SDSERVCONNPERC")),$GET(ARY84("SDSERVCONN")),$GET(ARY84("SDAPPTYPE")),$GET(ARY84("SDEAS")),DUZ,.APPTMSG)
End DoDot:1
+18 IF $GET(ARY84("SDPARENT"))
IF $GET(ARY84("SDMRTC"))
Begin DoDot:1
+19 SET REQUEST("MRTC","PATIENT INDICATED DATE")=$GET(ARY84("SDESIREDTTM"))
+20 SET REQUEST("MRTC","CHILD REQUEST")=REQUESTIEN
+21 SET REQUEST("MRTC","MRTC APPOINTMENT")=$GET(NEWIEN40984)
+22 DO BUILDMRTCLINKS^SDESEDITAPPTREQ(.REQUEST,$GET(ARY84("SDPARENT")))
+23 DO BUILDMRTCPID^SDESEDITAPPTREQ(.REQUEST,$GET(ARY84("SDPARENT")))
End DoDot:1
+24 ;
+25 IF $PIECE(ARY84("SDREQTYPE"),"|",1)="C"
Begin DoDot:1
+26 DO REQSET^SDEC07A($PIECE($GET(ARY84("SDREQTYPE")),"|",2),$GET(ARY84("SDPROVIEN")),"",1,"",$GET(ARY84("SDNOTE")),$GET(ARY84("SDAPPTSTARTDTTM")),$GET(ARY84("SDRESOURCE")),$GET(ARY84("DFN")))
+27 DO UPDATECONSULTPID^SDES2APPTUTIL($PIECE($GET(ARY84("SDREQTYPE")),"|",2),$GET(ARY84("SDESIREDTTM")),$GET(ARY84("DFN")))
End DoDot:1
+28 ;add entry to OUTPATIENT ENCOUNTER file (#409.68) ;alb/sat 672
+29 IF $$NOW^XLFDT>ARY84("SDAPPTSTARTDTTM")
IF $$NEW^SDPCE(ARY84("SDAPPTSTARTDTTM"))
Begin DoDot:1
+30 SET ENCOUNTER=$$GETAPT^SDVSIT2(ARY84("DFN"),ARY84("SDAPPTSTARTDTTM"),ARY84("CLINICIEN"))
End DoDot:1
+31 ;
+32 QUIT
+33 ;
