SDES2CANCELAPPT ;ALB/JAS,MCB,JAS,BLB,LAB,BLB,MGD,BWF,JAS,JAS,TAW,JHC,LAB - SDES2 CANCEL APPOINTMENT ; FEB 10, 2026
;;5.3;Scheduling;**869,871,873,875,877,878,880,886,897,918,920,909,929**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to DUZ^XUP is supported by IA #7487
;
Q
CANCELAPPT(JSONRETURN,SDCONTEXT,PARAMS) ;
;
N APPTIEN,APPTIENS,GOODPARAMS,SDERRORS,SDRETURN
;
D VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Appointment",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
S GOODPARAMS=$$VALPARAMS(.PARAMS,.SDERRORS)
I 'GOODPARAMS,$D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Appointment",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
S PARAMS("NOTE")=$$VALNOTE($G(PARAMS("NOTE")),$G(PARAMS("CANCEL HASH")))
S PARAMS("CANCEL REASON IEN")=$O(^SD(409.2,"B",PARAMS("CANCEL REASON"),0))
S PARAMS("ORIGINAL USER")=DUZ
D TRY2CANCEL(.SDRETURN,.SDCONTEXT,.PARAMS,.SDERRORS)
;
I '$D(SDRETURN) S SDRETURN("Appointment",1)=""
I $D(SDERRORS) M SDRETURN=SDERRORS
D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
Q
;
VALPARAMS(PARAMS,SDERRORS) ;
N LINKEDCLINIC,PID,RESOURCEIEN,VALRET
; Validate APPT IEN
D VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,$G(PARAMS("APPT IEN")),1,0,14,15)
Q:'VALRET 0
I $$GET1^DIQ(409.84,PARAMS("APPT IEN"),.12,"I") D ERRLOG^SDES2JSON(.SDERRORS,449) Q 0
; Validate Clinic IEN
D VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,44,$G(PARAMS("CLINIC IEN")),1,0,18,19)
Q:'VALRET 0
S RESOURCEIEN=$$GET1^DIQ(409.84,PARAMS("APPT IEN"),.07,"I")
S LINKEDCLINIC=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
I PARAMS("CLINIC IEN")'=LINKEDCLINIC D ERRLOG^SDES2JSON(.SDERRORS,193) Q 0
; Validate DFN
D VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,2,$G(PARAMS("DFN")),1,0,1,2)
Q:'VALRET 0
I $$GET1^DIQ(409.84,PARAMS("APPT IEN"),.05,"I")'=PARAMS("DFN") D ERRLOG^SDES2JSON(.SDERRORS,194) Q 0
; Order Lock Check
N APPTREQTYPE,REQTYPE,REQUESTIEN,APPOINTMENT
S APPTREQTYPE=$$GET1^DIQ(409.84,PARAMS("APPT IEN"),.22,"I")
S REQUESTIEN=$P($G(APPTREQTYPE),";")
S REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
; Validate Cancelled By
D VALFIELD^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,.17,$G(PARAMS("CANCELLED BY")),1,0,190,189)
Q:'VALRET 0
I PARAMS("CANCELLED BY")'="C",PARAMS("CANCELLED BY")'="PC" D ERRLOG^SDES2JSON(.SDERRORS,189) Q 0
I $$GET1^DIQ(409.84,PARAMS("APPT IEN"),.12,"I") D ERRLOG^SDES2JSON(.SDERRORS,449) Q 0
; Validate Cancel Reason
D VALFIELD^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,.122,$G(PARAMS("CANCEL REASON")),1,0,128,129)
Q:'VALRET 0
;
I $G(PARAMS("NEW PID"))'="" D Q:$D(SDERRORS) 0
. S PID=$$ISOTFM^SDAMUTDT(PARAMS("NEW PID"))
. I PID=-1!($P(PID,".",2)) D ERRLOG^SDES2JSON(.SDERRORS,160) Q
. I PARAMS("CANCELLED BY")="C" D ERRLOG^SDES2JSON(.SDERRORS,448) Q
. I $$DUPPIDCHK(REQUESTIEN,PID) D ERRLOG^SDES2JSON(.SDERRORS,545) Q
. S PARAMS("NEW PID")=PID
Q 1
;
VALNOTE(NOTE,CANCELHASH) ;
N SDECJ
S NOTE=$$CTRL^XMXUTIL1(NOTE)
S NOTE=$TR($G(NOTE),"^"," ") ;
S CANCELHASH=$$CTRL^XMXUTIL1(CANCELHASH)
I $G(CANCELHASH)'="" F SDECJ=$L(CANCELHASH,U):-1:1 S NOTE=$P(CANCELHASH,U,SDECJ)_"_"_NOTE
I $E(NOTE,$L(NOTE))="_" S NOTE=$E(NOTE,1,$L(NOTE)-1)
Q NOTE
;
DUPPIDCHK(REQUESTIEN,NEWPID) ;
N CHILDIEN,DUPPID,PARENTIEN S (CHILDIEN,DUPPID)=0
S PARENTIEN=$$GET1^DIQ(409.85,REQUESTIEN_",",43.8,"I")
I 'PARENTIEN Q DUPPID
F S CHILDIEN=$O(^SDEC(409.85,PARENTIEN,2,"B",CHILDIEN)) Q:'CHILDIEN D
. Q:CHILDIEN=REQUESTIEN
. I NEWPID>0,$$GET1^DIQ(409.85,CHILDIEN,22,"I")=NEWPID S DUPPID=1
Q DUPPID
;
TRY2CANCEL(SDRETURN,SDCONTEXT,PARAMS,SDERRORS) ; Cancel Patient's Appt
N APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASON,CANCELREASONIEN,NOTE,CANCELHASH,EAS,NEWPID,ROLLBACK
S APPTIEN=PARAMS("APPT IEN"),CLINICIEN=PARAMS("CLINIC IEN"),DFN=PARAMS("DFN")
S CANBYCLINORPAT=PARAMS("CANCELLED BY"),CANCELREASON=PARAMS("CANCEL REASON"),CANCELREASONIEN=PARAMS("CANCEL REASON IEN")
S NOTE=$G(PARAMS("NOTE")),EAS=$G(SDCONTEXT("ACHERON AUDIT ID")),NEWPID=$G(PARAMS("NEW PID"))
;
N SDATA,APPTENDTIME,APPTLENGTH,APPTSTARTTIME,APPTTYPE,CLINICSUBIEN,EDITED,MRTC,OLDRECALLPTR,PROVIEN,WALKIN
N PARENTREQUEST,PARENTSTATUS,RECALLREQIEN,RECALLREQLINK,RECALLRET,REQUESTIEN,REQUESTTYPE,RESOURCE,IENS44
D POPULATE(APPTIEN,.APPTSTARTTIME,.REQUESTTYPE,.REQUESTIEN,.APPTENDTIME,.APPTLENGTH,.APPTTYPE,.RESOURCE,.WALKIN,.MRTC,.PARENTREQUEST,.PARENTSTATUS,.SLOTSTATUSSTRING)
S ROLLBACK("WALKIN")=WALKIN
S IENS44=$$GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN)
; first event handler
S CLINICSUBIEN=$$BEFOREEVENT^SDES2CANCELAPPT1(DFN,APPTSTARTTIME,CLINICIEN,.SDATA)
; cancel appointments
D CANCEL40984(.SDERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,$G(EAS),.ROLLBACK)
Q:$D(SDERRORS)
D CANCEL44(.SDERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44,.ROLLBACK)
Q:$D(SDERRORS)
D CANCEL2(.SDERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,$G(NOTE),APPTIEN,CLINICIEN,IENS44,.ROLLBACK)
Q:$D(SDERRORS)
; update linked appointment request records
D UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,$G(NOTE),APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,$G(NEWPID),.SDERRORS,REQUESTTYPE)
; update compensation and pension records
I APPTTYPE="COMPENSATION & PENSION" D AMIECAN^SDESCOMPPEN(.SDRETURN,DFN,APPTSTARTTIME)
; remove outpatient encounter
D REMOVEENCOUNTER(APPTIEN,$$GET1^DIQ(2.98,APPTSTARTTIME_","_DFN_",",21,"I"),APPTSTARTTIME,DFN,IENS44)
; update clinic availability
D INCREMENTAVAIL1^SDESUTIL(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
; second event handler
D AFTEREVENT^SDES2CANCELAPPT1($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),$G(CLINICSUBIEN),.SDATA)
S SDRETURN("Appointment","Cancelled")=$G(APPTIEN)
Q
;
CANCEL40984(SDERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,EAS,ROLLBACK) ;
N IENS,FDA,ERR84
S IENS=APPTIEN_","
I WALKIN="YES" D
.S ROLLBACK(409.84,IENS,.03)=$$GET1^DIQ(409.84,IENS,.03,"I")
.S ROLLBACK(409.84,IENS,.04)=$$GET1^DIQ(409.84,IENS,.04,"I")
.S FDA(409.84,IENS,.03)=""
.S FDA(409.84,IENS,.04)=""
S FDA(409.84,IENS,.12)=$$NOW^XLFDT
S FDA(409.84,IENS,.121)=DUZ
S FDA(409.84,IENS,.122)=CANCELREASONIEN
S FDA(409.84,IENS,.17)=CANBYCLINORPAT
S FDA(409.84,IENS,100)=EAS
L +^SDEC(409.84,APPTIEN):3 I '$T D ERRLOG^SDES2JSON(.SDERRORS,192) Q
D FILE^DIE("","FDA","ERR84")
L -^SDEC(409.84,APPTIEN)
I $D(ERR84) D ERRLOG^SDES2JSON(.SDERRORS,191) Q
Q
;
CANCEL44(SDERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44,ROLLBACK) ;
N IENS,FDA44003,ERR44003
I WALKIN="YES" D
.S ROLLBACK(44.003,IENS44,309)=$$GET1^DIQ(44.003,IENS44,309,"I")
.S FDA44003(44.003,IENS44,309)=""
S FDA44003(44.003,IENS44,310)="C"
L +^SC(CLINICIEN,"S",APPTSTARTTIME):3 I '$T D ERRLOG^SDES2JSON(.SDERRORS,186),CLEAN40984(APPTIEN,.ROLLBACK) Q
D FILE^DIE("","FDA44003","ERR44003")
L -^SC(CLINICIEN,"S",APPTSTARTTIME)
I $D(ERR44003) D ERRLOG^SDES2JSON(.SDERRORS,191) D CLEAN40984(APPTIEN,.ROLLBACK) Q
Q
;
CANCEL2(SDERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,NOTE,APPTIEN,CLINICIEN,IENS44,ROLLBACK) ;
N IENS,FDA298,ERR298
S IENS=APPTSTARTTIME_","_DFN_","
S FDA298(2.98,IENS,3)=CANBYCLINORPAT
S FDA298(2.98,IENS,14)=DUZ
S FDA298(2.98,IENS,15)=$$NOW^XLFDT
S FDA298(2.98,IENS,16)=CANCELREASONIEN
S FDA298(2.98,IENS,17)=NOTE
L +^DPT(DFN,"S",APPTSTARTTIME):3 I '$T D ERRLOG^SDES2JSON(.SDERRORS,187),CLEAN40984(APPTIEN,.ROLLBACK),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44,.ROLLBACK) Q
D FILE^DIE("","FDA298","ERR298")
L -^DPT(DFN,"S",APPTSTARTTIME)
I $D(ERR298) D ERRLOG^SDES2JSON(.SDERRORS,191),CLEAN40984(APPTIEN,.ROLLBACK),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44,.ROLLBACK) Q
Q
;
UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,NEWPID,SDERROR,REQUESTTYPE) ;
N RECALLREQIEN,RECALLREQLINK,OLDRECALLPTR,PROVIDERIEN
I REQUESTTYPE="APPTREQ"!(REQUESTTYPE="RTC")!(REQUESTTYPE="VETERAN")!(REQUESTTYPE="MOBILE") D
.D DELETEAPPTDATA(REQUESTIEN)
.D OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT,.SDERROR)
.D UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
.I $G(NEWPID),CANBYCLINORPAT="PC" D
..D ADDPIDHISTORY^SDES2CRTAPREQ(REQUESTIEN,NEWPID)
;
I REQUESTTYPE="RECALL" D
.D REOPEN^SDESRECALLREQ(.RECALLRET,APPTIEN,,NEWPID,CANBYCLINORPAT,)
.I '$D(RECALLRET) Q
.S RECALLREQIEN=$P($G(RECALLRET),U)
.S RECALLREQLINK=$P($G(RECALLRET),U,2)
.S OLDRECALLPTR=$P($G(RECALLRET),U,3)
.D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(RECALLREQIEN),$G(RECALLREQLINK),$G(OLDRECALLPTR))
;
I REQUESTTYPE="CONSULT" D
.S PROVIDERIEN=$$GETPROVIDER^SDESCREATEAPPT(CLINICIEN,"C")
.N GMRCDUZ
.D REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIDERIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
.D UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
.I $G(NEWPID) D
..D UPDATECONSULTPID^SDES2APPTUTIL(REQUESTIEN,NEWPID,DFN)
Q
;
OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT,SDERRORS) ;
N REQFDA,REQUESTERR,REASONALLOWSOPEN,CANEDITPID,ERRIDX,ERRMSG
S REASONALLOWSOPEN=$$GET1^DIQ(409.2,$$GET1^DIQ(409.84,APPTIEN,.122,"I"),5,"I")
S CANEDITPID=$S(CANBYCLINORPAT="C":0,CANBYCLINORPAT="PC":1,1:"")
;
I REASONALLOWSOPEN D
.S REQFDA(409.85,REQUESTIEN_",",19)=""
.S REQFDA(409.85,REQUESTIEN_",",20)=""
.S REQFDA(409.85,REQUESTIEN_",",21)=""
.S REQFDA(409.85,REQUESTIEN_",",23)="O"
.S REQFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
.D FILE^DIE("","REQFDA","REQUESTERR") K REQFDA
.I $D(REQUESTERR("DIERR")) D
. S ERRMSG="Error while reopening request "
. F ERRIDX=1:1:$G(REQUESTERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
; do not re-open
I 'REASONALLOWSOPEN D
.S REQFDA(409.85,REQUESTIEN_",",19)=$P($$GET1^DIQ(409.84,APPTIEN,.12,"I"),".",1)
.S REQFDA(409.85,REQUESTIEN_",",20)=$$GET1^DIQ(409.84,APPTIEN,.121,"I")
.S REQFDA(409.85,REQUESTIEN_",",21)=$O(^SDEC(409.853,"B","CANCELLED NOT RE-OPENED",""))
.S REQFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
.D FILE^DIE("","REQFDA","REQUESTERR") K REQFDA
.I $D(REQUESTERR("DIERR")) D
.. S ERRMSG="Error while updating request when not reopening "
.. F ERRIDX=1:1:$G(REQUESTERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
I MRTC D
.D REMOVEMRTCAPTIEN^SDES2MRTCUTIL(REQUESTIEN,APPTIEN,PARENTREQUEST,.SDERRORS)
.I PARENTSTATUS="C",REASONALLOWSOPEN D
.. D REOPENREQUEST^SDES2MRTCUTIL(PARENTREQUEST,.SDERRORS)
.I 'REASONALLOWSOPEN D
..D REMOVEMRTCINFO^SDES2MRTCUTIL(PARENTREQUEST,REQUESTIEN,.SDERRORS)
Q
;
REMOVEENCOUNTER(APPTIEN,ENCOUNTERIEN,APPTSTARTTIME,DFN,IENS44) ;
N SECENCOUNTERIEN,VAR,PROCESSTYPE,APPTFDA,ENCOUNTERFDA,CHILDIEN,CHILDFDA,CHILDPROCESSTYPE,VISITUPDATE,PATIENTFDA,CLINICFDA,CLINICIENS,DISPOSITIONFDA,DISPOSITIONIEN,CLASSIEN,CLASSFDA
I '$G(ENCOUNTERIEN)!('$$EDITOK^SDCO3($G(ENCOUNTERIEN),2)) Q
S VAR=$$DELVFILE^PXAPI("ALL",$P($G(^SCE(ENCOUNTERIEN,0)),U,5),"","","",0)
S PROCESSTYPE=$$GET1^DIQ(409.68,ENCOUNTERIEN,.08,"E")
; child encounters
I $L($G(PROCESSTYPE)),$G(PROCESSTYPE)'="CREDIT STOP CODE" D
.S CHILDIEN=0
.F S CHILDIEN=$O(^SCE("APAR",ENCOUNTERIEN,CHILDIEN)) Q:'CHILDIEN D
..S CHILDFDA(409.68,CHILDIEN_",",.01)="@"
..D FILE^DIE(,"CHILDFDA") K CHILDFDA
..S VISITUPDATE=$$KILL^VSITKIL($$GET1^DIQ(409.68,CHILDIEN,.05,"I"))
; patient file and check-in from clinic file
I PROCESSTYPE="APPOINTMENT" D
.S PATIENTFDA(2.98,APPTSTARTTIME_","_DFN_",",21)="@"
.D FILE^DIE(,"PATIENTFDA") K PATIENTFDA
.S CLINICFDA(44.003,IENS44,303)="@"
.D FILE^DIE(,"CLINICFDA") K CLINICFDA
; disposition subfile in patient file
I PROCESSTYPE="DISPOSITION" D
.S DISPOSITIONIEN=$$GET1^DIQ(409.68,ENCOUNTERIEN,.09,"I")
.S DISPOSITIONFDA(2.101,DISPOSITIONIEN_","_DFN_",",18)="@"
.D FILE^DIE(,"DISPOSITIONFDA") K DISPOSITIONFDA
; outpatient classification file
I '$$GET1^DIQ(409.68,ENCOUNTERIEN,.06,"I"),$O(^SDD(409.42,"AO",ENCOUNTERIEN,0))>0 D
.S CLASSIEN=0
.F S CLASSIEN=$O(^SDD(409.42,"AO",ENCOUNTERIEN,CLASSIEN)) Q:'CLASSIEN D
..S CLASSFDA(409.42,CLASSIEN_",",.01)="@"
..D FILE^DIE(,"CLASSFDA") K CLASSFDA
; outpatient encounter file
S ENCOUNTERFDA(409.68,ENCOUNTERIEN_",",.01)="@"
D FILE^DIE(,"ENCOUNTERFDA") K ENCOUNTERFDA
S VISITUPDATE=$$KILL^VSITKIL($$GET1^DIQ(409.68,ENCOUNTERIEN,.05,"I"))
; delete checkout in appointment file
I $$GET1^DIQ(409.84,APPTIEN,.14,"I") D
.S APPTFDA(409.84,APPTIEN_",",.14)="@"
.S APPTFDA(409.84,APPTIEN_",",.08)=DUZ
.D FILE^DIE(,"APPTFDA") K APPTFDA
Q
;
DELETEAPPTDATA(REQUESTIEN) ;
N FDA
S REQUESTIEN=$G(REQUESTIEN)_","
S FDA(409.85,REQUESTIEN,13)="@"
S FDA(409.85,REQUESTIEN,13.1)="@"
S FDA(409.85,REQUESTIEN,13.2)="@"
S FDA(409.85,REQUESTIEN,13.3)="@"
S FDA(409.85,REQUESTIEN,13.4)="@"
S FDA(409.85,REQUESTIEN,13.6)="@"
S FDA(409.85,REQUESTIEN,13.7)="@"
S FDA(409.85,REQUESTIEN,13.8)="@"
S FDA(409.85,REQUESTIEN,100)=$G(EAS)
D FILE^DIE(,"FDA") K FDA
Q
;
REMOVEMRTCAPTIEN(REQUESTIEN,APPTIEN,PARENTIEN) ;
;leaving tag in for No-show, but needs removed and replaced in noshow
D REMOVEMRTCAPTIEN^SDES2MRTCUTIL(REQUESTIEN,APPTIEN,PARENTIEN)
Q
;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN) ;
N FOUND,IENS44003,SUBIEN
S FOUND=0
S SUBIEN=0 F S SUBIEN=$O(^SC(CLINICIEN,"S",APPTSTARTTIME,1,SUBIEN)) Q:'SUBIEN!($G(FOUND)=1) D
.I $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",310,"E")="CANCELLED" Q
.I $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",.01,"I")=DFN D
..S IENS44003=SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",FOUND=1 Q
Q $G(IENS44003)
;
CLEAN40984(APPTIEN,ROLLBACK) ;
N FDA,IENS
S IENS=APPTIEN_","
I ROLLBACK("WALKIN")="YES" D
.S FDA(409.84,IENS,.03)=ROLLBACK(409.84,IENS,.03)
.S FDA(409.84,IENS,.04)=ROLLBACK(409.84,IENS,.04)
S FDA(409.84,IENS,.12)=""
S FDA(409.84,IENS,.121)=""
S FDA(409.84,IENS,.122)=""
S FDA(409.84,IENS,.17)=""
S FDA(409.84,IENS,100)=""
D FILE^DIE("","FDA") K FDA
Q
;
CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44,ROLLBACK) ;
N FDA44003,IENS,ERR44003
I ROLLBACK("WALKIN")="YES" S FDA44003(44.003,IENS44,309)=ROLLBACK(44.003,IENS44,309)
S FDA44003(44.003,IENS44,310)=""
D FILE^DIE("","FDA44003","ERR44003") K FDA44003
Q
;
POPULATE(APPTIEN,APPTSTARTTIME,REQUESTTYPE,REQUESTIEN,APPTENDTIME,APPTLENGTH,APPTTYPE,RESOURCE,WALKIN,MRTC,PARENTREQUEST,PARENTSTATUS,SLOTSTATUSSTRING) ;
S APPTSTARTTIME=$$GET1^DIQ(409.84,$G(APPTIEN),.01,"I")
S REQUESTTYPE=$P($$GET1^DIQ(409.84,$G(APPTIEN),.22,"I"),";",2),REQUESTTYPE=$S(REQUESTTYPE="GMR(123,":"CONSULT",REQUESTTYPE="SD(403.5,":"RECALL",REQUESTTYPE="SDEC(409.85,":"APPTREQ",1:"")
S REQUESTIEN=$P($$GET1^DIQ(409.84,$G(APPTIEN),.22,"I"),";")
S APPTENDTIME=$$GET1^DIQ(409.84,$G(APPTIEN),.02,"I")
S APPTLENGTH=$$GET1^DIQ(409.84,APPTIEN,.18,"I")
S APPTTYPE=$$GET1^DIQ(409.84,APPTIEN,.06,"E")
S RESOURCE=$$GET1^DIQ(409.84,$G(APPTIEN),.07,"I")
S WALKIN=$$GET1^DIQ(409.84,APPTIEN,.13,"E")
S MRTC=$$GET1^DIQ(409.85,REQUESTIEN,41,"I")
S PARENTREQUEST=$$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")
S PARENTSTATUS=$$GET1^DIQ(409.85,PARENTREQUEST,23,"I")
S SLOTSTATUSSTRING="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2CANCELAPPT 15542 printed Apr 22, 2026@14:50:55 Page 2
SDES2CANCELAPPT ;ALB/JAS,MCB,JAS,BLB,LAB,BLB,MGD,BWF,JAS,JAS,TAW,JHC,LAB - SDES2 CANCEL APPOINTMENT ; FEB 10, 2026
+1 ;;5.3;Scheduling;**869,871,873,875,877,878,880,886,897,918,920,909,929**;Aug 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to DUZ^XUP is supported by IA #7487
+5 ;
+6 QUIT
CANCELAPPT(JSONRETURN,SDCONTEXT,PARAMS) ;
+1 ;
+2 NEW APPTIEN,APPTIENS,GOODPARAMS,SDERRORS,SDRETURN
+3 ;
+4 DO VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
+5 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Appointment",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+6 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+7 ;
+8 SET GOODPARAMS=$$VALPARAMS(.PARAMS,.SDERRORS)
+9 IF 'GOODPARAMS
IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Appointment",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+10 ;
+11 SET PARAMS("NOTE")=$$VALNOTE($GET(PARAMS("NOTE")),$GET(PARAMS("CANCEL HASH")))
+12 SET PARAMS("CANCEL REASON IEN")=$ORDER(^SD(409.2,"B",PARAMS("CANCEL REASON"),0))
+13 SET PARAMS("ORIGINAL USER")=DUZ
+14 DO TRY2CANCEL(.SDRETURN,.SDCONTEXT,.PARAMS,.SDERRORS)
+15 ;
+16 IF '$DATA(SDRETURN)
SET SDRETURN("Appointment",1)=""
+17 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
+18 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
+19 QUIT
+20 ;
VALPARAMS(PARAMS,SDERRORS) ;
+1 NEW LINKEDCLINIC,PID,RESOURCEIEN,VALRET
+2 ; Validate APPT IEN
+3 DO VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,$GET(PARAMS("APPT IEN")),1,0,14,15)
+4 if 'VALRET
QUIT 0
+5 IF $$GET1^DIQ(409.84,PARAMS("APPT IEN"),.12,"I")
DO ERRLOG^SDES2JSON(.SDERRORS,449)
QUIT 0
+6 ; Validate Clinic IEN
+7 DO VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,44,$GET(PARAMS("CLINIC IEN")),1,0,18,19)
+8 if 'VALRET
QUIT 0
+9 SET RESOURCEIEN=$$GET1^DIQ(409.84,PARAMS("APPT IEN"),.07,"I")
+10 SET LINKEDCLINIC=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
+11 IF PARAMS("CLINIC IEN")'=LINKEDCLINIC
DO ERRLOG^SDES2JSON(.SDERRORS,193)
QUIT 0
+12 ; Validate DFN
+13 DO VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,2,$GET(PARAMS("DFN")),1,0,1,2)
+14 if 'VALRET
QUIT 0
+15 IF $$GET1^DIQ(409.84,PARAMS("APPT IEN"),.05,"I")'=PARAMS("DFN")
DO ERRLOG^SDES2JSON(.SDERRORS,194)
QUIT 0
+16 ; Order Lock Check
+17 NEW APPTREQTYPE,REQTYPE,REQUESTIEN,APPOINTMENT
+18 SET APPTREQTYPE=$$GET1^DIQ(409.84,PARAMS("APPT IEN"),.22,"I")
+19 SET REQUESTIEN=$PIECE($GET(APPTREQTYPE),";")
+20 SET REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
+21 ; Validate Cancelled By
+22 DO VALFIELD^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,.17,$GET(PARAMS("CANCELLED BY")),1,0,190,189)
+23 if 'VALRET
QUIT 0
+24 IF PARAMS("CANCELLED BY")'="C"
IF PARAMS("CANCELLED BY")'="PC"
DO ERRLOG^SDES2JSON(.SDERRORS,189)
QUIT 0
+25 IF $$GET1^DIQ(409.84,PARAMS("APPT IEN"),.12,"I")
DO ERRLOG^SDES2JSON(.SDERRORS,449)
QUIT 0
+26 ; Validate Cancel Reason
+27 DO VALFIELD^SDES2VALUTIL(.VALRET,.SDERRORS,409.84,.122,$GET(PARAMS("CANCEL REASON")),1,0,128,129)
+28 if 'VALRET
QUIT 0
+29 ;
+30 IF $GET(PARAMS("NEW PID"))'=""
Begin DoDot:1
+31 SET PID=$$ISOTFM^SDAMUTDT(PARAMS("NEW PID"))
+32 IF PID=-1!($PIECE(PID,".",2))
DO ERRLOG^SDES2JSON(.SDERRORS,160)
QUIT
+33 IF PARAMS("CANCELLED BY")="C"
DO ERRLOG^SDES2JSON(.SDERRORS,448)
QUIT
+34 IF $$DUPPIDCHK(REQUESTIEN,PID)
DO ERRLOG^SDES2JSON(.SDERRORS,545)
QUIT
+35 SET PARAMS("NEW PID")=PID
End DoDot:1
if $DATA(SDERRORS)
QUIT 0
+36 QUIT 1
+37 ;
VALNOTE(NOTE,CANCELHASH) ;
+1 NEW SDECJ
+2 SET NOTE=$$CTRL^XMXUTIL1(NOTE)
+3 ;
SET NOTE=$TRANSLATE($GET(NOTE),"^"," ")
+4 SET CANCELHASH=$$CTRL^XMXUTIL1(CANCELHASH)
+5 IF $GET(CANCELHASH)'=""
FOR SDECJ=$LENGTH(CANCELHASH,U):-1:1
SET NOTE=$PIECE(CANCELHASH,U,SDECJ)_"_"_NOTE
+6 IF $EXTRACT(NOTE,$LENGTH(NOTE))="_"
SET NOTE=$EXTRACT(NOTE,1,$LENGTH(NOTE)-1)
+7 QUIT NOTE
+8 ;
DUPPIDCHK(REQUESTIEN,NEWPID) ;
+1 NEW CHILDIEN,DUPPID,PARENTIEN
SET (CHILDIEN,DUPPID)=0
+2 SET PARENTIEN=$$GET1^DIQ(409.85,REQUESTIEN_",",43.8,"I")
+3 IF 'PARENTIEN
QUIT DUPPID
+4 FOR
SET CHILDIEN=$ORDER(^SDEC(409.85,PARENTIEN,2,"B",CHILDIEN))
if 'CHILDIEN
QUIT
Begin DoDot:1
+5 if CHILDIEN=REQUESTIEN
QUIT
+6 IF NEWPID>0
IF $$GET1^DIQ(409.85,CHILDIEN,22,"I")=NEWPID
SET DUPPID=1
End DoDot:1
+7 QUIT DUPPID
+8 ;
TRY2CANCEL(SDRETURN,SDCONTEXT,PARAMS,SDERRORS) ; Cancel Patient's Appt
+1 NEW APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASON,CANCELREASONIEN,NOTE,CANCELHASH,EAS,NEWPID,ROLLBACK
+2 SET APPTIEN=PARAMS("APPT IEN")
SET CLINICIEN=PARAMS("CLINIC IEN")
SET DFN=PARAMS("DFN")
+3 SET CANBYCLINORPAT=PARAMS("CANCELLED BY")
SET CANCELREASON=PARAMS("CANCEL REASON")
SET CANCELREASONIEN=PARAMS("CANCEL REASON IEN")
+4 SET NOTE=$GET(PARAMS("NOTE"))
SET EAS=$GET(SDCONTEXT("ACHERON AUDIT ID"))
SET NEWPID=$GET(PARAMS("NEW PID"))
+5 ;
+6 NEW SDATA,APPTENDTIME,APPTLENGTH,APPTSTARTTIME,APPTTYPE,CLINICSUBIEN,EDITED,MRTC,OLDRECALLPTR,PROVIEN,WALKIN
+7 NEW PARENTREQUEST,PARENTSTATUS,RECALLREQIEN,RECALLREQLINK,RECALLRET,REQUESTIEN,REQUESTTYPE,RESOURCE,IENS44
+8 DO POPULATE(APPTIEN,.APPTSTARTTIME,.REQUESTTYPE,.REQUESTIEN,.APPTENDTIME,.APPTLENGTH,.APPTTYPE,.RESOURCE,.WALKIN,.MRTC,.PARENTREQUEST,.PARENTSTATUS,.SLOTSTATUSSTRING)
+9 SET ROLLBACK("WALKIN")=WALKIN
+10 SET IENS44=$$GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN)
+11 ; first event handler
+12 SET CLINICSUBIEN=$$BEFOREEVENT^SDES2CANCELAPPT1(DFN,APPTSTARTTIME,CLINICIEN,.SDATA)
+13 ; cancel appointments
+14 DO CANCEL40984(.SDERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,$GET(EAS),.ROLLBACK)
+15 if $DATA(SDERRORS)
QUIT
+16 DO CANCEL44(.SDERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44,.ROLLBACK)
+17 if $DATA(SDERRORS)
QUIT
+18 DO CANCEL2(.SDERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,$GET(NOTE),APPTIEN,CLINICIEN,IENS44,.ROLLBACK)
+19 if $DATA(SDERRORS)
QUIT
+20 ; update linked appointment request records
+21 DO UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,$GET(NOTE),APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,$GET(NEWPID),.SDERRORS,REQUESTTYPE)
+22 ; update compensation and pension records
+23 IF APPTTYPE="COMPENSATION & PENSION"
DO AMIECAN^SDESCOMPPEN(.SDRETURN,DFN,APPTSTARTTIME)
+24 ; remove outpatient encounter
+25 DO REMOVEENCOUNTER(APPTIEN,$$GET1^DIQ(2.98,APPTSTARTTIME_","_DFN_",",21,"I"),APPTSTARTTIME,DFN,IENS44)
+26 ; update clinic availability
+27 DO INCREMENTAVAIL1^SDESUTIL(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
+28 ; second event handler
+29 DO AFTEREVENT^SDES2CANCELAPPT1($GET(DFN),$GET(APPTSTARTTIME),$GET(CLINICIEN),$GET(CLINICSUBIEN),.SDATA)
+30 SET SDRETURN("Appointment","Cancelled")=$GET(APPTIEN)
+31 QUIT
+32 ;
CANCEL40984(SDERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,EAS,ROLLBACK) ;
+1 NEW IENS,FDA,ERR84
+2 SET IENS=APPTIEN_","
+3 IF WALKIN="YES"
Begin DoDot:1
+4 SET ROLLBACK(409.84,IENS,.03)=$$GET1^DIQ(409.84,IENS,.03,"I")
+5 SET ROLLBACK(409.84,IENS,.04)=$$GET1^DIQ(409.84,IENS,.04,"I")
+6 SET FDA(409.84,IENS,.03)=""
+7 SET FDA(409.84,IENS,.04)=""
End DoDot:1
+8 SET FDA(409.84,IENS,.12)=$$NOW^XLFDT
+9 SET FDA(409.84,IENS,.121)=DUZ
+10 SET FDA(409.84,IENS,.122)=CANCELREASONIEN
+11 SET FDA(409.84,IENS,.17)=CANBYCLINORPAT
+12 SET FDA(409.84,IENS,100)=EAS
+13 LOCK +^SDEC(409.84,APPTIEN):3
IF '$TEST
DO ERRLOG^SDES2JSON(.SDERRORS,192)
QUIT
+14 DO FILE^DIE("","FDA","ERR84")
+15 LOCK -^SDEC(409.84,APPTIEN)
+16 IF $DATA(ERR84)
DO ERRLOG^SDES2JSON(.SDERRORS,191)
QUIT
+17 QUIT
+18 ;
CANCEL44(SDERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44,ROLLBACK) ;
+1 NEW IENS,FDA44003,ERR44003
+2 IF WALKIN="YES"
Begin DoDot:1
+3 SET ROLLBACK(44.003,IENS44,309)=$$GET1^DIQ(44.003,IENS44,309,"I")
+4 SET FDA44003(44.003,IENS44,309)=""
End DoDot:1
+5 SET FDA44003(44.003,IENS44,310)="C"
+6 LOCK +^SC(CLINICIEN,"S",APPTSTARTTIME):3
IF '$TEST
DO ERRLOG^SDES2JSON(.SDERRORS,186)
DO CLEAN40984(APPTIEN,.ROLLBACK)
QUIT
+7 DO FILE^DIE("","FDA44003","ERR44003")
+8 LOCK -^SC(CLINICIEN,"S",APPTSTARTTIME)
+9 IF $DATA(ERR44003)
DO ERRLOG^SDES2JSON(.SDERRORS,191)
DO CLEAN40984(APPTIEN,.ROLLBACK)
QUIT
+10 QUIT
+11 ;
CANCEL2(SDERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,NOTE,APPTIEN,CLINICIEN,IENS44,ROLLBACK) ;
+1 NEW IENS,FDA298,ERR298
+2 SET IENS=APPTSTARTTIME_","_DFN_","
+3 SET FDA298(2.98,IENS,3)=CANBYCLINORPAT
+4 SET FDA298(2.98,IENS,14)=DUZ
+5 SET FDA298(2.98,IENS,15)=$$NOW^XLFDT
+6 SET FDA298(2.98,IENS,16)=CANCELREASONIEN
+7 SET FDA298(2.98,IENS,17)=NOTE
+8 LOCK +^DPT(DFN,"S",APPTSTARTTIME):3
IF '$TEST
DO ERRLOG^SDES2JSON(.SDERRORS,187)
DO CLEAN40984(APPTIEN,.ROLLBACK)
DO CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44,.ROLLBACK)
QUIT
+9 DO FILE^DIE("","FDA298","ERR298")
+10 LOCK -^DPT(DFN,"S",APPTSTARTTIME)
+11 IF $DATA(ERR298)
DO ERRLOG^SDES2JSON(.SDERRORS,191)
DO CLEAN40984(APPTIEN,.ROLLBACK)
DO CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44,.ROLLBACK)
QUIT
+12 QUIT
+13 ;
UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,NEWPID,SDERROR,REQUESTTYPE) ;
+1 NEW RECALLREQIEN,RECALLREQLINK,OLDRECALLPTR,PROVIDERIEN
+2 IF REQUESTTYPE="APPTREQ"!(REQUESTTYPE="RTC")!(REQUESTTYPE="VETERAN")!(REQUESTTYPE="MOBILE")
Begin DoDot:1
+3 DO DELETEAPPTDATA(REQUESTIEN)
+4 DO OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT,.SDERROR)
+5 DO UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
+6 IF $GET(NEWPID)
IF CANBYCLINORPAT="PC"
Begin DoDot:2
+7 DO ADDPIDHISTORY^SDES2CRTAPREQ(REQUESTIEN,NEWPID)
End DoDot:2
End DoDot:1
+8 ;
+9 IF REQUESTTYPE="RECALL"
Begin DoDot:1
+10 DO REOPEN^SDESRECALLREQ(.RECALLRET,APPTIEN,,NEWPID,CANBYCLINORPAT,)
+11 IF '$DATA(RECALLRET)
QUIT
+12 SET RECALLREQIEN=$PIECE($GET(RECALLRET),U)
+13 SET RECALLREQLINK=$PIECE($GET(RECALLRET),U,2)
+14 SET OLDRECALLPTR=$PIECE($GET(RECALLRET),U,3)
+15 DO UPDCONTSEQ^SDESCONTACTS($GET(DFN),$GET(RECALLREQIEN),$GET(RECALLREQLINK),$GET(OLDRECALLPTR))
End DoDot:1
+16 ;
+17 IF REQUESTTYPE="CONSULT"
Begin DoDot:1
+18 SET PROVIDERIEN=$$GETPROVIDER^SDESCREATEAPPT(CLINICIEN,"C")
+19 NEW GMRCDUZ
+20 DO REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIDERIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
+21 DO UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
+22 IF $GET(NEWPID)
Begin DoDot:2
+23 DO UPDATECONSULTPID^SDES2APPTUTIL(REQUESTIEN,NEWPID,DFN)
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT,SDERRORS) ;
+1 NEW REQFDA,REQUESTERR,REASONALLOWSOPEN,CANEDITPID,ERRIDX,ERRMSG
+2 SET REASONALLOWSOPEN=$$GET1^DIQ(409.2,$$GET1^DIQ(409.84,APPTIEN,.122,"I"),5,"I")
+3 SET CANEDITPID=$SELECT(CANBYCLINORPAT="C":0,CANBYCLINORPAT="PC":1,1:"")
+4 ;
+5 IF REASONALLOWSOPEN
Begin DoDot:1
+6 SET REQFDA(409.85,REQUESTIEN_",",19)=""
+7 SET REQFDA(409.85,REQUESTIEN_",",20)=""
+8 SET REQFDA(409.85,REQUESTIEN_",",21)=""
+9 SET REQFDA(409.85,REQUESTIEN_",",23)="O"
+10 SET REQFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
+11 DO FILE^DIE("","REQFDA","REQUESTERR")
KILL REQFDA
+12 IF $DATA(REQUESTERR("DIERR"))
Begin DoDot:2
End DoDot:2
+13 SET ERRMSG="Error while reopening request "
+14 FOR ERRIDX=1:1:$GET(REQUESTERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+15 ; do not re-open
+16 IF 'REASONALLOWSOPEN
Begin DoDot:1
+17 SET REQFDA(409.85,REQUESTIEN_",",19)=$PIECE($$GET1^DIQ(409.84,APPTIEN,.12,"I"),".",1)
+18 SET REQFDA(409.85,REQUESTIEN_",",20)=$$GET1^DIQ(409.84,APPTIEN,.121,"I")
+19 SET REQFDA(409.85,REQUESTIEN_",",21)=$ORDER(^SDEC(409.853,"B","CANCELLED NOT RE-OPENED",""))
+20 SET REQFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
+21 DO FILE^DIE("","REQFDA","REQUESTERR")
KILL REQFDA
+22 IF $DATA(REQUESTERR("DIERR"))
Begin DoDot:2
+23 SET ERRMSG="Error while updating request when not reopening "
+24 FOR ERRIDX=1:1:$GET(REQUESTERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:2
End DoDot:1
+25 IF MRTC
Begin DoDot:1
+26 DO REMOVEMRTCAPTIEN^SDES2MRTCUTIL(REQUESTIEN,APPTIEN,PARENTREQUEST,.SDERRORS)
+27 IF PARENTSTATUS="C"
IF REASONALLOWSOPEN
Begin DoDot:2
+28 DO REOPENREQUEST^SDES2MRTCUTIL(PARENTREQUEST,.SDERRORS)
End DoDot:2
+29 IF 'REASONALLOWSOPEN
Begin DoDot:2
+30 DO REMOVEMRTCINFO^SDES2MRTCUTIL(PARENTREQUEST,REQUESTIEN,.SDERRORS)
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
REMOVEENCOUNTER(APPTIEN,ENCOUNTERIEN,APPTSTARTTIME,DFN,IENS44) ;
+1 NEW SECENCOUNTERIEN,VAR,PROCESSTYPE,APPTFDA,ENCOUNTERFDA,CHILDIEN,CHILDFDA,CHILDPROCESSTYPE,VISITUPDATE,PATIENTFDA,CLINICFDA,CLINICIENS,DISPOSITIONFDA,DISPOSITIONIEN,CLASSIEN,CLASSFDA
+2 IF '$GET(ENCOUNTERIEN)!('$$EDITOK^SDCO3($GET(ENCOUNTERIEN),2))
QUIT
+3 SET VAR=$$DELVFILE^PXAPI("ALL",$PIECE($GET(^SCE(ENCOUNTERIEN,0)),U,5),"","","",0)
+4 SET PROCESSTYPE=$$GET1^DIQ(409.68,ENCOUNTERIEN,.08,"E")
+5 ; child encounters
+6 IF $LENGTH($GET(PROCESSTYPE))
IF $GET(PROCESSTYPE)'="CREDIT STOP CODE"
Begin DoDot:1
+7 SET CHILDIEN=0
+8 FOR
SET CHILDIEN=$ORDER(^SCE("APAR",ENCOUNTERIEN,CHILDIEN))
if 'CHILDIEN
QUIT
Begin DoDot:2
+9 SET CHILDFDA(409.68,CHILDIEN_",",.01)="@"
+10 DO FILE^DIE(,"CHILDFDA")
KILL CHILDFDA
+11 SET VISITUPDATE=$$KILL^VSITKIL($$GET1^DIQ(409.68,CHILDIEN,.05,"I"))
End DoDot:2
End DoDot:1
+12 ; patient file and check-in from clinic file
+13 IF PROCESSTYPE="APPOINTMENT"
Begin DoDot:1
+14 SET PATIENTFDA(2.98,APPTSTARTTIME_","_DFN_",",21)="@"
+15 DO FILE^DIE(,"PATIENTFDA")
KILL PATIENTFDA
+16 SET CLINICFDA(44.003,IENS44,303)="@"
+17 DO FILE^DIE(,"CLINICFDA")
KILL CLINICFDA
End DoDot:1
+18 ; disposition subfile in patient file
+19 IF PROCESSTYPE="DISPOSITION"
Begin DoDot:1
+20 SET DISPOSITIONIEN=$$GET1^DIQ(409.68,ENCOUNTERIEN,.09,"I")
+21 SET DISPOSITIONFDA(2.101,DISPOSITIONIEN_","_DFN_",",18)="@"
+22 DO FILE^DIE(,"DISPOSITIONFDA")
KILL DISPOSITIONFDA
End DoDot:1
+23 ; outpatient classification file
+24 IF '$$GET1^DIQ(409.68,ENCOUNTERIEN,.06,"I")
IF $ORDER(^SDD(409.42,"AO",ENCOUNTERIEN,0))>0
Begin DoDot:1
+25 SET CLASSIEN=0
+26 FOR
SET CLASSIEN=$ORDER(^SDD(409.42,"AO",ENCOUNTERIEN,CLASSIEN))
if 'CLASSIEN
QUIT
Begin DoDot:2
+27 SET CLASSFDA(409.42,CLASSIEN_",",.01)="@"
+28 DO FILE^DIE(,"CLASSFDA")
KILL CLASSFDA
End DoDot:2
End DoDot:1
+29 ; outpatient encounter file
+30 SET ENCOUNTERFDA(409.68,ENCOUNTERIEN_",",.01)="@"
+31 DO FILE^DIE(,"ENCOUNTERFDA")
KILL ENCOUNTERFDA
+32 SET VISITUPDATE=$$KILL^VSITKIL($$GET1^DIQ(409.68,ENCOUNTERIEN,.05,"I"))
+33 ; delete checkout in appointment file
+34 IF $$GET1^DIQ(409.84,APPTIEN,.14,"I")
Begin DoDot:1
+35 SET APPTFDA(409.84,APPTIEN_",",.14)="@"
+36 SET APPTFDA(409.84,APPTIEN_",",.08)=DUZ
+37 DO FILE^DIE(,"APPTFDA")
KILL APPTFDA
End DoDot:1
+38 QUIT
+39 ;
DELETEAPPTDATA(REQUESTIEN) ;
+1 NEW FDA
+2 SET REQUESTIEN=$GET(REQUESTIEN)_","
+3 SET FDA(409.85,REQUESTIEN,13)="@"
+4 SET FDA(409.85,REQUESTIEN,13.1)="@"
+5 SET FDA(409.85,REQUESTIEN,13.2)="@"
+6 SET FDA(409.85,REQUESTIEN,13.3)="@"
+7 SET FDA(409.85,REQUESTIEN,13.4)="@"
+8 SET FDA(409.85,REQUESTIEN,13.6)="@"
+9 SET FDA(409.85,REQUESTIEN,13.7)="@"
+10 SET FDA(409.85,REQUESTIEN,13.8)="@"
+11 SET FDA(409.85,REQUESTIEN,100)=$GET(EAS)
+12 DO FILE^DIE(,"FDA")
KILL FDA
+13 QUIT
+14 ;
REMOVEMRTCAPTIEN(REQUESTIEN,APPTIEN,PARENTIEN) ;
+1 ;leaving tag in for No-show, but needs removed and replaced in noshow
+2 DO REMOVEMRTCAPTIEN^SDES2MRTCUTIL(REQUESTIEN,APPTIEN,PARENTIEN)
+3 QUIT
+4 ;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN) ;
+1 NEW FOUND,IENS44003,SUBIEN
+2 SET FOUND=0
+3 SET SUBIEN=0
FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",APPTSTARTTIME,1,SUBIEN))
if 'SUBIEN!($GET(FOUND)=1)
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",310,"E")="CANCELLED"
QUIT
+5 IF $$GET1^DIQ(44.003,SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_",",.01,"I")=DFN
Begin DoDot:2
+6 SET IENS44003=SUBIEN_","_APPTSTARTTIME_","_CLINICIEN_","
SET FOUND=1
QUIT
End DoDot:2
End DoDot:1
+7 QUIT $GET(IENS44003)
+8 ;
CLEAN40984(APPTIEN,ROLLBACK) ;
+1 NEW FDA,IENS
+2 SET IENS=APPTIEN_","
+3 IF ROLLBACK("WALKIN")="YES"
Begin DoDot:1
+4 SET FDA(409.84,IENS,.03)=ROLLBACK(409.84,IENS,.03)
+5 SET FDA(409.84,IENS,.04)=ROLLBACK(409.84,IENS,.04)
End DoDot:1
+6 SET FDA(409.84,IENS,.12)=""
+7 SET FDA(409.84,IENS,.121)=""
+8 SET FDA(409.84,IENS,.122)=""
+9 SET FDA(409.84,IENS,.17)=""
+10 SET FDA(409.84,IENS,100)=""
+11 DO FILE^DIE("","FDA")
KILL FDA
+12 QUIT
+13 ;
CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44,ROLLBACK) ;
+1 NEW FDA44003,IENS,ERR44003
+2 IF ROLLBACK("WALKIN")="YES"
SET FDA44003(44.003,IENS44,309)=ROLLBACK(44.003,IENS44,309)
+3 SET FDA44003(44.003,IENS44,310)=""
+4 DO FILE^DIE("","FDA44003","ERR44003")
KILL FDA44003
+5 QUIT
+6 ;
POPULATE(APPTIEN,APPTSTARTTIME,REQUESTTYPE,REQUESTIEN,APPTENDTIME,APPTLENGTH,APPTTYPE,RESOURCE,WALKIN,MRTC,PARENTREQUEST,PARENTSTATUS,SLOTSTATUSSTRING) ;
+1 SET APPTSTARTTIME=$$GET1^DIQ(409.84,$GET(APPTIEN),.01,"I")
+2 SET REQUESTTYPE=$PIECE($$GET1^DIQ(409.84,$GET(APPTIEN),.22,"I"),";",2)
SET REQUESTTYPE=$SELECT(REQUESTTYPE="GMR(123,":"CONSULT",REQUESTTYPE="SD(403.5,":"RECALL",REQUESTTYPE="SDEC(409.85,":"APPTREQ",1:"")
+3 SET REQUESTIEN=$PIECE($$GET1^DIQ(409.84,$GET(APPTIEN),.22,"I"),";")
+4 SET APPTENDTIME=$$GET1^DIQ(409.84,$GET(APPTIEN),.02,"I")
+5 SET APPTLENGTH=$$GET1^DIQ(409.84,APPTIEN,.18,"I")
+6 SET APPTTYPE=$$GET1^DIQ(409.84,APPTIEN,.06,"E")
+7 SET RESOURCE=$$GET1^DIQ(409.84,$GET(APPTIEN),.07,"I")
+8 SET WALKIN=$$GET1^DIQ(409.84,APPTIEN,.13,"E")
+9 SET MRTC=$$GET1^DIQ(409.85,REQUESTIEN,41,"I")
+10 SET PARENTREQUEST=$$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")
+11 SET PARENTSTATUS=$$GET1^DIQ(409.85,PARENTREQUEST,23,"I")
+12 SET SLOTSTATUSSTRING="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
+13 QUIT
