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

SDEC07.m

Go to the documentation of this file.
SDEC07 ;ALB/SAT,PC,KML,MGD,LAB,TJB/BLB - ADD NEW APPOINTMENT ;Jun 23,2023
 ;;5.3;Scheduling;**627,642,651,658,665,669,671,672,701,686,740,694,785,788,790,799,801,805,816,819,842,843,847,851,869**;Aug 13, 1993;Build 13
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 ; Reference to ^GMR(123 is supported by IA #4837
 Q
APPADD(SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT,SDEL,EAS) ;
 N SDAPPTYP,CKATYP
 N SDECERR,SDECIEN,SDECDEP,SDECI,SDECJ,SDECAPPTI,SDECDJ,SDECRESD,SDECRNOD,SDECC,SDECERR,SDECWKIN,ITYP,REQIEN
 N SDECNOEV,SDECDEV,SDECDERR,SDECTMP,SAVESTRT,SDAREQ0,XQOPT
 N %DT,X,Y,DGQUIET,OBM,RET
 N SDOE
 ;Don't execute SDEC ADD APPOINTMENT protocol
 S SDECNOEV=1
 K ^TMP("SDEC07",$J)
 S SDECERR=0
 S SDECI=0
 S SDECY="^TMP(""SDEC07"","_$J_")"
 S ^TMP("SDEC07",$J,SDECI)="I00020APPOINTMENTID^T00020ERRORID"_$C(30)
 S SDECI=SDECI+1
 S ITYP="SDEC07 Error: Invalid Appointment Type"
 S CKATYP=$P($G(SDAPTYP),"|",1)
 I ("^A^C^R^"'[("^"_CKATYP_"^")) D ERR(SDECI+1,ITYP,,0) Q
 S REQIEN=+$P($G(SDAPTYP),"|",2)
 I 'REQIEN D ERR(SDECI+1,ITYP,,0) Q
 I CKATYP="E" I '$D(^SDWL(409.3,REQIEN,0)) D ERR(SDECI+1,ITYP,,0) Q
 I CKATYP="R" I '$D(^SD(403.5,REQIEN,0)) D ERR(SDECI+1,ITYP,,0) Q
 I CKATYP="C" I '$D(^GMR(123,REQIEN,0)) D ERR(SDECI+1,ITYP,,0) Q
 I CKATYP="A" I '$D(^SDEC(409.85,REQIEN,0)) D ERR(SDECI+1,ITYP,,0) Q
 I CKATYP="A" S SDAREQ0=$G(^SDEC(409.85,REQIEN,0)) I $P(SDAREQ0,U,5)="RTC",$P(SDAREQ0,U,17)="C" D ERR(SDECI+1,"SDEC07 Error: This RTC request has been closed.",,0) Q
 ; MGH save date/time for consult request
 S SAVESTRT=SDECSTART
 S ITYP="SDEC07 Error: The patient on the appointment request and the subsequent appointment must match."
 I CKATYP="R" I DFN'=$$GET1^DIQ(403.5,REQIEN,.01,"I") D ERR(SDECI+1,ITYP,,0) Q
 I CKATYP="C" I DFN'=$$GET1^DIQ(123,REQIEN,.02,"I") D ERR(SDECI+1,ITYP,,0) Q
 I CKATYP="A" I DFN'=$$GET1^DIQ(409.85,REQIEN,.01,"I") D ERR(SDECI+1,ITYP,,0) Q
 ;
 S SDECSTART=$$NETTOFM^SDECDATE(SDECSTART,"Y")
 I SDECSTART=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid Start Time",,0) Q
 S SDECEND=$$NETTOFM^SDECDATE(SDECEND,"Y")
 I SDECEND=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time",,0) Q
 I $L(SDECEND,".")=1 D ERR(SDECI+1,"SDEC07 Error: Invalid End Time",,0) Q
 I SDECSTART>SDECEND S SDECTMP=SDECEND,SDECEND=SDECSTART,SDECSTART=SDECTMP
 S DFN=$G(DFN)
 I DFN="" D ERR(SDECI+1,"SDEC07: Patient ID required.",,0) Q
 I '$D(^DPT(DFN,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Patient ID",,0) Q
 L +^DPT(DFN):3 I '$T D ERR(SDECI+1,"Patient is being edited. Try again later.",,0) Q
 D OP^XQCHK
 N POP
 S POP=0
 S:(CKATYP="A")&($P($G(XQOPT),U)'="SD RECEIVE OR") POP=$$ORDERLOCKCHECK^SDEC07C($P(SDAREQ0,"^",5),$P(SDAPTYP,"|",2),.SDECI,DFN)
 Q:POP
 ;  Reject if another appointment scheduled at same time.
 I $D(^DPT(DFN,"S",SDECSTART)),$P(^(SDECSTART,0),U,2)'="C",$P(^(0),U,2)'="PC" D ERR(SDECI+1,"Appointment in "_$P(^SC($P(^(0),U,1),0),U,1)_" already scheduled at the same time.",DFN,1) Q  ;SD,740
 ;Validate Resource
 S SDECERR=0 K SDECRESD
 S SDECRES=$G(SDECRES) I SDECRES="" D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID",DFN,1) Q
 I +SDECRES,'$D(^SDEC(409.831,SDECRES,0)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID",DFN,1) Q
 I '+SDECRES,'$D(^SDEC(409.831,"B",SDECRES)) D ERR(SDECI+1,"SDEC07 Error: Invalid Resource ID",DFN,1) Q
 S SDECRESD=$S(+SDECRES:+SDECRES,1:$O(^SDEC(409.831,"B",SDECRES,0)))
 S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0))
 I SDECRNOD="" D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.",DFN,1) Q
 N PTR44,MAXDAYS S PTR44=$P(SDECRNOD,"^",4),MAXDAYS=390
 I +PTR44,$D(^SC(PTR44,"SDP")) S MAXDAYS=$P(^("SDP"),"^",2) S:MAXDAYS="" MAXDAYS=390
 I SDECSTART>$$FMADD^XLFDT($$NOW^XLFDT(),MAXDAYS) D ERR(SDECI+1,"Appointment date too far in the future",DFN,1) Q
 S SDECWKIN=0
 S SDECATID=$G(SDECATID)
 I SDECATID="WALKIN" S SDECWKIN=1
 I SDECATID'?.N&(SDECATID'="WALKIN") S SDECATID=""
 S SDECLEN=$G(SDECLEN)
 ;validate MTRC flag (optional)
 S SDMRTC=$$UP^XLFSTR($G(SDMRTC))
 S SDMRTC=$S(SDMRTC="TRUE":1,1:0)
 ;validate desired date of appt (optional)
 S SDDDT=$G(SDDDT)
 I SDDDT'="" S %DT="" S X=$P(SDDDT,"@",1) D ^%DT S SDDDT=Y I Y=-1 S SDDDT=""
 I SDDDT="",SDECATID'="WALKIN" S SDDDT=$P(SDECSTART,".",1)
 ;validate requested by
 S SDREQBY=$$UP^XLFSTR($G(SDREQBY))
 I SDREQBY'="" S SDREQBY=$S(SDREQBY="PROVIDER":1,SDREQBY="PATIENT":2,1:0)
 ;validate lab date/time (optional)
 S SDLAB=$G(SDLAB)
 I SDLAB'="" S %DT="T" S X=SDLAB D ^%DT S SDLAB=Y I Y=-1 S SDLAB=""
 ;validate EKG date/time (optional)
 S SDEKG=$G(SDEKG)
 I SDEKG'="" S %DT="T" S X=SDEKG D ^%DT S SDEKG=Y I Y=-1 S SDEKG=""
 ;validate XRAY date/time (optional)
 S SDXRAY=$G(SDXRAY)
 I SDXRAY'="" S %DT="T" S X=SDXRAY D ^%DT S SDXRAY=Y I Y=-1 S SDXRAY=""
 S SDID=$G(SDID)
 ;validate clini101
  S SDCL=$G(SDCL)
 I SDCL'="" I '$D(^SC(SDCL,0)) S SDCL=""
 ;clinic ID   ;support for single HOSPITAL LOCATION in SDEC RESOURCE
 I SDCL="" S SDCL=$$GET1^DIQ(409.831,SDECRESD_",",.04,"I")
 S OVB=+$G(OVB)
 I 'OVB S OBM=$$OBM1^SDEC57(SDCL,SDECSTART,SDMRTC,,+SDECWKIN) I OBM'="",+OBM'=1 S SDECAPPTID=0 D ERR(SDECI+1,"OBM"_OBM,DFN,1) Q   ;alb/sat 658 check if overbook ;alb/sat 665 clear SDECAPPTID  ;SD,740
 ;validate appt request type (required)
 I SDCL="" D
 .S:$P(SDAPTYP,"|",1)="E" SDCL=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",13.2,"I")
 .S:$P(SDAPTYP,"|",1)="R" SDCL=$$GET1^DIQ(403.5,$P(SDAPTYP,"|",2)_",",4.5,"I")
 .;ICR 4837 ICR states 'Zero node read into variable'
 .S:$P(SDAPTYP,"|",1)="C" SDCL=$P($G(^GMR(123,+$P(SDAPTYP,"|",2),0)),U,4)
 .S:$P(SDAPTYP,"|",1)="A" SDCL=$$GET1^DIQ(409.85,$P(SDAPTYP,"|",2)_",",8,"I")
 I SDCL="" D ERR(SDECI+1,"SDEC07 Error: Invalid clinic ID.",DFN,1) Q
 I $$INACTIVE^SDEC32(SDCL) D ERR(SDECI+1,"SDEC07 Error: "_$$GET1^DIQ(44,SDCL_",",.01)_" is an inactive clinic.",DFN,1) Q   ;SD,740
 ;Reject if consult is not active or pending.  SD*5.3*686
 I $P(SDAPTYP,"|",1)="C" N CNSLTSTS,NOTOK S CNSLTSTS=$P($G(^GMR(123,+$P(SDAPTYP,"|",2),0)),U,12),NOTOK=0 D  Q:NOTOK  ;
 . I CNSLTSTS'=5,CNSLTSTS'=6 D ERR(SDECI+1,"Consult status is not PENDING or ACTIVE.  It cannot be scheduled.",DFN,1) S NOTOK=1 Q  ;SD,740
 ;
 ;
 ;validate provider
 I $G(PROVIEN),'$D(^VA(200,+$G(PROVIEN),0)) D ERR(SDECI+1,"SDEC07 Error: Invalid provider ID.",DFN,1) Q
 I $G(PROVIEN)="" S PROVIEN=$$GETPROVIDER^SDESCREATEAPPT(SDCL,$P(SDAPTYP,"|",1),$P(SDAPTYP,"|",2))
 ;
 ;
 ;validate service connected
 S SDSVCPR=$G(SDSVCPR)
 I SDSVCPR'="" S:(+SDSVCPR<0)!(+SDSVCPR>100) SDSVCPR=""
 S SDSVCP=$G(SDSVCP)
 S SDSVCP=$S(SDSVCP=0:0,SDSVCP="NO":0,SDSVCP=1:1,SDSVCP="YES":1,1:"")
 ;validate note   ;alb/sat 658 - only use 1st 150 characters
 S SDECNOTE=$G(SDECNOTE) S:SDECNOTE'="" SDECNOTE=$TR($E(SDECNOTE,1,150),"^"," ")
 ;validate APPTYPE
 S APPTYPE=$G(APPTYPE) I APPTYPE'="",'$D(^SD(409.1,+APPTYPE,0)) S APPTYPE=""
 ;validate Patient Status (EESTAT)
 S EESTAT=$G(EESTAT)
 I EESTAT="" D
 .I $P(SDAPTYP,"|",1)="E" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",27,"I")
 .I $P(SDAPTYP,"|",1)="A" S EESTAT=$$GET1^DIQ(409.3,$P(SDAPTYP,"|",2)_",",.02,"I")
 S EESTAT=$S(EESTAT="N":"N",EESTAT="NEW":"N",EESTAT="E":"E",EESTAT="ESTABLISHED":"E",1:"")
 ;validate OVB (overbook)
 S OVB=+$G(OVB)
 I 'OVB D
 .D OVBOOK^SDEC07A(.RET,SDCL,SDECSTART,SDECRES)
 D
 .S SDAPPTYP=+APPTYPE
 .I 'SDAPPTYP D
 ..I $P(SDAPTYP,"|",1)="E" S SDAPPTYP=$$GET1^DIQ(409.3,+$P(SDAPTYP,"|",2)_",",8.7,"I")
 ..I $P(SDAPTYP,"|",1)="A" S SDAPPTYP=$$GET1^DIQ(409.85,+$P(SDAPTYP,"|",2)_",",8.7,"I")
 ..I $P(SDAPTYP,"|",1)="C",+APPTYPE S SDAPPTYP=+APPTYPE
 .S:'SDAPPTYP SDAPPTYP=$O(^SD(409.1,"B","REGULAR",0))
 S EAS=$TR($G(EAS),"^"," ")
 I $L(EAS) S EAS=$$EASVALIDATE^SDESUTIL(EAS)
 I EAS=-1 D ERR(SDECI+1,"SDEC07 Error: Invalid EAS Tracking Number",,0) Q
 S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,1,+SDECLEN,EAS)  ;alb/sat 665 add SDECLEN
 I 'SDECAPPTID D ERR(SDECI+1,"SDEC07 Error: Unable to add appointment to SDEC APPOINTMENT file.",DFN,2) Q   ;SD,740
 ;Lock SDEC node
 L +^SDEC(409.84,SDECAPPTID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record.  Please try again later",DFN,1) Q  ; Fixed Lock *790
 ;Save the appt
 ; call chart request
 S SDECDEV=""
 I SDECATID="WALKIN",$G(SDECCR),$G(SDECDEV)'="" S DGQUIET=1 D WISD^SDECRT(DFN,$P(SDECSTART,"."),"",SDECDEV)
 I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE)
 ;Create appt in VistA ;TODO: have this call APPVISTA^SDEC07B
 I +SDCL,$D(^SC(SDCL,0)) D  I +SDECERR D ERR(SDECI+1,$P(SDECERR,U,2),DFN,2)
 . S SDECC("PAT")=DFN
 . S SDECC("CLN")=SDCL
 . ;3 for scheduled appts, 4 for walkins
 . S SDECC("TYP")=$S(+SDECWKIN:4,SDAPPTYP=1:1,1:3)
 . ;collateral visit if appointment type is COLLATERAL OF VET.
 . S SDECC("COL")=$S(SDAPPTYP=7:1,1:"")
 . S SDECC("APT")=SDAPPTYP
 . S SDECC("ADT")=SDECSTART
 . S SDECC("LEN")=SDECLEN
 . ;File 44 has 150 character limit on OTHER field
 . S SDECC("OI")=$E($G(SDECNOTE),1,150)
 . ;No semicolons allowed
 . S SDECC("OI")=$TR(SDECC("OI"),";"," ")
 . ;Strip control characters from note
 . S SDECC("OI")=$$STRIP(SDECC("OI"))
 . S SDECC("RES")=SDECRESD
 . S SDECC("USR")=DUZ
 . S SDECC("MTR")=$G(SDMRTC)
 . S SDECC("DDT")=SDDDT
 . S SDECC("REQ")=SDREQBY
 . S SDECC("LAB")=SDLAB
 . S SDECC("XRA")=SDXRAY
 . S SDECC("EKG")=SDEKG
 . ; OVB: 2: Not an Overbook don't perform OB validation, 1:Overbook, don't perform OB validation, 0:Not an Overbook but perform OB validation
 . S SDECC("OVB")=$S(OVB=1:1,1:0)
 . S SDECC("ELG")=SDEL
 . S:$P(SDAPTYP,"|",1)="C" SDECC("CON")=$P(SDAPTYP,"|",2)
 . S SDECERR=$$MAKE^SDEC07B(.SDECC)
 . Q:SDECERR
 . D AVUPDT^SDEC07C(SDCL,SDECSTART,SDECLEN)
 . Q
 ;update wait list
 I $P(SDAPTYP,"|",1)="E" D EWL^SDEC07A($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCPR,SDSVCP,,SDAPPTYP)  ;alb/sat 658 do not pass note
 ;update appt request
 I $P(SDAPTYP,"|",1)="A" D
 .D UPDATE^SDECAR2($P(SDAPTYP,"|",2),SDECSTART,SDCL,SDSVCPR,SDSVCP,,SDAPPTYP,EAS)  ;alb/sat 658 do not pass note
 .I $G(SDMRTC),$G(SDPARENT) D AR433^SDECAR2(SDPARENT,SDECAPPTID_"~"_$P(SDAPTYP,"|",2))
 .D:$G(SDPARENT) AR438^SDECAR2($P(SDAPTYP,"|",2),SDPARENT)
 N SDT S SDT=SDECSTART
 ;add entry to OUTPATIENT ENCOUNTER file (#409.68)
 I $$NOW^XLFDT>SDT,$$NEW^SDPCE(SDT) D
 .N SDCOED
 .S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
 L -^SDEC(409.84,SDECAPPTID) ; Fixed Lock *790
 L -^DPT(DFN)
 S SDECI=SDECI+1
 S ^TMP("SDEC07",$J,SDECI)=SDECAPPTID_"^"_$G(SDECDERR)_$C(30)
 S SDECI=SDECI+1
 S ^TMP("SDEC07",$J,SDECI)=$C(31)
 Q
 ;
 ;ADD SDEC APPT ENTRY
SDECADD(SDECSTART,SDECEND,DFN,SDECRESD,SDECATID,SDDDT,SDID,SDAPTYP,PROVIEN,SDCL,SDECNOTE,SAVESTRT,SDECRES,SDAPPTYP,EESTAT,SDF,SDECLEN,EAS) ;alb/sat 665 add SDECLEN
 ;SDF - (optional) flags
 ;  1. called from GUI (update consult only if called from GUI)
 ;Returns ien in SDECAPPT or 0 if failed
 ;called from SDEC APPADD rpc and from VistA via SDM1A
 ;Create entry in SDEC APPOINTMENT
 N SDIEN,SDECAPPTID,SDECIEN,SDECMSG,SL,X,SDDFN,FDA,ERR,REQIEN
 S SDECSTART=$G(SDECSTART)
 S SAVESTRT=$G(SAVESTRT),SDECRES=$G(SDECRES)  ;MGH save date/time for consult request
 S DFN=$G(DFN),SDDFN=DFN
 S SDECRESD=$G(SDECRESD)
 S SDECATID=$G(SDECATID)
 S SDDDT=$G(SDDDT)
 S SDID=$G(SDID)
 S SDAPTYP=$G(SDAPTYP)
 S SDAPPTYP=$G(SDAPPTYP)
 S PROVIEN=$G(PROVIEN)
 S SDCL=$G(SDCL)
 S SDECEND=$G(SDECEND)
 I $P(SDAPTYP,"|",1)="R" D
 .S PROVIEN=$$GET1^DIQ(403.54,PROVIEN,.01,"I")
 S SDECLEN=$G(SDECLEN)
 I SDECLEN="",SDECEND="" S SDECLEN=+$G(^SC(SDCL,"SL")) S:'+SDECLEN SDECLEN=30 S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN)   ;no length or end date/time
 I SDECLEN="",SDECEND'="" S SDECLEN=$$FMDIFF^XLFDT(SDECEND,SDECSTART,2)\60  ;no length
 I SDECLEN'="",SDECEND="" S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN)  ;no end date/time
 S SDECNOTE=$G(SDECNOTE)
 S SDF=$G(SDF,0)
 S EAS=$G(EAS)
 I PROVIEN="" S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I")
 S SDIEN=$$APPTGET^SDECUTL(DFN,SDECSTART,SDCL)
 S SDIEN=$S(SDIEN'="":SDIEN_",",1:"+1,") K FDA
 S FDA(409.84,SDIEN,.01)=SDECSTART
 S FDA(409.84,SDIEN,.02)=SDECEND
 S FDA(409.84,SDIEN,.03)="@" ;*zeb+22 686 3/20/19 clear data from overlaid appts
 S FDA(409.84,SDIEN,.04)="@"
 S FDA(409.84,SDIEN,.05)=DFN
 S FDA(409.84,SDIEN,.06)=$S(+SDAPPTYP:SDAPPTYP,1:"@")
 S FDA(409.84,SDIEN,.07)=SDECRESD
 S FDA(409.84,SDIEN,.08)=$G(DUZ)
 S FDA(409.84,SDIEN,.09)=$P($$NOW^XLFDT,".",1)
 S FDA(409.84,SDIEN,.1)="@"
 S FDA(409.84,SDIEN,.101)="@"
 S FDA(409.84,SDIEN,.102)="@"
 S FDA(409.84,SDIEN,.11)="@"
 S FDA(409.84,SDIEN,.12)="@"
 S FDA(409.84,SDIEN,.121)="@"
 S FDA(409.84,SDIEN,.122)="@"
 S FDA(409.84,SDIEN,.13)=$S(SDECATID="WALKIN":"y",1:"@")
 S FDA(409.84,SDIEN,.14)="@"
 S FDA(409.84,SDIEN,.16)=$S(PROVIEN'="":PROVIEN,1:"@")
 S FDA(409.84,SDIEN,.17)="@"
 S FDA(409.84,SDIEN,.18)=$S($G(SDECLEN)'="":SDECLEN,1:"@")
 S FDA(409.84,SDIEN,.2)=SDDDT
 S FDA(409.84,SDIEN,.21)=$S($G(SDID)'="":SDID,1:"@")
 S FDA(409.84,SDIEN,.22)=$S(SDAPTYP'="":$P(SDAPTYP,"|",2)_";"_$S($P(SDAPTYP,"|",1)="E":"SDWL(409.3,",$P(SDAPTYP,"|",1)="C":"GMR(123,",$P(SDAPTYP,"|",1)="R":"SD(403.5,",$P(SDAPTYP,"|",1)="A":"SDEC(409.85,",1:""),1:"@")
 S FDA(409.84,SDIEN,.23)=$S($G(EESTAT)'="":EESTAT,1:"@")
 S:EAS'="" FDA(409.84,SDIEN,100)=EAS
 K SDECIEN,SDECMSG
 D UPDATE^DIE("","FDA","SDECIEN","SDECMSG")
 I $P(SDAPTYP,"|",1)="A"!($P(SDAPTYP,"|",1)="R") D
 .S REQIEN=$P(SDAPTYP,"|",2)
 .I $$LASTPIDCHECK^SDECAR2(REQIEN,SDDDT) D
 ..K FDA S FDA(409.854,"+1,"_REQIEN_",",.01)=$$NOW^XLFDT
 ..S FDA(409.854,"+1,"_REQIEN_",",1)=SDDDT
 ..S FDA(409.854,"+1,"_REQIEN_",",2)=$$GET1^DIQ(200,DUZ,.01,"E")
 ..D UPDATE^DIE(,"FDA",,"ERR") K FDA
 S SDECAPPTID=$S(SDIEN'="+1,":+SDIEN,1:+$G(SDECIEN(1)))
 K SDECMSG
 I SDECNOTE="" D WP^DIE(409.84,$S(+$G(SDECAPPTID):SDECAPPTID_",",1:SDIEN_","),1,"","@","SDECMSG")
 I SDECNOTE'="" N ARR D WP^SDECUTL(.ARR,SDECNOTE) D WP^DIE(409.84,$S(+$G(SDECAPPTID):SDECAPPTID_",",1:SDIEN_","),1,"","ARR","SDECMSG")
 I SDECAPPTID'="" D
 .I $P(SDAPTYP,"|",1)="C",SDF D
 ..D REQSET^SDEC07A($P(SDAPTYP,"|",2),PROVIEN,"",1,"",SDECNOTE,SAVESTRT,SDECRES,SDDFN)
 .I $P(SDAPTYP,"|",1)="R" D  ; VSE-863 ;6/9/2021
 .. N SDCOMM,SDRET,SDRIEN1,SDRRFTR
 .. S SDRIEN1=$P(SDAPTYP,"|",2)
 .. S SDCOMM=$$GET1^DIQ(403.5,SDRIEN1,2.5)
 .. S SDRRFTR="APPT SCHEDULED" ; "7"
 .. D RECDSET^SDEC52A(.SDRET,SDRIEN1,SDRRFTR,SDCOMM)
 .;
 I $G(SDECAPPTID) D SETMISSIONELIG^SDESMISSIONELG(SDECAPPTID)
 Q SDECAPPTID
 ;
CONSPIDCHECK(SDRIEN1,SDDDT) ;
 N CHIEN,CHSIEN,OLDPID
 S CHIEN=$O(^SDEC(409.87,"B",SDRIEN1,0))
 S CHSIEN=$O(^SDEC(409.87,CHIEN,1,9999999),-1)
 S OLDPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
 I OLDPID'=$G(SDDDT) Q 1
 Q 0
SDECWP(SDECAPPTID,SDECNOTE) ;
 ;Add WP field
 I SDECNOTE]"" S SDECNOTE(.5)=SDECNOTE,SDECNOTE=""
 I $D(SDECNOTE(0)) S SDECNOTE(.5)=SDECNOTE(0) K SDECNOTE(0)
 I $D(SDECNOTE(.5)) D
 . D WP^DIE(409.84,SDECAPPTID_",",1,"","SDECNOTE","SDECMSG")
 Q
 ;
ADDEVT(DFN,SDECSTART,SDECSC,SDCLA) ;EP
 ;Called by SDEC ADD APPOINTMENT protocol
 ;SDECSC=IEN of clinic in ^SC
 ;SDCLA=IEN for ^SC(SDECSC,"S",SDECSTART,1,SDCLA). Use to get Length & Note
 ;
 N SDECNOD,SDECLEN,SDECAPPTID,SDECNODP,SDECWKIN,SDECRES
 Q:+$G(SDECNOEV)
 I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0))
 Q:'+$G(SDECRES)
 S SDECNOD=$G(^SC(SDECSC,"S",SDECSTART,1,SDCLA,0))
 Q:SDECNOD=""
 S SDECNODP=$G(^DPT(DFN,"S",SDECSTART,0))
 S SDECWKIN=""
 ;Purpose of Visit field of DPT Appointment subfile
 S:$P(SDECNODP,U,7)=4 SDECWKIN="WALKIN"
 S SDECLEN=$P(SDECNOD,U,2)
 Q:'+SDECLEN
 S SDECEND=$$FMADD^XLFDT(SDECSTART,0,0,SDECLEN,0)
 S SDECAPPTID=$$SDECADD(SDECSTART,SDECEND,DFN,SDECRES,SDECWKIN,,,,,SDECSC,,,,,,1,+SDECLEN)  ;alb/sat 665 add SDECLEN
 Q:'+SDECAPPTID
 S SDECNOTE=$P(SDECNOD,U,4)
 I SDECNOTE]"" D SDECWP(SDECAPPTID,SDECNOTE)
 D ADDEVT3(SDECRES)
 Q
 ;
ADDEVT3(SDECRES) ;
 ;Call RaiseEvent to notify GUI clients
 Q
 ;
STRIP(SDECZ) ;Replace control characters with spaces
 N SDECI
 F SDECI=1:1:$L(SDECZ) I (32>$A($E(SDECZ,SDECI))) S SDECZ=$E(SDECZ,1,SDECI-1)_" "_$E(SDECZ,SDECI+1,999)
 Q SDECZ
 ;
ERR(SDECI,SDECERR,DFN,LOCK) ;Error processing  SD,740
 S DFN=$G(DFN)
 S SDECI=SDECI+1
 S SDECERR=$TR(SDECERR,"^","~")
 S ^TMP("SDEC07",$J,SDECI)=$G(SDECAPPTID,0)_"^"_SDECERR_$C(30)
 S SDECI=SDECI+1
 S ^TMP("SDEC07",$J,SDECI)=$C(31)
 I $G(LOCK)=1 L -^DPT(DFN)
 I $G(LOCK)=2 L -^DPT(DFN)
 I +$G(SDECAPPTID) L -^SDEC(409.84,SDECAPPTID)
 Q
 ;
ETRAP ;EP Error trap entry
 D ^%ZTER
 I '$D(SDECI) N SDECI S SDECI=999999
 S SDECI=SDECI+1
 D ERR(SDECI,"SDEC07 Error")
 Q
ERROR ;
 D ERR1("Error")
 Q
 ;
ERR1(SDECERR) ;Error processing
 S SDECI=SDECI+1
 S ^TMP("SDEC07",$J,SDECI)=SDECERR_$C(30)
 S SDECI=SDECI+1
 S ^TMP("SDEC07",$J,SDECI)=$C(31)
 Q