- SDESCANAPPT2 ;ALB/DJS,LAB,MGD,BWF,BLB,ANU,MCB,JAS,BLB - SCHEDULING CANCEL APPOINTMENTS RPC ;FEB 16, 2024
- ;;5.3;Scheduling;**838,842,844,845,847,851,864,871,873,877**;Aug 13, 1993;Build 14
- ;;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)
- .I $G(NEWPID) D
- ..D UPDATECONSULTPID^SDES2APPTUTIL(REQUESTIEN,$G(NEWPID),DFN)
- ;
- 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
- .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 16116 printed Feb 19, 2025@00:22:24 Page 2
- SDESCANAPPT2 ;ALB/DJS,LAB,MGD,BWF,BLB,ANU,MCB,JAS,BLB - SCHEDULING CANCEL APPOINTMENTS RPC ;FEB 16, 2024
- +1 ;;5.3;Scheduling;**838,842,844,845,847,851,864,871,873,877**;Aug 13, 1993;Build 14
- +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)
- +22 IF $GET(NEWPID)
- Begin DoDot:2
- +23 DO UPDATECONSULTPID^SDES2APPTUTIL(REQUESTIEN,$GET(NEWPID),DFN)
- End DoDot:2
- End DoDot:1
- +24 ;
- +25 QUIT
- +26 ;
- 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 NEW APPTREQTYPE,REQUESTIEN
- +6 SET APPTREQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
- +7 SET REQUESTIEN=$PIECE($GET(APPTREQTYPE),";")
- +8 IF REQUESTIEN
- IF $$DUPPIDCHK^SDES2CANCELAPPT(REQUESTIEN,PID)
- DO ERRLOG^SDESJSON(.ERRORS,545)
- QUIT
- End DoDot:1
- +9 QUIT
- +10 ;
- 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 ;