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

SDESCREATEAPPT.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ;----------------- ----------------- ----------
  1.  ;
  1.  Q
  1.  ;
  1.  ; create appt in file 409.84. Called from wrapper level SDESCRTAPPTWRAP. See SDESCRTAPPTWRAP for required inputs.
  1.  ;
  1. VALIDATE(ERRORS,ARY84,ARY44) ; Validate input
  1.  N MAXDAYS,SDECRNOD,RESOURCED,ENCOUNTER,REQUESTIEN,SDCONERR,SDAPPTSTARTDATE,IEN,TYPEIEN,TIMEDIFF
  1.  ;
  1.  ; appointment Start Date and Time
  1.  S ARY84("SDAPPTSTARTDTTM")=$G(ARY84("SDAPPTSTARTDTTM"),"")
  1.  I ARY84("SDAPPTSTARTDTTM")="" D ERRLOG^SDESJSON(.ERRORS,165) Q
  1.  I $P($G(ARY84("SDAPPTSTARTDTTM")),"T",2)="" D ERRLOG^SDESJSON(.ERRORS,166) Q  ;ISSUE INVALID ERROR MESSAGE IF NO TIME ENTERED
  1.  S ARY84("SDAPPTSTARTDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDAPPTSTARTDTTM"),ARY84("CLINICIEN"))
  1.  I ARY84("SDAPPTSTARTDTTM")=-1 D ERRLOG^SDESJSON(.ERRORS,166) Q
  1.  ;
  1.  ; appointment End Date and Time
  1.  S ARY84("SDAPPTENDDTTM")=$G(ARY84("SDAPPTENDDTTM"),"")
  1.  I ARY84("SDAPPTENDDTTM")="" D ERRLOG^SDESJSON(.ERRORS,167) Q
  1.  I $P($G(ARY84("SDAPPTENDDTTM")),"T",2)="" D ERRLOG^SDESJSON(.ERRORS,168) Q  ;ISSUE INVALID ERROR MESSAGE IF NO TIME ENTERED
  1.  S ARY84("SDAPPTENDDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDAPPTENDDTTM"),ARY84("CLINICIEN"))
  1.  I ARY84("SDAPPTENDDTTM")=-1!($L(ARY84("SDAPPTENDDTTM"),".")=1) D ERRLOG^SDESJSON(.ERRORS,168) Q
  1.  I ARY84("SDAPPTSTARTDTTM")>ARY84("SDAPPTENDDTTM") D ERRLOG^SDESJSON(.ERRORS,13) Q
  1.  ;
  1.  ; patient DFN
  1.  S ARY84("DFN")=$G(ARY84("DFN"),"")
  1.  I ARY84("DFN")="" D ERRLOG^SDESJSON(.ERRORS,1) Q
  1.  I ARY84("DFN")'="",'$D(^DPT(+ARY84("DFN"),0)) D ERRLOG^SDESJSON(.ERRORS,2) Q
  1.  ;
  1.  ; clinic IEN
  1.  S ARY84("CLINICIEN")=$G(ARY84("CLINICIEN"),"")
  1.  I ARY84("CLINICIEN")="" D ERRLOG^SDESJSON(.ERRORS,18) Q
  1.  I '$D(^SC(ARY84("CLINICIEN"),0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
  1.  ;
  1.  ; resource
  1.  N RESOURCE,SDTYP,MATCH
  1.  S ARY84("SDRESOURCE")=$G(ARY84("SDRESOURCE"),"")
  1.  I +ARY84("SDRESOURCE"),'$D(^SDEC(409.831,ARY84("SDRESOURCE"),0)) D ERRLOG^SDESJSON(.ERRORS,70) Q
  1.  I 'ARY84("SDRESOURCE") D
  1.  .S MATCH=0
  1.  .S RESOURCE="" F  S RESOURCE=$O(^SDEC(409.831,"ALOC",ARY84("CLINICIEN"),RESOURCE)) Q:RESOURCE'>0!(MATCH>0)  D
  1.  ..S SDTYP=$$GET1^DIQ(409.831,RESOURCE_",",.012,"I")
  1.  ..Q:$P(SDTYP,";",2)'="SC("
  1.  ..S ARY84("SDRESOURCE")=RESOURCE
  1.  ..S MATCH=1
  1.  ;
  1.  I $$GET1^DIQ(409.831,$G(ARY84("SDRESOURCE")),.04,"I")'=$G(ARY84("CLINICIEN")) D ERRLOG^SDESJSON(.ERRORS,366) Q
  1.  ;
  1.  ; max days in future allowed to schedule in clinic
  1.  I $D(^SC(ARY84("CLINICIEN"),"SDP")) D
  1.  .S MAXDAYS=$$GET1^DIQ(44,ARY84("CLINICIEN"),2002)
  1.  .I MAXDAYS="" S MAXDAYS=390
  1.  I ARY84("SDAPPTSTARTDTTM")>$$FMADD^XLFDT($$NOW^XLFDT(),MAXDAYS) D ERRLOG^SDESJSON(.ERRORS,177) Q
  1.  ;
  1.  ; access Type ID
  1.  N TODAY
  1.  S ARY84("WALKIN")=$G(ARY84("WALKIN"),"")
  1.  I ARY84("WALKIN")'="",ARY84("WALKIN")'="y",ARY84("WALKIN")'="n" D ERRLOG^SDESJSON(.ERRORS,178) Q
  1.  S TODAY=$$NOW^XLFDT(),TODAY=$P(TODAY,"."),ARY84("SDAPPTSTARTDATE")=$P(ARY84("SDAPPTSTARTDTTM"),".")   ;Check only the date
  1.  ; added check for walkin - otherwise can't make appointment that isn't today - BLB - added new error code - DJS
  1.  I ARY84("WALKIN")="y",ARY84("SDAPPTSTARTDATE")<TODAY!(ARY84("SDAPPTSTARTDATE")>TODAY) D ERRLOG^SDESJSON(.ERRORS,166) Q
  1.  ;
  1.  ; desired Date of Appointment
  1.  S ARY84("SDESIREDTTM")=$G(ARY84("SDESIREDTTM"),"")
  1.  I ARY84("SDESIREDTTM")'="" S ARY84("SDESIREDTTM")=$$ISOTFM^SDAMUTDT(ARY84("SDESIREDTTM"),ARY84("CLINICIEN"))
  1.  I ARY84("SDESIREDTTM")=-1 D ERRLOG^SDESJSON(.ERRORS,58) Q
  1.  ;
  1.  ; appt request type
  1.  S ARY84("SDREQTYPE")=$G(ARY84("SDREQTYPE"),"")
  1.  I ARY84("SDREQTYPE")="" D ERRLOG^SDESJSON(.ERRORS,60) Q
  1.  I ";E;R;C;A;"'[(";"_$P(ARY84("SDREQTYPE"),"|",1)_";") D ERRLOG^SDESJSON(.ERRORS,61) Q
  1.  I +$P(ARY84("SDREQTYPE"),"|",2)=0 D ERRLOG^SDESJSON(.ERRORS,61) Q
  1.  I ARY84("SDREQTYPE")'="" D
  1.  .I $P(ARY84("SDREQTYPE"),"|",1)="E" I '$D(^SDWL(409.3,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
  1.  .I $P(ARY84("SDREQTYPE"),"|",1)="R" I '$D(^SD(403.5,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
  1.  .I $P(ARY84("SDREQTYPE"),"|",1)="C" I '$D(^GMR(123,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
  1.  .I $P(ARY84("SDREQTYPE"),"|",1)="A" I '$D(^SDEC(409.85,+$P(ARY84("SDREQTYPE"),"|",2),0)) S ARY84("SDREQTYPE")=""
  1.  I ARY84("SDREQTYPE")="" D ERRLOG^SDESJSON(.ERRORS,61) Q
  1.  ;ANU
  1.  I $P(ARY84("SDREQTYPE"),"|",1)="A",$$GET1^DIQ(409.85,+$P(ARY84("SDREQTYPE"),"|",2)_",",23,"I")="C" D ERRLOG^SDESJSON(.ERRORS,433) Q
  1.  I $P(ARY84("SDREQTYPE"),"|",1)="E",$$GET1^DIQ(409.3,+$P(ARY84("SDREQTYPE"),"|",2)_",",23,"I")="C" D ERRLOG^SDESJSON(.ERRORS,433) Q
  1.  S SDCONERR=0
  1.  I $P(ARY84("SDREQTYPE"),"|",1)="C" D
  1.  .I $$GET1^DIQ(123,+$P(ARY84("SDREQTYPE"),"|",2)_",",8,"E")'="PENDING",$$GET1^DIQ(123,+$P(ARY84("SDREQTYPE"),"|",2)_",",8,"E")'="ACTIVE" S SDCONERR=1
  1.  ;
  1.  S IEN=$P(ARY84("SDREQTYPE"),"|",2)
  1.  I $P(ARY84("SDREQTYPE"),"|")="A" D
  1.  .I ARY84("DFN")'=$$GET1^DIQ(409.85,IEN,.01,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
  1.  I $P(ARY84("SDREQTYPE"),"|")="R" D
  1.  .I ARY84("DFN")'=$$GET1^DIQ(403.5,IEN,.01,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
  1.  I $P(ARY84("SDREQTYPE"),"|")="C" D
  1.  .I ARY84("DFN")'=$$GET1^DIQ(123,IEN,.02,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
  1.  ;
  1.  I SDCONERR D ERRLOG^SDESJSON(.ERRORS,433) Q
  1.  ;
  1.  ; note
  1.  S ARY84("SDNOTE")=$G(ARY84("SDNOTE"),"") S:ARY84("SDNOTE")'="" ARY84("SDNOTE")=$TR($E(ARY84("SDNOTE"),1,150),"^"," ")
  1.  ;
  1.  ; appointment Type
  1.  I '$G(ARY84("SDAPPTYPE")),'$L($G(ARY84("SDAPPTNAME"))) D ERRLOG^SDESJSON(.ERRORS,306) Q
  1.  ;
  1.  I '$G(ARY84("SDAPPTNAME")),$G(ARY84("SDAPPTYPE")) D
  1.  .I '$D(^SD(409.1,ARY84("SDAPPTYPE"),0)) D ERRLOG^SDESJSON(.ERRORS,180) Q
  1.  ;
  1.  I $L($G(ARY84("SDAPPTNAME"))) D
  1.  .I '$D(^SD(409.1,"B",$G(ARY84("SDAPPTNAME")))) D ERRLOG^SDESJSON(.ERRORS,446) Q
  1.  .S TYPEIEN=0
  1.  .S ARY84("SDAPPTYPE")=$O(^SD(409.1,"B",ARY84("SDAPPTNAME"),TYPEIEN))
  1.  ;
  1.  ; patient Status
  1.  S ARY84("SDPATIENTSTATUS")=$G(ARY84("SDPATIENTSTATUS"))
  1.  I ARY84("SDPATIENTSTATUS")="" D
  1.  .I $P(ARY84("SDREQTYPE"),"|",1)="A" S ARY84("SDPATIENTSTATUS")=$$GET1^DIQ(409.3,$P(ARY84("SDREQTYPE"),"|",2)_",",.02,"I")
  1.  S ARY84("SDPATIENTSTATUS")=$S(ARY84("SDPATIENTSTATUS")="N":"N",ARY84("SDPATIENTSTATUS")="NEW":"N",ARY84("SDPATIENTSTATUS")="E":"E",ARY84("SDPATIENTSTATUS")="ESTABLISHED":"E",1:"")
  1.  ;
  1.  ; appt length - if passed in, must be 5-240
  1.  S ARY44("SDAPPTLENGTH")=$G(ARY84("SDAPPTLENGTH"),"")
  1.  I ARY84("SDAPPTLENGTH")="" D ERRLOG^SDESJSON(.ERRORS,115) Q
  1.  I ARY84("SDAPPTLENGTH")'="",((+ARY84("SDAPPTLENGTH")<5)!(+ARY84("SDAPPTLENGTH")>240)) D ERRLOG^SDESJSON(.ERRORS,116) Q
  1.  S TIMEDIFF=$$FMDIFF^XLFDT(ARY84("SDAPPTENDDTTM"),ARY84("SDAPPTSTARTDTTM"),2)/60
  1.  I TIMEDIFF'=ARY84("SDAPPTLENGTH") D ERRLOG^SDESJSON(.ERRORS,116) Q
  1.  ;
  1.  ; validate EAS
  1.  S ARY84("SDEAS")=$G(ARY84("SDEAS"),"")
  1.  I $L(ARY84("SDEAS")) S ARY84("SDEAS")=$$EASVALIDATE^SDESUTIL(ARY84("SDEAS"))
  1.  I $G(ARY84("SDEAS"))=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q
  1.  ;
  1.  ; validate provider
  1.  I $G(ARY84("SDPROVIEN")),'$D(^VA(200,+$G(ARY84("SDPROVIEN")),0)) D ERRLOG^SDESJSON(.ERRORS,54) Q
  1.  I '$G(ARY84("SDPROVIEN")) S ARY84("SDPROVIEN")=$$GETPROVIDER(ARY84("CLINICIEN"),$P(ARY84("SDREQTYPE"),"|",1),$P(ARY84("SDREQTYPE"),"|",2))
  1.  ;
  1.  S ARY84("SDEXTERNALID")=$G(ARY84("SDEXTERNALID"),"")
  1.  ;
  1.  ;validate MTRC flag (optional)
  1.  S ARY84("SDMRTC")=$G(ARY84("SDMRTC"),"")
  1.  S ARY84("SDMRTC")=$$UP^XLFSTR($G(ARY84("SDMRTC")))
  1.  S ARY84("SDMRTC")=$S(ARY84("SDMRTC")="TRUE":1,1:0)
  1.  ;
  1.  ;validate parent
  1.  I ARY84("SDPARENT")'="" D
  1.  .I '$D(^SDEC(409.85,ARY84("SDPARENT"))) D ERRLOG^SDESJSON(.ERRORS,179) Q
  1.  .;ANU
  1.  .I $$GET1^DIQ(409.85,ARY84("SDPARENT")_",",23,"I")="C" D ERRLOG^SDESJSON(.ERRORS,433) Q
  1.  ;
  1.  ;validate service connected
  1.  S ARY84("SDSERVCONNPERC")=$G(ARY84("SDSERVCONNPERC"),"")
  1.  I ARY84("SDSERVCONNPERC")'="" S:(+ARY84("SDSERVCONNPERC")<0)!(+ARY84("SDSERVCONNPERC")>100) ARY84("SDSERVCONNPERC")=""
  1.  S ARY84("SDSERVCONN")=$G(ARY84("SDSERVCONN"),"")
  1.  S ARY84("SDSERVCONN")=$S(ARY84("SDSERVCONN")=0:0,ARY84("SDSERVCONN")="NO":0,ARY84("SDSERVCONN")=1:1,ARY84("SDSERVCONN")="YES":1,1:"")
  1.  ;
  1.  Q
  1.  ;
  1. GETPROVIDER(CLINICIEN,REQUESTTYPE,REQUESTIEN) ;
  1.  N DEFAULTPROVIEN,PROVIDERIEN
  1.  ;
  1.  I REQUESTTYPE="R" Q $$GET1^DIQ(403.54,$$GET1^DIQ(403.5,REQUESTIEN,4,"I"),.01,"I")
  1.  ;
  1.  S PROVIDERIEN=0,DEFAULTPROVIEN=""
  1.  F  S PROVIDERIEN=$O(^SC(CLINICIEN,"PR",PROVIDERIEN)) Q:'PROVIDERIEN!($G(DEFAULTPROVIEN))  D
  1.  .I $$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.02,"I") S DEFAULTPROVIEN=$$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.01,"I")
  1.  ;
  1.  Q DEFAULTPROVIEN
  1.  ;
  1. CREATE(ARY84FDA,ARY84) ;
  1.  N SDREQTYPE
  1.  S SDREQTYPE=ARY84("SDREQTYPE")
  1.  S ARY84FDA(409.84,"+1,",.01)=$G(ARY84("SDAPPTSTARTDTTM"))
  1.  S ARY84FDA(409.84,"+1,",.02)=$G(ARY84("SDAPPTENDDTTM"))
  1.  S ARY84FDA(409.84,"+1,",.05)=$G(ARY84("DFN"))
  1.  S ARY84FDA(409.84,"+1,",.06)=$G(ARY84("SDAPPTYPE"))
  1.  S ARY84FDA(409.84,"+1,",.07)=$G(ARY84("SDRESOURCE"))
  1.  S ARY84FDA(409.84,"+1,",.08)=$G(DUZ)
  1.  S ARY84FDA(409.84,"+1,",.09)=$$NOW^XLFDT
  1.  S ARY84FDA(409.84,"+1,",.13)=$G(ARY84("WALKIN"))
  1.  S ARY84FDA(409.84,"+1,",.16)=$G(ARY84("SDPROVIEN"))
  1.  S ARY84FDA(409.84,"+1,",.18)=$G(ARY84("SDAPPTLENGTH"))
  1.  S ARY84FDA(409.84,"+1,",.2)=$G(ARY84("SDESIREDTTM"))
  1.  S ARY84FDA(409.84,"+1,",.21)=$G(ARY84("SDEXTERNALID"))
  1.  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:"")
  1.  S ARY84FDA(409.84,"+1,",.23)=$G(ARY84("SDPATIENTSTATUS"))
  1.  S ARY84FDA(409.84,"+1,",100)=$G(ARY84("SDEAS"))
  1.  Q
  1.  ;
  1. CLEANUP40984(ARY84,NEWIEN40984,APPTMSG) ;
  1.  N REQUEST
  1.  ;file word processing field in NOTE (409.84,1)
  1.  K SDECMSG
  1.  I ARY84("SDNOTE")'="" N ARR D WP^SDECUTL(.ARR,ARY84("SDNOTE")) D WP^DIE(409.84,NEWIEN40984_",",1,"","ARR","SDECMSG")
  1.  S REQUESTIEN=$P(ARY84("SDREQTYPE"),"|",2)
  1.  ;
  1.  ;delete recall request if appointment made from recall
  1.  I $P(ARY84("SDREQTYPE"),"|",1)="R" D  ; VSE-863 ;6/9/2021
  1.  .N SDCOMM,SDRET,SDRIEN1,SDRRFTR
  1.  .S SDRIEN1=$P(ARY84("SDREQTYPE"),"|",2)
  1.  .S SDCOMM=$$GET1^DIQ(403.5,SDRIEN1,2.5)
  1.  .S SDRRFTR="APPT SCHEDULED" ; "7"
  1.  .D RECDSET^SDEC52A(.SDRET,SDRIEN1,SDRRFTR,SDCOMM)
  1.  ;
  1.  ; add MRTC data to parent request
  1.  I $P(ARY84("SDREQTYPE"),"|",1)="A" D
  1.  .D BUILDAPPTDATA^SDESEDITAPPTREQ(REQUESTIEN,$G(ARY84("SDAPPTSTARTDTTM")),$G(ARY84("CLINICIEN")),$G(ARY84("SDSERVCONNPERC")),$G(ARY84("SDSERVCONN")),$G(ARY84("SDAPPTYPE")),$G(ARY84("SDEAS")),DUZ,.APPTMSG)
  1.  I $G(ARY84("SDPARENT")),$G(ARY84("SDMRTC")) D
  1.  .S REQUEST("MRTC","PATIENT INDICATED DATE")=$G(ARY84("SDESIREDTTM"))
  1.  .S REQUEST("MRTC","CHILD REQUEST")=REQUESTIEN
  1.  .S REQUEST("MRTC","MRTC APPOINTMENT")=$G(NEWIEN40984)
  1.  .D BUILDMRTCLINKS^SDESEDITAPPTREQ(.REQUEST,$G(ARY84("SDPARENT")))
  1.  .D BUILDMRTCPID^SDESEDITAPPTREQ(.REQUEST,$G(ARY84("SDPARENT")))
  1.  ;
  1.  I $P(ARY84("SDREQTYPE"),"|",1)="C" D
  1.  .D REQSET^SDEC07A($P($G(ARY84("SDREQTYPE")),"|",2),$G(ARY84("SDPROVIEN")),"",1,"",$G(ARY84("SDNOTE")),$G(ARY84("SDAPPTSTARTDTTM")),$G(ARY84("SDRESOURCE")),$G(ARY84("DFN")))
  1.  .D UPDATECONSULTPID^SDES2APPTUTIL($P($G(ARY84("SDREQTYPE")),"|",2),$G(ARY84("SDESIREDTTM")),$G(ARY84("DFN")))
  1.  ;add entry to OUTPATIENT ENCOUNTER file (#409.68)  ;alb/sat 672
  1.  I $$NOW^XLFDT>ARY84("SDAPPTSTARTDTTM"),$$NEW^SDPCE(ARY84("SDAPPTSTARTDTTM")) D
  1.  .S ENCOUNTER=$$GETAPT^SDVSIT2(ARY84("DFN"),ARY84("SDAPPTSTARTDTTM"),ARY84("CLINICIEN"))
  1.  ;
  1.  Q
  1.  ;