- SDES2APPTUTIL ;ALB/BLB,TJB/ANU/BLB/LAB,BLB,LAB,BWF - SDES2 CREATE APPOINTMENT UTILITIES ;OCT 23,2024
- ;;5.3;Scheduling;**866,871,875,877,878,880,881,890,893**;Aug 13, 1993;Build 6
- ;;Per VHA Directive 6402, this routine should not be modified
- ;---------------------------------------------------------------
- Q
- ;
- APPTREQ(SDCONTEXT,APPOINTMENT,APPTIEN,APPTMSG) ; called only on create of appointment
- N STARTDATETIME,CLINICIEN,REQUESTIEN,REQUESTTYPE,SDUSER
- S REQUESTIEN=$P($G(APPOINTMENT("REQUEST TYPE")),"|",2)
- S REQUESTTYPE=$P($G(APPOINTMENT("REQUEST TYPE")),"|")
- ;
- S STARTDATETIME=$G(APPOINTMENT("START DATE TIME")),CLINICIEN=$G(APPOINTMENT("CLINIC IEN"))
- D ADDPIDHISTORY^SDESCREATEAPPREQ($P($G(APPOINTMENT("REQUEST TYPE")),"|",2),$G(APPOINTMENT("PATIENT INDICATED DATE")))
- ;
- S SDUSER=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
- D BUILDAPPTDATA^SDESEDITAPPTREQ(REQUESTIEN,STARTDATETIME,CLINICIEN,$G(APPOINTMENT("SERVICE CONNECTED PERCENTAGE")),$G(APPOINTMENT("SERVICE CONNECTED")),$G(APPOINTMENT("APPOINTMENT TYPE")),$G(SDCONTEXT("ACHERON AUDIT ID")),SDUSER,.APPTMSG)
- I $G(APPOINTMENT("MRTC PARENT")),$G(APPOINTMENT("MRTC")) D
- .D MRTCCHILD($G(APPOINTMENT("PATIENT INDICATED DATE")),REQUESTIEN,APPTIEN,$G(APPOINTMENT("MRTC PARENT")))
- Q
- ;
- RECALL(RECALLRETURN,SDCONTEXT,RECALL,REQUESTIEN) ;
- S RECALL("RECALL IEN")=REQUESTIEN
- S RECALL("DELETE REASON")=7
- D DISPRECALL^SDES2DISPRECALL(.RECALLRETURN,.SDCONTEXT,.RECALL)
- Q
- ;
- CONSULT(APPOINTMENT,APPTIEN44,USERID) ;
- N FDA,REQUESTIEN,PROVIDERIEN,NOTE,STARTDATETIME,RESOURCEIEN,DFN,CLINICIEN,NETSTARTDT,GMRCDUZ
- ;
- S REQUESTIEN=$P($G(APPOINTMENT("REQUEST TYPE")),"|",2)
- S PROVIDERIEN=$G(APPOINTMENT("PROVIDER IEN"))
- S NOTE=$G(APPOINTMENT("NOTE"))
- S STARTDATETIME=$G(APPOINTMENT("START DATE TIME"))
- S NETSTARTDT=$$FMTONET^SDECDATE(STARTDATETIME)
- S RESOURCEIEN=$G(APPOINTMENT("RESOURCE IEN"))
- S DFN=$G(APPOINTMENT("DFN"))
- S CLINICIEN=$G(APPOINTMENT("CLINIC IEN"))
- D REQSET(REQUESTIEN,USERID,"SCHEDULED","",$TR($E(NOTE,1,150),"^"," "),STARTDATETIME,CLINICIEN,DFN)
- ;
- S FDA(44.003,APPTIEN44_","_STARTDATETIME_","_CLINICIEN_",",688)=REQUESTIEN
- D UPDATE^DIE("","FDA") K FDA
- ;
- D UPDATECONSULTPID(REQUESTIEN,$G(APPOINTMENT("PATIENT INDICATED DATE")),DFN,.USERID)
- Q
- ;
- REQSET(REQUESTIEN,USERID,ACTION,CANCELLEDBY,NOTE,STARTDATETIME,CLINICIEN,DFN) ;
- N %DT,X,SD,TMPYCLNC
- ;
- I $$GET1^DIQ(123,REQUESTIEN_",",8,"E")="DISCONTINUED"!($$GET1^DIQ(123,REQUESTIEN_",",8,"E")="COMPLETE") Q
- ;
- I ACTION="SCHEDULED" D
- .D EDITCS^SDCNSLT(STARTDATETIME,NOTE,CLINICIEN_U_$$GET1^DIQ(44,CLINICIEN,.01,"E"),REQUESTIEN)
- ;
- I ACTION="CANCELLED" D
- .D SDECCAN^SDCNSLT(REQUESTIEN,$$GET1^DIQ(123,REQUESTIEN,.02,"I"),STARTDATETIME,CLINICIEN,CANCELLEDBY,$$GET44APPTIEN^SDES2NOSHOW(CLINICIEN,STARTDATETIME,DFN),NOTE)
- Q
- ;
- UPDATECONSULTPID(CONSULTIEN,PID,DFN,USERIEN) ;
- N CONSULTPIDIEN,CONSULTFDA,CONSULTSUBFDA,TOPLEVELIEN
- ;
- I '$D(^SDEC(409.87,"B",CONSULTIEN)) D
- .S CONSULTFDA(409.87,"+1,",.01)=CONSULTIEN
- .S CONSULTFDA(409.87,"+1,",.02)=DFN
- .D UPDATE^DIE("","CONSULTFDA","TOPLEVELIEN") K CONSULTFDA
- .;
- .S CONSULTSUBFDA(409.871,"+1,"_TOPLEVELIEN(1)_",",.01)=$$NOW^XLFDT
- .S CONSULTSUBFDA(409.871,"+1,"_TOPLEVELIEN(1)_",",1)=PID
- .S CONSULTSUBFDA(409.871,"+1,"_TOPLEVELIEN(1)_",",2)=$S($G(USERIEN):USERIEN,1:DUZ)
- .D UPDATE^DIE("","CONSULTSUBFDA") K CONSULTSUBFDA
- ;
- ; file consult pid history subfile only
- S CONSULTPIDIEN=$O(^SDEC(409.87,"B",CONSULTIEN,0))
- I $D(^SDEC(409.87,"B",CONSULTIEN)) D
- .I $$CONSPIDCHECK^SDEC07(CONSULTIEN,PID) D
- ..S CONSULTSUBFDA(409.871,"+1,"_CONSULTPIDIEN_",",.01)=$$NOW^XLFDT
- ..S CONSULTSUBFDA(409.871,"+1,"_CONSULTPIDIEN_",",1)=PID
- ..S CONSULTSUBFDA(409.871,"+1,"_CONSULTPIDIEN_",",2)=$S($G(USERIEN):USERIEN,1:DUZ)
- ..D UPDATE^DIE("","CONSULTSUBFDA") K CONSULTSUBFDA
- Q
- ;
- CONSPIDCHECK(SDRIEN1,SDDDT) ;
- N CHIEN,CHSIEN,OLDPID
- S CHIEN=$O(^SDEC(409.87,"B",SDRIEN1,0))
- S CHSIEN=$O(^SDEC(409.87,CHIEN,1,9999999),-1)
- S OLDPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
- I OLDPID'=$G(SDDDT) Q 1
- Q 0
- ;
- ENCOUNTERS(APPOINTMENT,ENCOUNTER) ;
- I $$NOW^XLFDT>$G(APPOINTMENT("START DATE TIME")),$$NEW^SDPCE($G(APPOINTMENT("START DATE TIME"))) D
- .S ENCOUNTER=$$GETAPT^SDVSIT2($G(APPOINTMENT("DFN")),$G(APPOINTMENT("START DATE TIME")),$G(APPOINTMENT("CLINIC IEN")))
- Q
- ;
- MAKE(DFN,STARTDATETIME,CLINICIEN) ;
- D MAKE^SDAMEVT(DFN,STARTDATETIME,CLINICIEN,$$SCIEN^SDECU2(DFN,CLINICIEN,STARTDATETIME),2)
- Q
- ;
- GETRESOURCE(ERRORS,APPOINTMENT,CLINICIEN) ;
- N RESOURCE,MATCH
- ;
- I '$G(APPOINTMENT("RESOURCE IEN")) D
- .S RESOURCE=0,MATCH=0
- .F S RESOURCE=$O(^SDEC(409.831,"ALOC",CLINICIEN,RESOURCE)) Q:RESOURCE'>0!(MATCH>0) D
- ..I $$GET1^DIQ(409.831,RESOURCE_",",.012,"E")'="CLINIC" Q
- ..S APPOINTMENT("RESOURCE IEN")=RESOURCE,MATCH=1
- ;
- I $$GET1^DIQ(409.831,$G(APPOINTMENT("RESOURCE IEN")),.04,"I")'=$G(CLINICIEN) D ERRLOG^SDESJSON(.ERRORS,366) Q
- Q
- ;
- GETPROVIDER(APPOINTMENT,CLINICIEN,PROVIDER,REQUESTTYPE,REQUESTIEN) ;
- N DEFAULTPROVIEN,PROVIDERIEN
- ;
- I $L($G(PROVIDER)) Q
- ;
- I REQUESTTYPE="R" D Q
- .S APPOINTMENT("PROVIDER IEN")=$$GET1^DIQ(403.54,$$GET1^DIQ(403.5,REQUESTIEN,4,"I"),.01,"I")
- ;
- S PROVIDERIEN=0,DEFAULTPROVIEN=""
- F S PROVIDERIEN=$O(^SC(CLINICIEN,"PR",PROVIDERIEN)) Q:'PROVIDERIEN!($G(DEFAULTPROVIEN)) D
- .I $$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.02,"I") S DEFAULTPROVIEN=$$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.01,"I")
- S APPOINTMENT("PROVIDER IEN")=DEFAULTPROVIEN
- ;
- Q
- ;
- MRTCCHILD(PID,REQUESTIEN,APPTIEN,PARENT) ;
- N REQUEST
- S REQUEST("MRTC","PATIENT INDICATED DATE")=$G(APPOINTMENT("PATIENT INDICATED DATE"))
- S REQUEST("MRTC","CHILD REQUEST")=REQUESTIEN
- S REQUEST("MRTC","MRTC APPOINTMENT")=$G(APPTIEN)
- D BUILDMRTCLINKS^SDESEDITAPPTREQ(.REQUEST,$G(APPOINTMENT("MRTC PARENT")))
- D BUILDMRTCPID^SDESEDITAPPTREQ(.REQUEST,$G(APPOINTMENT("MRTC PARENT")))
- Q
- ;
- STOREREQUESTCOMM(REQUESTIEN) ;
- N SUBIEN,PATIENTCOMMENTS
- ;
- I $D(^SDEC(409.85,REQUESTIEN,"PATCOM",0)) D
- .S SUBIEN=0
- .F S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN)) Q:'SUBIEN D
- ..S PATIENTCOMMENTS(SUBIEN)=$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")
- D WP^DIE(409.84,APPTIEN_",",4,"","PATIENTCOMMENTS")
- Q
- ;
- STORENOTE(APPTIEN,NOTE,APPTNOTES) ;
- I $L(NOTE) D
- .D WP^SDECUTL(.APPTNOTES,NOTE)
- .D WP^DIE(409.84,APPTIEN_",",1,"","APPTNOTES")
- Q
- ;
- REQUESTTYPE(ERRORS,APPOINTMENTS,REQUESTTYPE,REQUESTIEN,DFN) ;
- I '$L($G(APPOINTMENT("REQUEST TYPE"))) D ERRLOG^SDESJSON(.ERRORS,60) Q
- ;
- I REQUESTTYPE'="A",REQUESTTYPE'="R",REQUESTTYPE'="C" D ERRLOG^SDESJSON(.ERRORS,61) Q
- ;
- I '$G(REQUESTIEN) D ERRLOG^SDESJSON(.ERRORS,61) Q
- ;
- I REQUESTTYPE="R",'$D(^SD(403.5,REQUESTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,61) Q
- I REQUESTTYPE="C",'$D(^GMR(123,REQUESTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,61) Q
- I REQUESTTYPE="A",'$D(^SDEC(409.85,REQUESTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,61) Q
- ;
- I REQUESTTYPE="A",$$GET1^DIQ(409.85,$G(REQUESTIEN),23,"I")="C" D ERRLOG^SDESJSON(.ERRORS,433) Q
- ;
- I REQUESTTYPE="C" D
- .I $$GET1^DIQ(123,REQUESTIEN_",",8,"E")'="PENDING",$$GET1^DIQ(123,+REQUESTIEN_",",8,"E")'="ACTIVE" D ERRLOG^SDESJSON(.ERRORS,433) Q
- ;
- I REQUESTTYPE="A" D
- .I DFN'=$$GET1^DIQ(409.85,REQUESTIEN,.01,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
- I REQUESTTYPE="R" D
- .I DFN'=$$GET1^DIQ(403.5,REQUESTIEN,.01,"I") D ERRLOG^SDESJSON(.ERRORS,447) Q
- I REQUESTTYPE="C" D
- .I DFN'=$$GET1^DIQ(123,REQUESTIEN,.02,"I") D ERRLOG^SDESJSON(.ERRORS,447)
- Q
- ;
- GETAPPTTYPE(ERRORS,APPOINTMENT,TYPE,TYPENAME) ;
- I '$G(TYPE),'$L($G(TYPENAME)) D ERRLOG^SDESJSON(.ERRORS,306) Q
- ;
- I $G(TYPE),$D(^SD(409.1,TYPE,0)) Q
- ;
- I $L($G(TYPENAME)),$D(^SD(409.1,"B",TYPENAME)) S APPOINTMENT("APPOINTMENT TYPE")=$$FIND1^DIC(409.1,"","X",TYPENAME,"B") Q
- ;
- D ERRLOG^SDESJSON(.ERRORS,180)
- Q
- ;
- APPTIN44EXISTS(DFN,CLINIC,DATE) ;
- N SUBIEN,FOUND
- ;
- S SUBIEN=0,FOUND=0
- F S SUBIEN=$O(^SC(CLINIC,"S",DATE,1,SUBIEN)) Q:'SUBIEN!($G(FOUND)=1) D
- .I $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",310)="CANCELLED" Q ;cancelled
- .I $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",.01,"I")=DFN S FOUND=1 Q ; record exists
- I $G(FOUND) Q 1
- Q 0
- ;
- APPTINDIFFTZ(DFN,DATETIME) ;
- N EXISTINGAPPTCLIN,EXISTINGDATETIME,APPTIEN,FOUND
- ;
- S FOUND=0,APPTIEN=0
- F S APPTIEN=$O(^SDEC(409.84,"CPAT",DFN,APPTIEN)) Q:'APPTIEN!($G(FOUND)=1) D
- .I $$GET1^DIQ(409.84,APPTIEN,.12,"I") Q
- .S EXISTINGAPPTCLIN=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,APPTIEN,.07,"I"),.04,"I")
- .S EXISTINGDATETIME=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),EXISTINGAPPTCLIN)
- .I $$ISOTFM^SDAMUTDT(EXISTINGDATETIME,EXISTINGAPPTCLIN)=DATETIME S FOUND=1
- Q FOUND
- ;
- DELETECANRECORD(DFN,DATETIME,CLINICIEN) ;
- N SUBIEN,FOUND,FDA,FDAERR
- ;
- S SUBIEN=0,FOUND=0
- F S SUBIEN=$O(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN)) Q:'SUBIEN!(FOUND=1) D
- .I $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",.01,"I")=DFN D
- ..I $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",310)'="CANCELLED" D
- ...S FOUND=1
- ...S FDA(2.98,DATETIME_","_DFN_",",.01)="@"
- ...D FILE^DIE(,"FDA","FDAERR") K FDA
- ;
- DELETERECORD(ARRAYDELETE) ;
- N DELETEFDA,FILENUMBER,IENS,ERR
- ;
- S FILENUMBER=0
- F S FILENUMBER=$O(ARRAYDELETE(FILENUMBER)) Q:'FILENUMBER D
- .S IENS=ARRAYDELETE(FILENUMBER)
- .S DELETEFDA(FILENUMBER,IENS,.01)="@"
- .D FILE^DIE(,"DELETEFDA","ERR") K DELETEFDA
- Q
- ;
- ORDERCHECKLOCK(ERRORS,REQTYPE,DFN) ;
- N FOUND,REQUESTIEN,ORDERID
- ;
- S FOUND=0
- S REQUESTIEN=$P($G(REQTYPE),"|",2)
- 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("ORLK-"_ORDERID)) D ERRLOG^SDESJSON(.ERRORS,188) S FOUND=1
- Q FOUND
- ;
- GETPID(APPOINTMENT,PID,REQUESTTYPE,REQUESTIEN) ;
- I $L($G(PID)) Q
- ;
- I REQUESTTYPE="A" S PID=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
- I REQUESTTYPE="R" S PID=$$GET1^DIQ(403.5,REQUESTIEN,5,"I")
- ;
- I REQUESTTYPE="C",$$GET1^DIQ(123,REQUESTIEN,17,"I")'="" S PID=$$GET1^DIQ(123,REQUESTIEN,17,"I")
- I REQUESTTYPE="C",PID="" S PID=$$GET1^DIQ(123,REQUESTIEN,.01,"I")
- ;
- S APPOINTMENT("PATIENT INDICATED DATE")=$G(PID)
- Q
- ;
- DECREMENTAVAIL1(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;
- N COUNT,CLINICAPPTLENGTH,NUMOFSLOTSINPLAY
- S CLINICAPPTLENGTH=+$E($$GET1^DIQ(44,CLINICIEN,1917,"E"),1,2)
- S NUMOFSLOTSINPLAY=APPTLENGTH/CLINICAPPTLENGTH
- F COUNT=1:1:NUMOFSLOTSINPLAY D
- .I COUNT>1 D
- ..S APPTSTARTTIME=$$FMADD^XLFDT(APPTSTARTTIME,,,CLINICAPPTLENGTH)
- .D DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
- Q
- ;
- DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;decrement availability by one when creating appointment
- N SLOTINCREMENT,SLOTSTATUSSTRING,CURRENTSCHEDULE,NEWSCHEDULE,TIMECLINICOPENS,SLOTLENGTH,NEWAVAILABILITY,SPECIALCHARACTER,AVAILABILITYFDA,CENTEROFSLOT,CHARMULTIPLIER,MAXDAYSINFUTURE
- ;
- S CURRENTSCHEDULE=$$GET1^DIQ(44.005,$P(APPTSTARTTIME,".")_","_CLINICIEN_",",1)
- S TIMECLINICOPENS=$S($L($$GET1^DIQ(44,CLINICIEN,1914,"I")):$$GET1^DIQ(44,CLINICIEN,1914,"I"),1:8)-1/100
- S SLOTLENGTH=$S($$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
- S SLOTINCREMENT=$S('$$GET1^DIQ(44,CLINICIEN,1917,"I"):4,$$GET1^DIQ(44,CLINICIEN,1917,"I")<3:4,$$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
- S CHARMULTIPLIER=$S(SLOTLENGTH<3:8/SLOTLENGTH,1:2)
- S NEWAVAILABILITY=APPTSTARTTIME#1-TIMECLINICOPENS*100
- S CENTEROFSLOT=NEWAVAILABILITY#1*SLOTINCREMENT\.6+(NEWAVAILABILITY\1*SLOTINCREMENT)*2
- S MAXDAYSINFUTURE=$$GET1^DIQ(44,CLINICIEN,2002,"I")
- S SLOTSTATUSSTRING="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- ;
- I $P(APPTSTARTTIME,".")>$$FMADD^XLFDT(DT,MAXDAYSINFUTURE) D ERRLOG^SDESJSON(.ERRORS,491) Q
- ;
- I '$D(^SC(CLINICIEN,"ST",$P(APPTSTARTTIME,"."),1)) D
- .D ASSEMBLE^SDESCLINDAILYSCH(.ERRORS,CLINICIEN,$P(APPTSTARTTIME,"."),$$GET1^DIQ(44,CLINICIEN,1917,"I"),TIMECLINICOPENS)
- ;
- I $D(^SC(CLINICIEN,"ST",$P(APPTSTARTTIME,"."),"CAN"))!(CURRENTSCHEDULE["CAN") D ERRLOG^SDESJSON(.ERRORS,492)
- ;
- F SPECIALCHARACTER=CENTEROFSLOT:CHARMULTIPLIER Q:$L($G(NEWSCHEDULE))!($G(NEWAVAILABILITY)="") D
- .S NEWAVAILABILITY=$E(SLOTSTATUSSTRING,$F(SLOTSTATUSSTRING,$E(CURRENTSCHEDULE,SPECIALCHARACTER+1))-2)
- .S NEWSCHEDULE=$E(CURRENTSCHEDULE,1,SPECIALCHARACTER)_NEWAVAILABILITY_$E(CURRENTSCHEDULE,SPECIALCHARACTER+2,999)
- ;
- S AVAILABILITYFDA(44.005,$P(APPTSTARTTIME,".")_","_CLINICIEN_",",1)=NEWSCHEDULE
- D FILE^DIE(,"AVAILABILITYFDA") K AVAILABILITYFDA
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2APPTUTIL 12527 printed Feb 19, 2025@00:19:41 Page 2
- SDES2APPTUTIL ;ALB/BLB,TJB/ANU/BLB/LAB,BLB,LAB,BWF - SDES2 CREATE APPOINTMENT UTILITIES ;OCT 23,2024
- +1 ;;5.3;Scheduling;**866,871,875,877,878,880,881,890,893**;Aug 13, 1993;Build 6
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;---------------------------------------------------------------
- +4 QUIT
- +5 ;
- APPTREQ(SDCONTEXT,APPOINTMENT,APPTIEN,APPTMSG) ; called only on create of appointment
- +1 NEW STARTDATETIME,CLINICIEN,REQUESTIEN,REQUESTTYPE,SDUSER
- +2 SET REQUESTIEN=$PIECE($GET(APPOINTMENT("REQUEST TYPE")),"|",2)
- +3 SET REQUESTTYPE=$PIECE($GET(APPOINTMENT("REQUEST TYPE")),"|")
- +4 ;
- +5 SET STARTDATETIME=$GET(APPOINTMENT("START DATE TIME"))
- SET CLINICIEN=$GET(APPOINTMENT("CLINIC IEN"))
- +6 DO ADDPIDHISTORY^SDESCREATEAPPREQ($PIECE($GET(APPOINTMENT("REQUEST TYPE")),"|",2),$GET(APPOINTMENT("PATIENT INDICATED DATE")))
- +7 ;
- +8 SET SDUSER=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
- +9 DO BUILDAPPTDATA^SDESEDITAPPTREQ(REQUESTIEN,STARTDATETIME,CLINICIEN,$GET(APPOINTMENT("SERVICE CONNECTED PERCENTAGE")),$GET(APPOINTMENT("SERVICE CONNECTED")),$GET(APPOINTMENT("APPOINTMENT TYPE")),$GET(SDCONTEXT("ACHERON AUDIT ID")),SDUSER,.APPTM
- SG)
- +10 IF $GET(APPOINTMENT("MRTC PARENT"))
- IF $GET(APPOINTMENT("MRTC"))
- Begin DoDot:1
- +11 DO MRTCCHILD($GET(APPOINTMENT("PATIENT INDICATED DATE")),REQUESTIEN,APPTIEN,$GET(APPOINTMENT("MRTC PARENT")))
- End DoDot:1
- +12 QUIT
- +13 ;
- RECALL(RECALLRETURN,SDCONTEXT,RECALL,REQUESTIEN) ;
- +1 SET RECALL("RECALL IEN")=REQUESTIEN
- +2 SET RECALL("DELETE REASON")=7
- +3 DO DISPRECALL^SDES2DISPRECALL(.RECALLRETURN,.SDCONTEXT,.RECALL)
- +4 QUIT
- +5 ;
- CONSULT(APPOINTMENT,APPTIEN44,USERID) ;
- +1 NEW FDA,REQUESTIEN,PROVIDERIEN,NOTE,STARTDATETIME,RESOURCEIEN,DFN,CLINICIEN,NETSTARTDT,GMRCDUZ
- +2 ;
- +3 SET REQUESTIEN=$PIECE($GET(APPOINTMENT("REQUEST TYPE")),"|",2)
- +4 SET PROVIDERIEN=$GET(APPOINTMENT("PROVIDER IEN"))
- +5 SET NOTE=$GET(APPOINTMENT("NOTE"))
- +6 SET STARTDATETIME=$GET(APPOINTMENT("START DATE TIME"))
- +7 SET NETSTARTDT=$$FMTONET^SDECDATE(STARTDATETIME)
- +8 SET RESOURCEIEN=$GET(APPOINTMENT("RESOURCE IEN"))
- +9 SET DFN=$GET(APPOINTMENT("DFN"))
- +10 SET CLINICIEN=$GET(APPOINTMENT("CLINIC IEN"))
- +11 DO REQSET(REQUESTIEN,USERID,"SCHEDULED","",$TRANSLATE($EXTRACT(NOTE,1,150),"^"," "),STARTDATETIME,CLINICIEN,DFN)
- +12 ;
- +13 SET FDA(44.003,APPTIEN44_","_STARTDATETIME_","_CLINICIEN_",",688)=REQUESTIEN
- +14 DO UPDATE^DIE("","FDA")
- KILL FDA
- +15 ;
- +16 DO UPDATECONSULTPID(REQUESTIEN,$GET(APPOINTMENT("PATIENT INDICATED DATE")),DFN,.USERID)
- +17 QUIT
- +18 ;
- REQSET(REQUESTIEN,USERID,ACTION,CANCELLEDBY,NOTE,STARTDATETIME,CLINICIEN,DFN) ;
- +1 NEW %DT,X,SD,TMPYCLNC
- +2 ;
- +3 IF $$GET1^DIQ(123,REQUESTIEN_",",8,"E")="DISCONTINUED"!($$GET1^DIQ(123,REQUESTIEN_",",8,"E")="COMPLETE")
- QUIT
- +4 ;
- +5 IF ACTION="SCHEDULED"
- Begin DoDot:1
- +6 DO EDITCS^SDCNSLT(STARTDATETIME,NOTE,CLINICIEN_U_$$GET1^DIQ(44,CLINICIEN,.01,"E"),REQUESTIEN)
- End DoDot:1
- +7 ;
- +8 IF ACTION="CANCELLED"
- Begin DoDot:1
- +9 DO SDECCAN^SDCNSLT(REQUESTIEN,$$GET1^DIQ(123,REQUESTIEN,.02,"I"),STARTDATETIME,CLINICIEN,CANCELLEDBY,$$GET44APPTIEN^SDES2NOSHOW(CLINICIEN,STARTDATETIME,DFN),NOTE)
- End DoDot:1
- +10 QUIT
- +11 ;
- UPDATECONSULTPID(CONSULTIEN,PID,DFN,USERIEN) ;
- +1 NEW CONSULTPIDIEN,CONSULTFDA,CONSULTSUBFDA,TOPLEVELIEN
- +2 ;
- +3 IF '$DATA(^SDEC(409.87,"B",CONSULTIEN))
- Begin DoDot:1
- +4 SET CONSULTFDA(409.87,"+1,",.01)=CONSULTIEN
- +5 SET CONSULTFDA(409.87,"+1,",.02)=DFN
- +6 DO UPDATE^DIE("","CONSULTFDA","TOPLEVELIEN")
- KILL CONSULTFDA
- +7 ;
- +8 SET CONSULTSUBFDA(409.871,"+1,"_TOPLEVELIEN(1)_",",.01)=$$NOW^XLFDT
- +9 SET CONSULTSUBFDA(409.871,"+1,"_TOPLEVELIEN(1)_",",1)=PID
- +10 SET CONSULTSUBFDA(409.871,"+1,"_TOPLEVELIEN(1)_",",2)=$SELECT($GET(USERIEN):USERIEN,1:DUZ)
- +11 DO UPDATE^DIE("","CONSULTSUBFDA")
- KILL CONSULTSUBFDA
- End DoDot:1
- +12 ;
- +13 ; file consult pid history subfile only
- +14 SET CONSULTPIDIEN=$ORDER(^SDEC(409.87,"B",CONSULTIEN,0))
- +15 IF $DATA(^SDEC(409.87,"B",CONSULTIEN))
- Begin DoDot:1
- +16 IF $$CONSPIDCHECK^SDEC07(CONSULTIEN,PID)
- Begin DoDot:2
- +17 SET CONSULTSUBFDA(409.871,"+1,"_CONSULTPIDIEN_",",.01)=$$NOW^XLFDT
- +18 SET CONSULTSUBFDA(409.871,"+1,"_CONSULTPIDIEN_",",1)=PID
- +19 SET CONSULTSUBFDA(409.871,"+1,"_CONSULTPIDIEN_",",2)=$SELECT($GET(USERIEN):USERIEN,1:DUZ)
- +20 DO UPDATE^DIE("","CONSULTSUBFDA")
- KILL CONSULTSUBFDA
- End DoDot:2
- End DoDot:1
- +21 QUIT
- +22 ;
- CONSPIDCHECK(SDRIEN1,SDDDT) ;
- +1 NEW CHIEN,CHSIEN,OLDPID
- +2 SET CHIEN=$ORDER(^SDEC(409.87,"B",SDRIEN1,0))
- +3 SET CHSIEN=$ORDER(^SDEC(409.87,CHIEN,1,9999999),-1)
- +4 SET OLDPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
- +5 IF OLDPID'=$GET(SDDDT)
- QUIT 1
- +6 QUIT 0
- +7 ;
- ENCOUNTERS(APPOINTMENT,ENCOUNTER) ;
- +1 IF $$NOW^XLFDT>$G(APPOINTMENT("START DATE TIME"))
- IF $$NEW^SDPCE($GET(APPOINTMENT("START DATE TIME")))
- Begin DoDot:1
- +2 SET ENCOUNTER=$$GETAPT^SDVSIT2($GET(APPOINTMENT("DFN")),$GET(APPOINTMENT("START DATE TIME")),$GET(APPOINTMENT("CLINIC IEN")))
- End DoDot:1
- +3 QUIT
- +4 ;
- MAKE(DFN,STARTDATETIME,CLINICIEN) ;
- +1 DO MAKE^SDAMEVT(DFN,STARTDATETIME,CLINICIEN,$$SCIEN^SDECU2(DFN,CLINICIEN,STARTDATETIME),2)
- +2 QUIT
- +3 ;
- GETRESOURCE(ERRORS,APPOINTMENT,CLINICIEN) ;
- +1 NEW RESOURCE,MATCH
- +2 ;
- +3 IF '$GET(APPOINTMENT("RESOURCE IEN"))
- Begin DoDot:1
- +4 SET RESOURCE=0
- SET MATCH=0
- +5 FOR
- SET RESOURCE=$ORDER(^SDEC(409.831,"ALOC",CLINICIEN,RESOURCE))
- if RESOURCE'>0!(MATCH>0)
- QUIT
- Begin DoDot:2
- +6 IF $$GET1^DIQ(409.831,RESOURCE_",",.012,"E")'="CLINIC"
- QUIT
- +7 SET APPOINTMENT("RESOURCE IEN")=RESOURCE
- SET MATCH=1
- End DoDot:2
- End DoDot:1
- +8 ;
- +9 IF $$GET1^DIQ(409.831,$GET(APPOINTMENT("RESOURCE IEN")),.04,"I")'=$GET(CLINICIEN)
- DO ERRLOG^SDESJSON(.ERRORS,366)
- QUIT
- +10 QUIT
- +11 ;
- GETPROVIDER(APPOINTMENT,CLINICIEN,PROVIDER,REQUESTTYPE,REQUESTIEN) ;
- +1 NEW DEFAULTPROVIEN,PROVIDERIEN
- +2 ;
- +3 IF $LENGTH($GET(PROVIDER))
- QUIT
- +4 ;
- +5 IF REQUESTTYPE="R"
- Begin DoDot:1
- +6 SET APPOINTMENT("PROVIDER IEN")=$$GET1^DIQ(403.54,$$GET1^DIQ(403.5,REQUESTIEN,4,"I"),.01,"I")
- End DoDot:1
- QUIT
- +7 ;
- +8 SET PROVIDERIEN=0
- SET DEFAULTPROVIEN=""
- +9 FOR
- SET PROVIDERIEN=$ORDER(^SC(CLINICIEN,"PR",PROVIDERIEN))
- if 'PROVIDERIEN!($GET(DEFAULTPROVIEN))
- QUIT
- Begin DoDot:1
- +10 IF $$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.02,"I")
- SET DEFAULTPROVIEN=$$GET1^DIQ(44.1,PROVIDERIEN_","_CLINICIEN_",",.01,"I")
- End DoDot:1
- +11 SET APPOINTMENT("PROVIDER IEN")=DEFAULTPROVIEN
- +12 ;
- +13 QUIT
- +14 ;
- MRTCCHILD(PID,REQUESTIEN,APPTIEN,PARENT) ;
- +1 NEW REQUEST
- +2 SET REQUEST("MRTC","PATIENT INDICATED DATE")=$GET(APPOINTMENT("PATIENT INDICATED DATE"))
- +3 SET REQUEST("MRTC","CHILD REQUEST")=REQUESTIEN
- +4 SET REQUEST("MRTC","MRTC APPOINTMENT")=$GET(APPTIEN)
- +5 DO BUILDMRTCLINKS^SDESEDITAPPTREQ(.REQUEST,$GET(APPOINTMENT("MRTC PARENT")))
- +6 DO BUILDMRTCPID^SDESEDITAPPTREQ(.REQUEST,$GET(APPOINTMENT("MRTC PARENT")))
- +7 QUIT
- +8 ;
- STOREREQUESTCOMM(REQUESTIEN) ;
- +1 NEW SUBIEN,PATIENTCOMMENTS
- +2 ;
- +3 IF $DATA(^SDEC(409.85,REQUESTIEN,"PATCOM",0))
- Begin DoDot:1
- +4 SET SUBIEN=0
- +5 FOR
- SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN))
- if 'SUBIEN
- QUIT
- Begin DoDot:2
- +6 SET PATIENTCOMMENTS(SUBIEN)=$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")
- End DoDot:2
- End DoDot:1
- +7 DO WP^DIE(409.84,APPTIEN_",",4,"","PATIENTCOMMENTS")
- +8 QUIT
- +9 ;
- STORENOTE(APPTIEN,NOTE,APPTNOTES) ;
- +1 IF $LENGTH(NOTE)
- Begin DoDot:1
- +2 DO WP^SDECUTL(.APPTNOTES,NOTE)
- +3 DO WP^DIE(409.84,APPTIEN_",",1,"","APPTNOTES")
- End DoDot:1
- +4 QUIT
- +5 ;
- REQUESTTYPE(ERRORS,APPOINTMENTS,REQUESTTYPE,REQUESTIEN,DFN) ;
- +1 IF '$LENGTH($GET(APPOINTMENT("REQUEST TYPE")))
- DO ERRLOG^SDESJSON(.ERRORS,60)
- QUIT
- +2 ;
- +3 IF REQUESTTYPE'="A"
- IF REQUESTTYPE'="R"
- IF REQUESTTYPE'="C"
- DO ERRLOG^SDESJSON(.ERRORS,61)
- QUIT
- +4 ;
- +5 IF '$GET(REQUESTIEN)
- DO ERRLOG^SDESJSON(.ERRORS,61)
- QUIT
- +6 ;
- +7 IF REQUESTTYPE="R"
- IF '$DATA(^SD(403.5,REQUESTIEN,0))
- DO ERRLOG^SDESJSON(.ERRORS,61)
- QUIT
- +8 IF REQUESTTYPE="C"
- IF '$DATA(^GMR(123,REQUESTIEN,0))
- DO ERRLOG^SDESJSON(.ERRORS,61)
- QUIT
- +9 IF REQUESTTYPE="A"
- IF '$DATA(^SDEC(409.85,REQUESTIEN,0))
- DO ERRLOG^SDESJSON(.ERRORS,61)
- QUIT
- +10 ;
- +11 IF REQUESTTYPE="A"
- IF $$GET1^DIQ(409.85,$GET(REQUESTIEN),23,"I")="C"
- DO ERRLOG^SDESJSON(.ERRORS,433)
- QUIT
- +12 ;
- +13 IF REQUESTTYPE="C"
- Begin DoDot:1
- +14 IF $$GET1^DIQ(123,REQUESTIEN_",",8,"E")'="PENDING"
- IF $$GET1^DIQ(123,+REQUESTIEN_",",8,"E")'="ACTIVE"
- DO ERRLOG^SDESJSON(.ERRORS,433)
- QUIT
- End DoDot:1
- +15 ;
- +16 IF REQUESTTYPE="A"
- Begin DoDot:1
- +17 IF DFN'=$$GET1^DIQ(409.85,REQUESTIEN,.01,"I")
- DO ERRLOG^SDESJSON(.ERRORS,447)
- QUIT
- End DoDot:1
- +18 IF REQUESTTYPE="R"
- Begin DoDot:1
- +19 IF DFN'=$$GET1^DIQ(403.5,REQUESTIEN,.01,"I")
- DO ERRLOG^SDESJSON(.ERRORS,447)
- QUIT
- End DoDot:1
- +20 IF REQUESTTYPE="C"
- Begin DoDot:1
- +21 IF DFN'=$$GET1^DIQ(123,REQUESTIEN,.02,"I")
- DO ERRLOG^SDESJSON(.ERRORS,447)
- End DoDot:1
- +22 QUIT
- +23 ;
- GETAPPTTYPE(ERRORS,APPOINTMENT,TYPE,TYPENAME) ;
- +1 IF '$GET(TYPE)
- IF '$LENGTH($GET(TYPENAME))
- DO ERRLOG^SDESJSON(.ERRORS,306)
- QUIT
- +2 ;
- +3 IF $GET(TYPE)
- IF $DATA(^SD(409.1,TYPE,0))
- QUIT
- +4 ;
- +5 IF $LENGTH($GET(TYPENAME))
- IF $DATA(^SD(409.1,"B",TYPENAME))
- SET APPOINTMENT("APPOINTMENT TYPE")=$$FIND1^DIC(409.1,"","X",TYPENAME,"B")
- QUIT
- +6 ;
- +7 DO ERRLOG^SDESJSON(.ERRORS,180)
- +8 QUIT
- +9 ;
- APPTIN44EXISTS(DFN,CLINIC,DATE) ;
- +1 NEW SUBIEN,FOUND
- +2 ;
- +3 SET SUBIEN=0
- SET FOUND=0
- +4 FOR
- SET SUBIEN=$ORDER(^SC(CLINIC,"S",DATE,1,SUBIEN))
- if 'SUBIEN!($GET(FOUND)=1)
- QUIT
- Begin DoDot:1
- +5 ;cancelled
- IF $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",310)="CANCELLED"
- QUIT
- +6 ; record exists
- IF $$GET1^DIQ(44.003,SUBIEN_","_DATE_","_CLINIC_",",.01,"I")=DFN
- SET FOUND=1
- QUIT
- End DoDot:1
- +7 IF $GET(FOUND)
- QUIT 1
- +8 QUIT 0
- +9 ;
- APPTINDIFFTZ(DFN,DATETIME) ;
- +1 NEW EXISTINGAPPTCLIN,EXISTINGDATETIME,APPTIEN,FOUND
- +2 ;
- +3 SET FOUND=0
- SET APPTIEN=0
- +4 FOR
- SET APPTIEN=$ORDER(^SDEC(409.84,"CPAT",DFN,APPTIEN))
- if 'APPTIEN!($GET(FOUND)=1)
- QUIT
- Begin DoDot:1
- +5 IF $$GET1^DIQ(409.84,APPTIEN,.12,"I")
- QUIT
- +6 SET EXISTINGAPPTCLIN=$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,APPTIEN,.07,"I"),.04,"I")
- +7 SET EXISTINGDATETIME=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.84,APPTIEN,.01,"I"),EXISTINGAPPTCLIN)
- +8 IF $$ISOTFM^SDAMUTDT(EXISTINGDATETIME,EXISTINGAPPTCLIN)=DATETIME
- SET FOUND=1
- End DoDot:1
- +9 QUIT FOUND
- +10 ;
- DELETECANRECORD(DFN,DATETIME,CLINICIEN) ;
- +1 NEW SUBIEN,FOUND,FDA,FDAERR
- +2 ;
- +3 SET SUBIEN=0
- SET FOUND=0
- +4 FOR
- SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN))
- if 'SUBIEN!(FOUND=1)
- QUIT
- Begin DoDot:1
- +5 IF $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",.01,"I")=DFN
- Begin DoDot:2
- +6 IF $$GET1^DIQ(44.003,SUBIEN_","_DATETIME_","_CLINICIEN_",",310)'="CANCELLED"
- Begin DoDot:3
- +7 SET FOUND=1
- +8 SET FDA(2.98,DATETIME_","_DFN_",",.01)="@"
- +9 DO FILE^DIE(,"FDA","FDAERR")
- KILL FDA
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 ;
- DELETERECORD(ARRAYDELETE) ;
- +1 NEW DELETEFDA,FILENUMBER,IENS,ERR
- +2 ;
- +3 SET FILENUMBER=0
- +4 FOR
- SET FILENUMBER=$ORDER(ARRAYDELETE(FILENUMBER))
- if 'FILENUMBER
- QUIT
- Begin DoDot:1
- +5 SET IENS=ARRAYDELETE(FILENUMBER)
- +6 SET DELETEFDA(FILENUMBER,IENS,.01)="@"
- +7 DO FILE^DIE(,"DELETEFDA","ERR")
- KILL DELETEFDA
- End DoDot:1
- +8 QUIT
- +9 ;
- ORDERCHECKLOCK(ERRORS,REQTYPE,DFN) ;
- +1 NEW FOUND,REQUESTIEN,ORDERID
- +2 ;
- +3 SET FOUND=0
- +4 SET REQUESTIEN=$PIECE($GET(REQTYPE),"|",2)
- +5 SET REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
- +6 IF REQTYPE="RTC"
- Begin DoDot:1
- +7 SET ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
- +8 IF '+$GET(ORDERID)
- QUIT
- +9 IF $DATA(^XTMP("ORLK-"_ORDERID))
- DO ERRLOG^SDESJSON(.ERRORS,188)
- SET FOUND=1
- End DoDot:1
- +10 QUIT FOUND
- +11 ;
- GETPID(APPOINTMENT,PID,REQUESTTYPE,REQUESTIEN) ;
- +1 IF $LENGTH($GET(PID))
- QUIT
- +2 ;
- +3 IF REQUESTTYPE="A"
- SET PID=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
- +4 IF REQUESTTYPE="R"
- SET PID=$$GET1^DIQ(403.5,REQUESTIEN,5,"I")
- +5 ;
- +6 IF REQUESTTYPE="C"
- IF $$GET1^DIQ(123,REQUESTIEN,17,"I")'=""
- SET PID=$$GET1^DIQ(123,REQUESTIEN,17,"I")
- +7 IF REQUESTTYPE="C"
- IF PID=""
- SET PID=$$GET1^DIQ(123,REQUESTIEN,.01,"I")
- +8 ;
- +9 SET APPOINTMENT("PATIENT INDICATED DATE")=$GET(PID)
- +10 QUIT
- +11 ;
- DECREMENTAVAIL1(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;
- +1 NEW COUNT,CLINICAPPTLENGTH,NUMOFSLOTSINPLAY
- +2 SET CLINICAPPTLENGTH=+$EXTRACT($$GET1^DIQ(44,CLINICIEN,1917,"E"),1,2)
- +3 SET NUMOFSLOTSINPLAY=APPTLENGTH/CLINICAPPTLENGTH
- +4 FOR COUNT=1:1:NUMOFSLOTSINPLAY
- Begin DoDot:1
- +5 IF COUNT>1
- Begin DoDot:2
- +6 SET APPTSTARTTIME=$$FMADD^XLFDT(APPTSTARTTIME,,,CLINICAPPTLENGTH)
- End DoDot:2
- +7 DO DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
- End DoDot:1
- +8 QUIT
- +9 ;
- DECREMENTAVAIL2(CLINICIEN,APPTSTARTTIME,APPTLENGTH) ;decrement availability by one when creating appointment
- +1 NEW SLOTINCREMENT,SLOTSTATUSSTRING,CURRENTSCHEDULE,NEWSCHEDULE,TIMECLINICOPENS,SLOTLENGTH,NEWAVAILABILITY,SPECIALCHARACTER,AVAILABILITYFDA,CENTEROFSLOT,CHARMULTIPLIER,MAXDAYSINFUTURE
- +2 ;
- +3 SET CURRENTSCHEDULE=$$GET1^DIQ(44.005,$PIECE(APPTSTARTTIME,".")_","_CLINICIEN_",",1)
- +4 SET TIMECLINICOPENS=$SELECT($LENGTH($$GET1^DIQ(44,CLINICIEN,1914,"I")):$$GET1^DIQ(44,CLINICIEN,1914,"I"),1:8)-1/100
- +5 SET SLOTLENGTH=$SELECT($$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
- +6 SET SLOTINCREMENT=$SELECT('$$GET1^DIQ(44,CLINICIEN,1917,"I"):4,$$GET1^DIQ(44,CLINICIEN,1917,"I")<3:4,$$GET1^DIQ(44,CLINICIEN,1917,"I"):$$GET1^DIQ(44,CLINICIEN,1917,"I"),1:4)
- +7 SET CHARMULTIPLIER=$SELECT(SLOTLENGTH<3:8/SLOTLENGTH,1:2)
- +8 SET NEWAVAILABILITY=APPTSTARTTIME#1-TIMECLINICOPENS*100
- +9 SET CENTEROFSLOT=NEWAVAILABILITY#1*SLOTINCREMENT\.6+(NEWAVAILABILITY\1*SLOTINCREMENT)*2
- +10 SET MAXDAYSINFUTURE=$$GET1^DIQ(44,CLINICIEN,2002,"I")
- +11 SET SLOTSTATUSSTRING="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- +12 ;
- +13 IF $PIECE(APPTSTARTTIME,".")>$$FMADD^XLFDT(DT,MAXDAYSINFUTURE)
- DO ERRLOG^SDESJSON(.ERRORS,491)
- QUIT
- +14 ;
- +15 IF '$DATA(^SC(CLINICIEN,"ST",$PIECE(APPTSTARTTIME,"."),1))
- Begin DoDot:1
- +16 DO ASSEMBLE^SDESCLINDAILYSCH(.ERRORS,CLINICIEN,$PIECE(APPTSTARTTIME,"."),$$GET1^DIQ(44,CLINICIEN,1917,"I"),TIMECLINICOPENS)
- End DoDot:1
- +17 ;
- +18 IF $DATA(^SC(CLINICIEN,"ST",$PIECE(APPTSTARTTIME,"."),"CAN"))!(CURRENTSCHEDULE["CAN")
- DO ERRLOG^SDESJSON(.ERRORS,492)
- +19 ;
- +20 FOR SPECIALCHARACTER=CENTEROFSLOT:CHARMULTIPLIER
- if $LENGTH($GET(NEWSCHEDULE))!($GET(NEWAVAILABILITY)="")
- QUIT
- Begin DoDot:1
- +21 SET NEWAVAILABILITY=$EXTRACT(SLOTSTATUSSTRING,$FIND(SLOTSTATUSSTRING,$EXTRACT(CURRENTSCHEDULE,SPECIALCHARACTER+1))-2)
- +22 SET NEWSCHEDULE=$EXTRACT(CURRENTSCHEDULE,1,SPECIALCHARACTER)_NEWAVAILABILITY_$EXTRACT(CURRENTSCHEDULE,SPECIALCHARACTER+2,999)
- End DoDot:1
- +23 ;
- +24 SET AVAILABILITYFDA(44.005,$PIECE(APPTSTARTTIME,".")_","_CLINICIEN_",",1)=NEWSCHEDULE
- +25 DO FILE^DIE(,"AVAILABILITYFDA")
- KILL AVAILABILITYFDA
- +26 QUIT
- +27 ;