SDESCANAPPT2 ;ALB/DJS,LAB,MGD,BWF,BLB,ANU,MCB,JAS - SCHEDULING CANCEL APPOINTMENTS RPC ;FEB 16, 2024
;;5.3;Scheduling;**838,842,844,845,847,851,864,871,873**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
; Clone of SDESCANCELAPPTS - BLB
;
;APPTIEN - (required) pointer to SDEC APPOINTMENT file #409.84
;CLINICIEN -(required) pointer to hospital location file #44
;DFN -(required) pointer to patient file #2
;CANBYCLINORPAT - (required) appointment Status valid values: C=CANCELLED BY CLINIC ; PC=CANCELLED BY PATIENT
;CANCELREASON - (required) Cancellation Reason NAME in CANCELLATION REASON File (409.2)
;NOTE - (optional)
;CANCELHASH - (optional) List of cancellation comment hash tags
;EAS - (optional)
;NEWPID - (optional) New/edited PID passed in when cancelling an appointment by patient
;
Q
;
CANAPPT2(JSONRETURN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASON,NOTE,CANCELHASH,EAS,NEWPID) ;
N ERRORS,ISAPPTIENVALID,ORDERLOCK,ISCANBYVALID,ISCANREASONVALID,ISDFNVALID,SDATA,ISCLINICVALID,APPTENDTIME,APPTSTARTTIME,PROVIEN,ISEASVALID,ISCANBYVALID,ISNOTEVALID,ISCANDTTMVALID,EDITED,CLINICSUBIEN,IS2CANCELLED
N RECALLREQIEN,RECALLREQLINK,RESOURCE,OLDRECALLPTR,RETURN,RECALLRET,CANCELREASONIEN,APPTLENGTH,MRTC,PARENTREQUEST,PARENTSTATUS,IS40984CANCELLED,IS44CANCELLED,REQUESTTYPE,REQUESTIEN,APPTTYPE
;
; input validation
D VALIDATE($G(APPTIEN),$G(CLINICIEN),$G(DFN),$G(CANBYCLINORPAT),$G(CANCELREASON),$G(NOTE),$G(CANCELHASH),$G(EAS),.NEWPID)
I $D(ERRORS) S ERRORS("Appointment",1)="" M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
; populate variables
D POPULATE(APPTIEN,.APPTSTARTTIME,.REQUESTTYPE,.REQUESTIEN,.APPTENDTIME,.APPTLENGTH,.APPTTYPE,.RESOURCE,.WALKIN,.MRTC,.PARENTREQUEST,.PARENTSTATUS,.SLOTSTATUSSTRING)
S IENS44=$$GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN)
; first event handler
S CLINICSUBIEN=$$BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,.SDATA)
;
; cancel appointments
D CANCEL40984(.ERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,$G(EAS))
D CANCEL44(.ERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44)
D CANCEL2(.ERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,$G(NOTE),APPTIEN,CLINICIEN,IENS44)
I $D(ERRORS) S ERRORS("Appointment",1)="" M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
; update linked appointment request records
D UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,$G(NOTE),APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,$G(NEWPID))
;
; update compensation and pension records
I APPTTYPE="COMPENSATION & PENSION" D AMIECAN^SDESCOMPPEN(.RETURN,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($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),$G(CLINICSUBIEN),.SDATA)
;
S RETURN("Appointment","Cancelled")=$G(APPTIEN)
D BUILDJSON(.JSONRETURN,.RETURN) Q
Q
;
CANCEL40984(ERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,EAS) ;
N IENS,FDA40984,ERR84
;
S IENS=APPTIEN_","
;
I WALKIN="YES" D
.S FDA40984(409.84,IENS,.03)=""
.S FDA40984(409.84,IENS,.04)=""
S FDA40984(409.84,IENS,.12)=$$NOW^XLFDT
S FDA40984(409.84,IENS,.121)=DUZ
S FDA40984(409.84,IENS,.122)=CANCELREASONIEN
S FDA40984(409.84,IENS,.17)=CANBYCLINORPAT
S FDA40984(409.84,IENS,100)=EAS
;
L +^SDEC(APPTIEN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,192) Q
D FILE^DIE("","FDA40984","ERR84") K FDA40984
L -^SDEC(APPTIEN)
I $D(ERR84) D ERRLOG^SDESJSON(.ERRORS,191) Q
Q
;
CANCEL44(ERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44) ;
N IENS,FDA44003,ERR44003
;
I WALKIN="YES" D
.S FDA44003(44.003,IENS44,309)=""
S FDA44003(44.003,IENS44,310)="C"
;
L +^SC(CLINICIEN):3 I '$T D ERRLOG^SDESJSON(.ERRORS,186),CLEAN40984(APPTIEN) Q
D FILE^DIE("","FDA44003","ERR44003") K FDA44003
L -^SC(CLINICIEN)
I $D(ERR44003) D ERRLOG^SDESJSON(.ERRORS,191) D CLEAN40984(APPTIEN) Q
Q
;
CANCEL2(ERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,NOTE,APPTIEN,CLINICIEN,IENS44) ;
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):3 I '$T D ERRLOG^SDESJSON(.ERRORS,187),CLEAN40984(APPTIEN),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) Q
D FILE^DIE("","FDA298","ERR298") K FDA298
L -^DPT(DFN)
I $D(ERR298) D ERRLOG^SDESJSON(.ERRORS,191),CLEAN40984(APPTIEN),CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) Q
Q
;
UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,NEWPID) ;
N RECALLREQIEN,RECALLREQLINK,OLDRECALLPTR,PROVIDERIEN
;
I REQUESTTYPE="APPTREQ"!(REQUESTTYPE="RTC")!(REQUESTTYPE="VETERAN")!(REQUESTTYPE="MOBILE") D
.D OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT)
.D DELETEAPPTDATA(REQUESTIEN)
.D UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
.I $G(NEWPID),CANBYCLINORPAT="PC" D
..D ADDPIDHISTORY^SDESCREATEAPPREQ(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=$$GET1^DIQ(44,CLINICIEN,16,"I")
.D REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIDERIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
.D UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
;
Q
;
OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT) ;
N REQUESTFDA,REQUESTERR,PARENTFDA,PARENTERR,REASONALLOWSOPEN,CANEDITPID
;
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'=0 D
.S REQUESTFDA(409.85,REQUESTIEN_",",19)=""
.S REQUESTFDA(409.85,REQUESTIEN_",",20)=""
.S REQUESTFDA(409.85,REQUESTIEN_",",21)=""
.; 864
.;S REQUESTFDA(409.85,REQUESTIEN_",",23)="OPEN"
.S REQUESTFDA(409.85,REQUESTIEN_",",23)="O"
.S REQUESTFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
.D FILE^DIE("","REQUESTFDA","REQUESTERR") K REQUESTFDA,REQUESTERR
;
; do not re-open
I REASONALLOWSOPEN=0 D
.S REQUESTFDA(409.85,REQUESTIEN_",",19)=$P($$GET1^DIQ(409.84,APPTIEN,.12,"I"),".",1)
.S REQUESTFDA(409.85,REQUESTIEN_",",20)=$$GET1^DIQ(409.84,APPTIEN,.121,"I")
.S REQUESTFDA(409.85,REQUESTIEN_",",21)=$O(^SDEC(409.853,"B","CANCELLED NOT RE-OPENED",""))
.S REQUESTFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
.D FILE^DIE("","REQUESTFDA","REQUESTERR") K REQUESTFDA,REQUESTERR
;
I MRTC D
.D UPDATEMRTCSEQNUM(PARENTREQUEST,DFN)
.D REMOVEMRTCAPTIEN(REQUESTIEN,APPTIEN,PARENTREQUEST)
.I PARENTSTATUS="C" D
..S PARENTFDA(409.85,PARENTREQUEST_",",19)=""
..S PARENTFDA(409.85,PARENTREQUEST_",",20)=""
..S PARENTFDA(409.85,PARENTREQUEST_",",21)=""
..; 864
..;S PARENTFDA(409.85,PARENTREQUEST_",",23)="OPEN"
..S PARENTFDA(409.85,PARENTREQUEST_",",23)="O"
..D FILE^DIE("","PARENTFDA","PARENTERR") K PARENTFDA
Q
;
UPDATEMRTCSEQNUM(PARENTREQUEST,DFN) ;
N COUNT,REQUESTIEN,IENS,NEXTSEQUENCENUM,CHILD,LASTCHILD,MRTCFDA,ERR
;
S REQUESTIEN=0,COUNT=0,LASTCHILD=""
F S REQUESTIEN=$O(^SDEC(409.85,"B",DFN,REQUESTIEN)) Q:'REQUESTIEN D
.I $$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")=PARENTREQUEST D
..I $$GET1^DIQ(409.85,REQUESTIEN,21,"I") Q
..S COUNT=COUNT+1
..S CHILD(REQUESTIEN)=COUNT
;
S REQUESTIEN=0
F S REQUESTIEN=$O(CHILD(REQUESTIEN)) Q:'REQUESTIEN D
.S MRTCFDA(409.85,REQUESTIEN_",",43.1)=$G(CHILD(REQUESTIEN))
.D FILE^DIE(,"MRTCFDA","ERR") K MRTCFDA
Q
;
REMOVEENCOUNTER(APPTIEN,ENCOUNTERIEN,APPTSTARTTIME,DFN,IENS44) ;
N PROCESSTYPE,APPTFDA,ENCOUNTERFDA,CHILDIEN,CHILDFDA,CHILDPROCESSTYPE,VISITUPDATE,PATIENTFDA,CLINICFDA,CLINICIENS,DISPOSITIONFDA,DISPOSITIONIEN,CLASSIEN,CLASSFDA
I '$G(ENCOUNTERIEN)!('$$EDITOK^SDCO3($G(ENCOUNTERIEN),2)) Q
S PROCESSTYPE=$$GET1^DIQ(409.68,ENCOUNTERIEN,.08,"E")
;
; child encounters
I $G(PROCESSTYPE),$G(PROCESSTYPE)'="CREDIT STOP CODE" D
.S CHILDIEN=0
.F S CHILDIEN=$O(^SCE("APAR",ENCOUNTERIEN,CHILDIEN)) Q:'CHILDIEN D
..I '$$EDITOK^SDCO3(CHILDIEN,2) Q
..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)=$G(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) ;
N SUBIEN,FDA
S SUBIEN=0
S SUBIEN=$O(^SDEC(409.85,PARENTIEN,2,"B",REQUESTIEN,SUBIEN)) Q:'SUBIEN
S FDA(409.852,SUBIEN_","_PARENTIEN_",",.02)="@"
D FILE^DIE(,"FDA","FDAERR") K FDA
Q
;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN) ;
N FOUND,IENS44003
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) ;
N FDA,IENS
S IENS=APPTIEN_","
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) ;
N FDA44003,IENS,ERR44003
S FDA44003(44.003,IENS44,310)=""
D FILE^DIE("","FDA44003","ERR44003") K FDA44003
Q
;
BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,SDATA) ;
N SDDA,SDCPHDL
S SDDA=$$SCIEN^SDECU2(DFN,CLINICIEN,APPTSTARTTIME)
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
D BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDCPHDL)
Q $G(SDDA)
;
AFTEREVENT(DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDATA) ;
N SDCPHDL
S SDCPHDL=$$HANDLE^SDAMEVT(1)
S SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
D CANCEL^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,2,SDCPHDL)
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
;
VALIDATE(APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASON,NOTE,CANCELHASH,EAS,NEWPID) ;
D ORDERCHECKLOCK(.ERRORS,APPTIEN,DFN)
D VALIDATEAPPTIEN(.ERRORS,APPTIEN)
D VALIDATECLINIC(.ERRORS,CLINICIEN,APPTIEN)
D VALIDATEDFN(.ERRORS,DFN,APPTIEN)
D VALIDATECANBY(.ERRORS,CANBYCLINORPAT)
D VALIDATECANREAS(.ERRORS,CANCELREASON)
D VALIDATENOTE(.ERRORS,NOTE,CANCELHASH)
D VALIDATEEAS(.ERRORS,EAS)
D VALIDATENEWPID(.ERRORS,.NEWPID,CANBYCLINORPAT,APPTIEN)
Q
;
ORDERCHECKLOCK(ERRORS,APPTIEN,DFN) ;
N FOUND,REQUESTIEN,ORDERID,APPTREQTYPE,REQTYPE
S APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
S REQUESTIEN=$P($G(APPTREQTYPE),";")
S REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
I REQTYPE="RTC" D
.S ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
.I '+$G(ORDERID) Q
.I $D(^XTMP("ORPTLK-"_DFN)) D ERRLOG^SDESJSON(.ERRORS,188) S FOUND=1
Q
;
VALIDATENEWPID(ERRORS,PID,CANBYCLINORPAT,APPTIEN) ;
I $G(PID)'="" D
.S PID=$$ISOTFM^SDAMUTDT(PID)
.I PID=-1!($P(PID,".",2)) D ERRLOG^SDESJSON(.ERRORS,160) Q
.I CANBYCLINORPAT="C" D ERRLOG^SDESJSON(.ERRORS,448) Q
.I $P($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";",2)="GMR(123," D ERRLOG^SDESJSON(.ERRORS,450) Q
.N APPTREQTYPE,REQUESTIEN
.S APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
.S REQUESTIEN=$P($G(APPTREQTYPE),";")
.I REQUESTIEN,$$DUPPIDCHK^SDES2CANCELAPPT(REQUESTIEN,PID) D ERRLOG^SDESJSON(.ERRORS,545) Q
Q
;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14) Q
I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,15) Q
I $$GET1^DIQ(409.84,APPTIEN,.12,"I") D ERRLOG^SDESJSON(.ERRORS,449) Q
Q
;
VALIDATECANBY(ERRORS,CANBYCLINORPAT) ;
I CANBYCLINORPAT="" D ERRLOG^SDESJSON(.ERRORS,190) Q
I CANBYCLINORPAT'="C",CANBYCLINORPAT'="PC" D ERRLOG^SDESJSON(.ERRORS,189) Q
Q
;
VALIDATECLINIC(ERRORS,CLINICIEN,APPTIEN) ;
N RESOURCEIEN,LINKEDCLINIC
I CLINICIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I CLINICIEN'="",'$D(^SC(CLINICIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
S RESOURCEIEN=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
S LINKEDCLINIC=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
I CLINICIEN'=LINKEDCLINIC D ERRLOG^SDESJSON(.ERRORS,193) Q
Q
;
VALIDATEDFN(ERRORS,DFN,APPTIEN) ;
I DFN="" D ERRLOG^SDESJSON(.ERRORS,1) Q
I DFN'="",'$D(^DPT(DFN,0)) D ERRLOG^SDESJSON(.ERRORS,2) Q
I $$GET1^DIQ(409.84,APPTIEN,.05,"I")'=DFN D ERRLOG^SDESJSON(.ERRORS,194) Q
Q
;
VALIDATECANREAS(ERRORS,CANCELREASON) ;
I CANCELREASON="" D ERRLOG^SDESJSON(.ERRORS,128) Q
I '$D(^SD(409.2,"B",CANCELREASON)) D ERRLOG^SDESJSON(.ERRORS,129) Q
S CANCELREASONIEN=$O(^SD(409.2,"B",CANCELREASON,0))
Q
;
VALIDATENOTE(ERRORS,NOTE,CANCELHASH) ;
N SDECJ
S NOTE=$TR($G(NOTE),"^"," ") ;
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
;
VALIDATEEAS(ERRORS,EAS) ;
I $L(EAS) S EAS=$$EASVALIDATE^SDESUTIL($G(EAS))
I $P($G(EAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q
Q
;
BUILDJSON(JSONRETURN,RETURN) ;.
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCANAPPT2 16120 printed Apr 09, 2024@21:40:37 Page 2
SDESCANAPPT2 ;ALB/DJS,LAB,MGD,BWF,BLB,ANU,MCB,JAS - SCHEDULING CANCEL APPOINTMENTS RPC ;FEB 16, 2024
+1 ;;5.3;Scheduling;**838,842,844,845,847,851,864,871,873**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Clone of SDESCANCELAPPTS - BLB
+5 ;
+6 ;APPTIEN - (required) pointer to SDEC APPOINTMENT file #409.84
+7 ;CLINICIEN -(required) pointer to hospital location file #44
+8 ;DFN -(required) pointer to patient file #2
+9 ;CANBYCLINORPAT - (required) appointment Status valid values: C=CANCELLED BY CLINIC ; PC=CANCELLED BY PATIENT
+10 ;CANCELREASON - (required) Cancellation Reason NAME in CANCELLATION REASON File (409.2)
+11 ;NOTE - (optional)
+12 ;CANCELHASH - (optional) List of cancellation comment hash tags
+13 ;EAS - (optional)
+14 ;NEWPID - (optional) New/edited PID passed in when cancelling an appointment by patient
+15 ;
+16 QUIT
+17 ;
CANAPPT2(JSONRETURN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASON,NOTE,CANCELHASH,EAS,NEWPID) ;
+1 NEW ERRORS,ISAPPTIENVALID,ORDERLOCK,ISCANBYVALID,ISCANREASONVALID,ISDFNVALID,SDATA,ISCLINICVALID,APPTENDTIME,APPTSTARTTIME,PROVIEN,ISEASVALID,ISCANBYVALID,ISNOTEVALID,ISCANDTTMVALID,EDITED,CLINICSUBIEN,IS2CANCELLED
+2 NEW RECALLREQIEN,RECALLREQLINK,RESOURCE,OLDRECALLPTR,RETURN,RECALLRET,CANCELREASONIEN,APPTLENGTH,MRTC,PARENTREQUEST,PARENTSTATUS,IS40984CANCELLED,IS44CANCELLED,REQUESTTYPE,REQUESTIEN,APPTTYPE
+3 ;
+4 ; input validation
+5 DO VALIDATE($GET(APPTIEN),$GET(CLINICIEN),$GET(DFN),$GET(CANBYCLINORPAT),$GET(CANCELREASON),$GET(NOTE),$GET(CANCELHASH),$GET(EAS),.NEWPID)
+6 IF $DATA(ERRORS)
SET ERRORS("Appointment",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+7 ;
+8 ; populate variables
+9 DO POPULATE(APPTIEN,.APPTSTARTTIME,.REQUESTTYPE,.REQUESTIEN,.APPTENDTIME,.APPTLENGTH,.APPTTYPE,.RESOURCE,.WALKIN,.MRTC,.PARENTREQUEST,.PARENTSTATUS,.SLOTSTATUSSTRING)
+10 SET IENS44=$$GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN)
+11 ; first event handler
+12 SET CLINICSUBIEN=$$BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,.SDATA)
+13 ;
+14 ; cancel appointments
+15 DO CANCEL40984(.ERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,$GET(EAS))
+16 DO CANCEL44(.ERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44)
+17 DO CANCEL2(.ERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,$GET(NOTE),APPTIEN,CLINICIEN,IENS44)
+18 IF $DATA(ERRORS)
SET ERRORS("Appointment",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+19 ;
+20 ; update linked appointment request records
+21 DO UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,$GET(NOTE),APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,$GET(NEWPID))
+22 ;
+23 ; update compensation and pension records
+24 IF APPTTYPE="COMPENSATION & PENSION"
DO AMIECAN^SDESCOMPPEN(.RETURN,DFN,APPTSTARTTIME)
+25 ;
+26 ; remove outpatient encounter
+27 DO REMOVEENCOUNTER(APPTIEN,$$GET1^DIQ(2.98,APPTSTARTTIME_","_DFN_",",21,"I"),APPTSTARTTIME,DFN,IENS44)
+28 ;
+29 ; update clinic availability
+30 ;
DO INCREMENTAVAIL1^SDESUTIL(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
+31 ;
+32 ; second event handler
+33 DO AFTEREVENT($GET(DFN),$GET(APPTSTARTTIME),$GET(CLINICIEN),$GET(CLINICSUBIEN),.SDATA)
+34 ;
+35 SET RETURN("Appointment","Cancelled")=$GET(APPTIEN)
+36 DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+37 QUIT
+38 ;
CANCEL40984(ERRORS,APPTIEN,CANCELREASON,CANBYCLINORPAT,WALKIN,EAS) ;
+1 NEW IENS,FDA40984,ERR84
+2 ;
+3 SET IENS=APPTIEN_","
+4 ;
+5 IF WALKIN="YES"
Begin DoDot:1
+6 SET FDA40984(409.84,IENS,.03)=""
+7 SET FDA40984(409.84,IENS,.04)=""
End DoDot:1
+8 SET FDA40984(409.84,IENS,.12)=$$NOW^XLFDT
+9 SET FDA40984(409.84,IENS,.121)=DUZ
+10 SET FDA40984(409.84,IENS,.122)=CANCELREASONIEN
+11 SET FDA40984(409.84,IENS,.17)=CANBYCLINORPAT
+12 SET FDA40984(409.84,IENS,100)=EAS
+13 ;
+14 LOCK +^SDEC(APPTIEN):3
IF '$TEST
DO ERRLOG^SDESJSON(.ERRORS,192)
QUIT
+15 DO FILE^DIE("","FDA40984","ERR84")
KILL FDA40984
+16 LOCK -^SDEC(APPTIEN)
+17 IF $DATA(ERR84)
DO ERRLOG^SDESJSON(.ERRORS,191)
QUIT
+18 QUIT
+19 ;
CANCEL44(ERRORS,CLINICIEN,APPTSTARTTIME,DFN,APPTIEN,WALKIN,IENS44) ;
+1 NEW IENS,FDA44003,ERR44003
+2 ;
+3 IF WALKIN="YES"
Begin DoDot:1
+4 SET FDA44003(44.003,IENS44,309)=""
End DoDot:1
+5 SET FDA44003(44.003,IENS44,310)="C"
+6 ;
+7 LOCK +^SC(CLINICIEN):3
IF '$TEST
DO ERRLOG^SDESJSON(.ERRORS,186)
DO CLEAN40984(APPTIEN)
QUIT
+8 DO FILE^DIE("","FDA44003","ERR44003")
KILL FDA44003
+9 LOCK -^SC(CLINICIEN)
+10 IF $DATA(ERR44003)
DO ERRLOG^SDESJSON(.ERRORS,191)
DO CLEAN40984(APPTIEN)
QUIT
+11 QUIT
+12 ;
CANCEL2(ERRORS,DFN,APPTSTARTTIME,CANBYCLINORPAT,CANCELREASON,NOTE,APPTIEN,CLINICIEN,IENS44) ;
+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):3
IF '$TEST
DO ERRLOG^SDESJSON(.ERRORS,187)
DO CLEAN40984(APPTIEN)
DO CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44)
QUIT
+9 DO FILE^DIE("","FDA298","ERR298")
KILL FDA298
+10 LOCK -^DPT(DFN)
+11 IF $DATA(ERR298)
DO ERRLOG^SDESJSON(.ERRORS,191)
DO CLEAN40984(APPTIEN)
DO CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44)
QUIT
+12 QUIT
+13 ;
UPDATEREQUEST(REQUESTIEN,APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE,MRTC,PARENTREQUEST,PARENTSTATUS,NEWPID) ;
+1 NEW RECALLREQIEN,RECALLREQLINK,OLDRECALLPTR,PROVIDERIEN
+2 ;
+3 IF REQUESTTYPE="APPTREQ"!(REQUESTTYPE="RTC")!(REQUESTTYPE="VETERAN")!(REQUESTTYPE="MOBILE")
Begin DoDot:1
+4 DO OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT)
+5 DO DELETEAPPTDATA(REQUESTIEN)
+6 DO UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
+7 IF $GET(NEWPID)
IF CANBYCLINORPAT="PC"
Begin DoDot:2
+8 DO ADDPIDHISTORY^SDESCREATEAPPREQ(REQUESTIEN,NEWPID)
End DoDot:2
End DoDot:1
+9 ;
+10 IF REQUESTTYPE="RECALL"
Begin DoDot:1
+11 DO REOPEN^SDESRECALLREQ(.RECALLRET,APPTIEN,,NEWPID,CANBYCLINORPAT)
+12 IF '$DATA(RECALLRET)
QUIT
+13 SET RECALLREQIEN=$PIECE($GET(RECALLRET),U)
+14 SET RECALLREQLINK=$PIECE($GET(RECALLRET,U),2)
+15 SET OLDRECALLPTR=$PIECE($GET(RECALLRET,U),3)
+16 DO UPDCONTSEQ^SDESCONTACTS($GET(DFN),$GET(RECALLREQIEN),$GET(RECALLREQLINK),$GET(OLDRECALLPTR))
End DoDot:1
+17 ;
+18 IF REQUESTTYPE="CONSULT"
Begin DoDot:1
+19 SET PROVIDERIEN=$$GET1^DIQ(44,CLINICIEN,16,"I")
+20 DO REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIDERIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
+21 DO UPDCONTSEQ^SDESCONTACTS(DFN,REQUESTIEN)
End DoDot:1
+22 ;
+23 QUIT
+24 ;
OPENAPPTREQUEST(REQUESTIEN,APPTIEN,MRTC,PARENTREQUEST,PARENTSTATUS,DFN,CANBYCLINORPAT) ;
+1 NEW REQUESTFDA,REQUESTERR,PARENTFDA,PARENTERR,REASONALLOWSOPEN,CANEDITPID
+2 ;
+3 SET REASONALLOWSOPEN=$$GET1^DIQ(409.2,$$GET1^DIQ(409.84,APPTIEN,.122,"I"),5,"I")
+4 SET CANEDITPID=$SELECT(CANBYCLINORPAT="C":0,CANBYCLINORPAT="PC":1,1:"")
+5 ;
+6 IF REASONALLOWSOPEN'=0
Begin DoDot:1
+7 SET REQUESTFDA(409.85,REQUESTIEN_",",19)=""
+8 SET REQUESTFDA(409.85,REQUESTIEN_",",20)=""
+9 SET REQUESTFDA(409.85,REQUESTIEN_",",21)=""
+10 ; 864
+11 ;S REQUESTFDA(409.85,REQUESTIEN_",",23)="OPEN"
+12 SET REQUESTFDA(409.85,REQUESTIEN_",",23)="O"
+13 SET REQUESTFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
+14 DO FILE^DIE("","REQUESTFDA","REQUESTERR")
KILL REQUESTFDA,REQUESTERR
End DoDot:1
+15 ;
+16 ; do not re-open
+17 IF REASONALLOWSOPEN=0
Begin DoDot:1
+18 SET REQUESTFDA(409.85,REQUESTIEN_",",19)=$PIECE($$GET1^DIQ(409.84,APPTIEN,.12,"I"),".",1)
+19 SET REQUESTFDA(409.85,REQUESTIEN_",",20)=$$GET1^DIQ(409.84,APPTIEN,.121,"I")
+20 SET REQUESTFDA(409.85,REQUESTIEN_",",21)=$ORDER(^SDEC(409.853,"B","CANCELLED NOT RE-OPENED",""))
+21 SET REQUESTFDA(409.85,REQUESTIEN_",",49)=CANEDITPID
+22 DO FILE^DIE("","REQUESTFDA","REQUESTERR")
KILL REQUESTFDA,REQUESTERR
End DoDot:1
+23 ;
+24 IF MRTC
Begin DoDot:1
+25 DO UPDATEMRTCSEQNUM(PARENTREQUEST,DFN)
+26 DO REMOVEMRTCAPTIEN(REQUESTIEN,APPTIEN,PARENTREQUEST)
+27 IF PARENTSTATUS="C"
Begin DoDot:2
+28 SET PARENTFDA(409.85,PARENTREQUEST_",",19)=""
+29 SET PARENTFDA(409.85,PARENTREQUEST_",",20)=""
+30 SET PARENTFDA(409.85,PARENTREQUEST_",",21)=""
+31 ; 864
+32 ;S PARENTFDA(409.85,PARENTREQUEST_",",23)="OPEN"
+33 SET PARENTFDA(409.85,PARENTREQUEST_",",23)="O"
+34 DO FILE^DIE("","PARENTFDA","PARENTERR")
KILL PARENTFDA
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
UPDATEMRTCSEQNUM(PARENTREQUEST,DFN) ;
+1 NEW COUNT,REQUESTIEN,IENS,NEXTSEQUENCENUM,CHILD,LASTCHILD,MRTCFDA,ERR
+2 ;
+3 SET REQUESTIEN=0
SET COUNT=0
SET LASTCHILD=""
+4 FOR
SET REQUESTIEN=$ORDER(^SDEC(409.85,"B",DFN,REQUESTIEN))
if 'REQUESTIEN
QUIT
Begin DoDot:1
+5 IF $$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")=PARENTREQUEST
Begin DoDot:2
+6 IF $$GET1^DIQ(409.85,REQUESTIEN,21,"I")
QUIT
+7 SET COUNT=COUNT+1
+8 SET CHILD(REQUESTIEN)=COUNT
End DoDot:2
End DoDot:1
+9 ;
+10 SET REQUESTIEN=0
+11 FOR
SET REQUESTIEN=$ORDER(CHILD(REQUESTIEN))
if 'REQUESTIEN
QUIT
Begin DoDot:1
+12 SET MRTCFDA(409.85,REQUESTIEN_",",43.1)=$GET(CHILD(REQUESTIEN))
+13 DO FILE^DIE(,"MRTCFDA","ERR")
KILL MRTCFDA
End DoDot:1
+14 QUIT
+15 ;
REMOVEENCOUNTER(APPTIEN,ENCOUNTERIEN,APPTSTARTTIME,DFN,IENS44) ;
+1 NEW 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 PROCESSTYPE=$$GET1^DIQ(409.68,ENCOUNTERIEN,.08,"E")
+4 ;
+5 ; child encounters
+6 IF $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 IF '$$EDITOK^SDCO3(CHILDIEN,2)
QUIT
+10 SET CHILDFDA(409.68,CHILDIEN_",",.01)="@"
+11 DO FILE^DIE(,"CHILDFDA")
KILL CHILDFDA
+12 SET VISITUPDATE=$$KILL^VSITKIL($$GET1^DIQ(409.68,CHILDIEN,.05,"I"))
End DoDot:2
End DoDot:1
+13 ;
+14 ; patient file and check-in from clinic file
+15 IF PROCESSTYPE="APPOINTMENT"
Begin DoDot:1
+16 SET PATIENTFDA(2.98,APPTSTARTTIME_","_DFN_",",21)="@"
+17 DO FILE^DIE(,"PATIENTFDA")
KILL PATIENTFDA
+18 SET CLINICFDA(44.003,IENS44,303)="@"
+19 DO FILE^DIE(,"CLINICFDA")
KILL CLINICFDA
End DoDot:1
+20 ;
+21 ; disposition subfile in patient file
+22 IF PROCESSTYPE="DISPOSITION"
Begin DoDot:1
+23 SET DISPOSITIONIEN=$$GET1^DIQ(409.68,ENCOUNTERIEN,.09,"I")
+24 SET DISPOSITIONFDA(2.101,DISPOSITIONIEN_","_DFN_",",18)="@"
+25 DO FILE^DIE(,"DISPOSITIONFDA")
KILL DISPOSITIONFDA
End DoDot:1
+26 ;
+27 ; outpatient classification file
+28 IF '$$GET1^DIQ(409.68,ENCOUNTERIEN,.06,"I")
IF $ORDER(^SDD(409.42,"AO",ENCOUNTERIEN,0))>0
Begin DoDot:1
+29 SET CLASSIEN=0
+30 FOR
SET CLASSIEN=$ORDER(^SDD(409.42,"AO",ENCOUNTERIEN,CLASSIEN))
if 'CLASSIEN
QUIT
Begin DoDot:2
+31 SET CLASSFDA(409.42,CLASSIEN_",",.01)="@"
+32 DO FILE^DIE(,"CLASSFDA")
KILL CLASSFDA
End DoDot:2
End DoDot:1
+33 ;
+34 ; outpatient encounter file
+35 SET ENCOUNTERFDA(409.68,ENCOUNTERIEN_",",.01)="@"
+36 DO FILE^DIE(,"ENCOUNTERFDA")
KILL ENCOUNTERFDA
+37 SET VISITUPDATE=$$KILL^VSITKIL($$GET1^DIQ(409.68,ENCOUNTERIEN,.05,"I"))
+38 ;
+39 ; delete checkout in appointment file
+40 IF $$GET1^DIQ(409.84,APPTIEN,.14,"I")
Begin DoDot:1
+41 SET APPTFDA(409.84,APPTIEN_",",.14)="@"
+42 SET APPTFDA(409.84,APPTIEN_",",.08)=$GET(DUZ)
+43 DO FILE^DIE(,"APPTFDA")
KILL APPTFDA
End DoDot:1
+44 QUIT
+45 ;
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 NEW SUBIEN,FDA
+2 SET SUBIEN=0
+3 SET SUBIEN=$ORDER(^SDEC(409.85,PARENTIEN,2,"B",REQUESTIEN,SUBIEN))
if 'SUBIEN
QUIT
+4 SET FDA(409.852,SUBIEN_","_PARENTIEN_",",.02)="@"
+5 DO FILE^DIE(,"FDA","FDAERR")
KILL FDA
+6 QUIT
+7 ;
GET44RECORDIENS(CLINICIEN,APPTSTARTTIME,DFN) ;
+1 NEW FOUND,IENS44003
+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) ;
+1 NEW FDA,IENS
+2 SET IENS=APPTIEN_","
+3 SET FDA(409.84,IENS,.12)=""
+4 SET FDA(409.84,IENS,.121)=""
+5 SET FDA(409.84,IENS,.122)=""
+6 SET FDA(409.84,IENS,.17)=""
+7 SET FDA(409.84,IENS,100)=""
+8 DO FILE^DIE("","FDA")
KILL FDA
+9 QUIT
+10 ;
CLEAN44003(DFN,CLINICIEN,APPTSTARTTIME,IENS44) ;
+1 NEW FDA44003,IENS,ERR44003
+2 SET FDA44003(44.003,IENS44,310)=""
+3 DO FILE^DIE("","FDA44003","ERR44003")
KILL FDA44003
+4 QUIT
+5 ;
BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,SDATA) ;
+1 NEW SDDA,SDCPHDL
+2 SET SDDA=$$SCIEN^SDECU2(DFN,CLINICIEN,APPTSTARTTIME)
+3 SET SDCPHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
+4 DO BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDCPHDL)
+5 QUIT $GET(SDDA)
+6 ;
AFTEREVENT(DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDATA) ;
+1 NEW SDCPHDL
+2 SET SDCPHDL=$$HANDLE^SDAMEVT(1)
+3 SET SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
+4 DO CANCEL^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,2,SDCPHDL)
+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
+14 ;
VALIDATE(APPTIEN,CLINICIEN,DFN,CANBYCLINORPAT,CANCELREASON,NOTE,CANCELHASH,EAS,NEWPID) ;
+1 DO ORDERCHECKLOCK(.ERRORS,APPTIEN,DFN)
+2 DO VALIDATEAPPTIEN(.ERRORS,APPTIEN)
+3 DO VALIDATECLINIC(.ERRORS,CLINICIEN,APPTIEN)
+4 DO VALIDATEDFN(.ERRORS,DFN,APPTIEN)
+5 DO VALIDATECANBY(.ERRORS,CANBYCLINORPAT)
+6 DO VALIDATECANREAS(.ERRORS,CANCELREASON)
+7 DO VALIDATENOTE(.ERRORS,NOTE,CANCELHASH)
+8 DO VALIDATEEAS(.ERRORS,EAS)
+9 DO VALIDATENEWPID(.ERRORS,.NEWPID,CANBYCLINORPAT,APPTIEN)
+10 QUIT
+11 ;
ORDERCHECKLOCK(ERRORS,APPTIEN,DFN) ;
+1 NEW FOUND,REQUESTIEN,ORDERID,APPTREQTYPE,REQTYPE
+2 SET APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
+3 SET REQUESTIEN=$PIECE($GET(APPTREQTYPE),";")
+4 SET REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
+5 IF REQTYPE="RTC"
Begin DoDot:1
+6 SET ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
+7 IF '+$GET(ORDERID)
QUIT
+8 IF $DATA(^XTMP("ORPTLK-"_DFN))
DO ERRLOG^SDESJSON(.ERRORS,188)
SET FOUND=1
End DoDot:1
+9 QUIT
+10 ;
VALIDATENEWPID(ERRORS,PID,CANBYCLINORPAT,APPTIEN) ;
+1 IF $GET(PID)'=""
Begin DoDot:1
+2 SET PID=$$ISOTFM^SDAMUTDT(PID)
+3 IF PID=-1!($PIECE(PID,".",2))
DO ERRLOG^SDESJSON(.ERRORS,160)
QUIT
+4 IF CANBYCLINORPAT="C"
DO ERRLOG^SDESJSON(.ERRORS,448)
QUIT
+5 IF $PIECE($$GET1^DIQ(409.84,APPTIEN,.22,"I"),";",2)="GMR(123,"
DO ERRLOG^SDESJSON(.ERRORS,450)
QUIT
+6 NEW APPTREQTYPE,REQUESTIEN
+7 SET APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
+8 SET REQUESTIEN=$PIECE($GET(APPTREQTYPE),";")
+9 IF REQUESTIEN
IF $$DUPPIDCHK^SDES2CANCELAPPT(REQUESTIEN,PID)
DO ERRLOG^SDESJSON(.ERRORS,545)
QUIT
End DoDot:1
+10 QUIT
+11 ;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
+1 IF APPTIEN=""
DO ERRLOG^SDESJSON(.ERRORS,14)
QUIT
+2 IF APPTIEN'=""
IF '$DATA(^SDEC(409.84,APPTIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,15)
QUIT
+3 IF $$GET1^DIQ(409.84,APPTIEN,.12,"I")
DO ERRLOG^SDESJSON(.ERRORS,449)
QUIT
+4 QUIT
+5 ;
VALIDATECANBY(ERRORS,CANBYCLINORPAT) ;
+1 IF CANBYCLINORPAT=""
DO ERRLOG^SDESJSON(.ERRORS,190)
QUIT
+2 IF CANBYCLINORPAT'="C"
IF CANBYCLINORPAT'="PC"
DO ERRLOG^SDESJSON(.ERRORS,189)
QUIT
+3 QUIT
+4 ;
VALIDATECLINIC(ERRORS,CLINICIEN,APPTIEN) ;
+1 NEW RESOURCEIEN,LINKEDCLINIC
+2 IF CLINICIEN=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+3 IF CLINICIEN'=""
IF '$DATA(^SC(CLINICIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+4 SET RESOURCEIEN=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+5 SET LINKEDCLINIC=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
+6 IF CLINICIEN'=LINKEDCLINIC
DO ERRLOG^SDESJSON(.ERRORS,193)
QUIT
+7 QUIT
+8 ;
VALIDATEDFN(ERRORS,DFN,APPTIEN) ;
+1 IF DFN=""
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT
+2 IF DFN'=""
IF '$DATA(^DPT(DFN,0))
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT
+3 IF $$GET1^DIQ(409.84,APPTIEN,.05,"I")'=DFN
DO ERRLOG^SDESJSON(.ERRORS,194)
QUIT
+4 QUIT
+5 ;
VALIDATECANREAS(ERRORS,CANCELREASON) ;
+1 IF CANCELREASON=""
DO ERRLOG^SDESJSON(.ERRORS,128)
QUIT
+2 IF '$DATA(^SD(409.2,"B",CANCELREASON))
DO ERRLOG^SDESJSON(.ERRORS,129)
QUIT
+3 SET CANCELREASONIEN=$ORDER(^SD(409.2,"B",CANCELREASON,0))
+4 QUIT
+5 ;
VALIDATENOTE(ERRORS,NOTE,CANCELHASH) ;
+1 NEW SDECJ
+2 ;
SET NOTE=$TRANSLATE($GET(NOTE),"^"," ")
+3 IF $GET(CANCELHASH)'=""
FOR SDECJ=$LENGTH(CANCELHASH,U):-1:1
SET NOTE=$PIECE(CANCELHASH,U,SDECJ)_"_"_NOTE
+4 IF $EXTRACT(NOTE,$LENGTH(NOTE))="_"
SET NOTE=$EXTRACT(NOTE,1,$LENGTH(NOTE)-1)
+5 QUIT NOTE
+6 ;
VALIDATEEAS(ERRORS,EAS) ;
+1 IF $LENGTH(EAS)
SET EAS=$$EASVALIDATE^SDESUTIL($GET(EAS))
+2 IF $PIECE($GET(EAS),U)=-1
DO ERRLOG^SDESJSON(.ERRORS,142)
QUIT
+3 QUIT
+4 ;
BUILDJSON(JSONRETURN,RETURN) ;.
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
+3 QUIT
+4 ;
