SDESCCAVAIL ;ALB/KML,MGD,BWF,JDJ - VISTA SCHEDULING RPCS CANCEL CLINIC AVAILABILITY ; January 26,2024
;;5.3;Scheduling;**800,805,809,813,819,820,824,825,871**;Aug 13, 1993;Build 13
;;Per VHA Directive 6402, this routine should not be modified
;
;
Q ;No Direct Call
;
CANCLAVAIL(SDCLNJSON,SDCLNIEN,SDFULLPART,SDESBEGDTTM,SDESENDDTTM,SDCANREM,SDEAS) ;Called from RPC: SDES CANCEL CLINIC AVAILABILITY
; This RPC cancels Clinic availability within a given timeframe for a given clinic.
; Input:
; SDCLNJSON [required] - Success or Error message
; SDCLNIEN [required] - The Internal Entry Number (IEN) from the HOSPITAL LOCATION File #44
; SDFULLPART [required] - Full or partial day cancellation ('F' for full, 'P' for partial)
; SDESBEGDTTM [required] - Start date/time in ISO8601 format (CCYY-MM-DDTHH:MM:SS-HH:MM)
; SDESENDDTTM [required] - End Date/time in ISO8601 format (CCYY-MM-DDTHH:MM:SS-HH:MM)
; SDCANREM [optional] - Cancellation Remarks (must be 3-160 characters if passed)
; SDEAS [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
;
N FMSDTTM,FMEDTTM,ERRORS,SINC,STARTOFDAY,SDCLNSREC,CANAPPTS
S SDCLNIEN=$G(SDCLNIEN),SDFULLPART=$G(SDFULLPART),SDESBEGDTTM=$G(SDESBEGDTTM),SDESENDDTTM=$G(SDESENDDTTM),SDCANREM=$G(SDCANREM),SDEAS=$G(SDEAS)
; validate the dates first, since we need them to fully validate the clinic
D VALIDATEFULLPART(.ERRORS,SDFULLPART)
I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
S FMSDTTM=$$VALIDATEBEGDATE(.ERRORS,SDESBEGDTTM,SDCLNIEN)
I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
S FMEDTTM=$$VALIDATEENDDATE(.ERRORS,SDESBEGDTTM,SDESENDDTTM,SDCLNIEN)
I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
D VALIDATECANREM(.ERRORS,SDCANREM)
I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
S SINC=""
D VALIDATECLINIC(.ERRORS,SDCLNIEN,FMSDTTM,FMEDTTM,.SINC,.STARTOFDAY)
D VALIDATEEAS(.ERRORS,SDEAS)
I $D(ERRORS) D Q
.S ERRORS("CancelClinicAvailability",1)=""
.D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS)
D CANCLNAVA(SDCLNIEN,SDFULLPART,FMSDTTM,FMEDTTM,SINC,STARTOFDAY,$G(SDCANREM),.DH,.CANAPPTS)
S SDCLNSREC("CancelClinicAvailability",1)="Clinic availability has been successfully cancelled."
I '$D(CANAPPTS) S SDCLNSREC("CancelClinicAvailability",1)=SDCLNSREC("CancelClinicAvailability",1)_" No appointments scheduled."
M SDCLNSREC=CANAPPTS
D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.SDCLNSREC)
Q
;
VALIDATEFULLPART(ERRORS,FP) ;
; missing full or partial flag
I $G(FP)="" D ERRLOG^SDESJSON(.ERRORS,245) Q ; Missing full/partial day cancellation flag
; incorrect type
I $G(FP)'="F"&($G(FP)'="P") D ERRLOG^SDESJSON(.ERRORS,246) ;Invalid full/partial day cancellation flag
Q
;
VALIDATEBEGDATE(ERRORS,BDATE,CLINIC) ;
N FMSDATE
I BDATE="" D ERRLOG^SDESJSON(.ERRORS,9) Q ""
S FMSDATE=$$ISOTFM^SDAMUTDT(BDATE,CLINIC)
I FMSDATE<1 D ERRLOG^SDESJSON(.ERRORS,11) Q ""
Q FMSDATE
;
VALIDATEENDDATE(ERRORS,BDATE,EDATE,CLINIC) ;
N FMSDATE,FMEDATE
I EDATE="" D ERRLOG^SDESJSON(.ERRORS,10) Q ""
S FMSDATE=$$ISOTFM^SDAMUTDT(BDATE,CLINIC)
S FMEDATE=$$ISOTFM^SDAMUTDT(EDATE,CLINIC)
I FMEDATE<1 D ERRLOG^SDESJSON(.ERRORS,12) Q ""
; Start date and end date must be the same
I $P(FMEDATE,".")'=$P(FMSDATE,".") D ERRLOG^SDESJSON(.ERRORS,241) Q ""
I FMEDATE<FMSDATE D ERRLOG^SDESJSON(.ERRORS,242) Q "" ;"End time must be after Start Time."
I FMEDATE=FMSDATE D ERRLOG^SDESJSON(.ERRORS,242) Q "" ;"End time must be after Start Time."
Q FMEDATE
;
VALIDATECANREM(ERRORS,REMARKS) ;
I $L(REMARKS),$L(REMARKS)<3!($L(REMARKS)>160) D ERRLOG^SDESJSON(.ERRORS,255)
Q
VALIDATEEAS(ERRORS,SDEAS) ;
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL($G(SDEAS))
I $P($G(SDEAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142)
Q
VALIDATECLINIC(ERRORS,SDCLNIEN,FMSDTTM,FMEDTTM,SINC,STARTOFDAY) ;
N FRTIME,TOTIME,DISPINCPERHR,HRCLNDISPBEG,HRCLNDISP,INACTIVATEDT,INACTIVATEDTEXT,REACTIVATEDT,REACTIVATEDTEXT,CANCELDATE,FDA,FDAIEN
N X,MASTERPATTERN,MPATTERNSLOTS,DAYSCHED,DOW,REACTIVATEMSG,Y,FILENO
I SDCLNIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I '$D(^SC(SDCLNIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
S CANCELDATE=$P(FMSDTTM,".")
S FRTIME=$P(FMSDTTM,".",2),TOTIME=$P(FMEDTTM,".",2)
; DISPINCPERHR - display increments per hour
S DISPINCPERHR=$$GET1^DIQ(44,SDCLNIEN,1917,"I")
; SINC - DISPLAY INCREMENTS PER HOUR
S SINC=$S(DISPINCPERHR="":4,DISPINCPERHR<3:4,DISPINCPERHR:DISPINCPERHR,1:4)
; HRCLNDISPBEG - hour clinic display begins
S HRCLNDISPBEG=$$GET1^DIQ(44,SDCLNIEN,1914,"I")
I HRCLNDISPBEG="" S HRCLNDISPBEG=8
S STARTOFDAY=$S($L(HRCLNDISPBEG):HRCLNDISPBEG,1:8)
; Clinic inactive
S INACTIVATEDT=$$GET1^DIQ(44,SDCLNIEN,2505,"I")
S INACTIVATEDTEXT=$TR($$FMTE^XLFDT(INACTIVATEDT,"5DF")," ","0")
S REACTIVATEDT=$$GET1^DIQ(44,SDCLNIEN,2506,"I")
S REACTIVATEDTEXT=$TR($$FMTE^XLFDT(REACTIVATEDT,"5DF")," ","0")
I REACTIVATEDT D
.S REACTIVATEMSG=$S(REACTIVATEDT:" to "_REACTIVATEDTEXT,1:"")
I INACTIVATEDT D
.; if inactivate date is after than the cancel request date, quit
.I INACTIVATEDT>$P(CANCELDATE,".") Q
.; if there is a reactivation date and the reactivation date before the cancel date, quit
.I REACTIVATEDT,REACTIVATEDT<$P(CANCELDATE,".") Q
.D ERRLOG^SDESJSON(.ERRORS,52,"Clinic is inactive "_$S('REACTIVATEDT:"as of ",1:"from ")_INACTIVATEDTEXT_$G(REACTIVATEMSG))
Q:$D(ERRORS)
;
; if the pattern does not exist for this date, create it from the template
; otherwise the user will be incorrectly told that the clinic does not meet on this day
I '$D(^SC(SDCLNIEN,"ST",CANCELDATE,1)) D
.S X=CANCELDATE
.D DOW^SDM0 S DOW=Y
.S MASTERPATTERN=+$O(^SC(SDCLNIEN,"T"_DOW,CANCELDATE))
.S FILENO=$SELECT(DOW=0:44.06,DOW=1:44.07,DOW=2:44.08,DOW=3:44.09,DOW=4:44.008,DOW=5:44.009,DOW=6:44.0001,1:"")
.S MPATTERNSLOTS=$$GET1^DIQ(FILENO,MASTERPATTERN_","_SDCLNIEN_",",1)
;.S FDA(44.005,"+1,"_SDCLNIEN_",",.01)=CANCELDATE
;.S FDA(44.005,"+1,"_SDCLNIEN_",",1)=$P("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$E(CANCELDATE,6,7)_$J("",SINC+SINC-6)_MPATTERNSLOTS
;.S FDAIEN(1)=CANCELDATE
;.D UPDATE^DIE(,"FDA","FDAIEN","FERR") K FDA,FDAIEN
S DAYSCHED=$$GET1^DIQ(44.005,CANCELDATE_","_SDCLNIEN_",",1,"I")
I DAYSCHED["CANCELLED" D ERRLOG^SDESJSON(.ERRORS,248) Q
; Clinic does not meet on that day
I DAYSCHED'["[" D ERRLOG^SDESJSON(.ERRORS,249) Q
; future consideration - should we inform the user whether or not appointments were scheduled?
;I $O(^SC(SDCLNIEN,"S",CANCELDATE))\1-CANCELDATE D ERRLOG^SDESJSON(.ERRORS,52,"NO APPOINTMENTS SCHEDULED") Q
;I $O(^SC(SC,"S",SD))\1-SD W *7,!?5,"NO APPOINTMENTS SCHEDULED" S NOAP=1 G W
;
; Loss of workload credit
I SDFULLPART="P",$$COED^SDESCCAVAIL2(SDCLNIEN,FMSDTTM,FMEDTTM,1) D ERRLOG^SDESJSON(.ERRORS,247) Q
I SDFULLPART="F",$$COED^SDESCCAVAIL2(SDCLNIEN,$P(FMSDTTM,"."),$P(FMSDTTM,".")_.2359,1) D ERRLOG^SDESJSON(.ERRORS,247) Q
;
N CANARY,OVERLAP,PCANDTTM,PCANCNT,PCANLOOP,FDAYSTRT
D CHKPARTIALCAN(.CANARY,SDCLNIEN,CANCELDATE)
I SDFULLPART="F" D Q
.S PCANCNT=0
.S CANSTARTTIME=$$TC^SDESCCAVAIL2($P(FMSDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SINC)
.S ST=$P(CANSTARTTIME,U,3)
.S FR=$P(CANSTARTTIME,U,2)
.I FR<0 D ERRLOG^SDESJSON(.ERRORS,52,$P(CANSTARTTIME,U,4))
.I '$D(CANARY) Q
.S PCANCNT=$O(ERRORS("Error",""),-1)+1
.S ERRORS("Error",PCANCNT)=$G(CANARY("HDR"))
.S PCANDTTM=0 F S PCANDTTM=$O(CANARY(PCANDTTM)) Q:'PCANDTTM D
..S PCANCNT=$G(PCANCNT)+1
..S ERRORS("Error",PCANCNT)=$G(CANARY(PCANDTTM,"MSG"))
.S PCANCNT=$G(PCANCNT)+1
.S ERRORS("Error",PCANCNT)="Full day cancellation cannot be used. Do you want to cancel another portion of the day?"
S CANSTARTTIME=$$TC^SDESCCAVAIL2($P(FMSDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SINC)
S ST=$P(CANSTARTTIME,U,3)
S FR=$P(CANSTARTTIME,U,2)
I FR<0 D ERRLOG^SDESJSON(.ERRORS,52,$P(CANSTARTTIME,U,4))
S CANENDTIME=$$TC^SDESCCAVAIL2($P(FMEDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SINC)
S TO=$P(CANENDTIME,U,2)
I TO<0 D ERRLOG^SDESJSON(.ERRORS,52,$P(CANENDTIME,U,4))
Q:$D(ERRORS)
S OVERLAP=$$CHKOVERLAP^SDESCCAVAIL2(.CANARY,FR,TO)
I OVERLAP D
.D ERRLOG^SDESJSON(.ERRORS,250)
.S PCANCNT=$O(ERRORS("Error",""),-1)+1
.Q:'$D(CANARY)
.S PCANCNT=PCANCNT+1
.S ERRORS("Error",PCANCNT)=$G(CANARY("HDR"))
.S PCANLOOP=0 F S PCANLOOP=$O(CANARY(PCANLOOP)) Q:'PCANLOOP D
..S PCANCNT=PCANCNT+1
..S ERRORS("Error",PCANCNT)=$G(CANARY(PCANLOOP,"MSG"))
Q
CHKPARTIALCAN(CANARY,SDCLNIEN,CANDATE) ;
N CHKDT,BEGCANDTTM,ENDCANDTTM,CANMSG,CANDTLOOP,X,MSG,APPTDT,SDCTO
; if the cancellation nodes exist, use them to build the current cancellations (from SDC2+3)
I $D(^SC(SDCLNIEN,"SDCAN")),$P($O(^SC(SDCLNIEN,"SDCAN",CANDATE)),".")=CANDATE D Q
.S CHKDT=CANDATE
.F S CHKDT=$O(^SC(SDCLNIEN,"SDCAN",CHKDT)) Q:'CHKDT!($P(CHKDT,".")>CANDATE) D
..S BEGCANDTTM=$$GET1^DIQ(44.05,CHKDT_","_SDCLNIEN_",",.01,"I")
..S ENDCANDTTM=$$GET1^DIQ(44.05,CHKDT_","_SDCLNIEN_",",1,"I")
..S CANMSG=$$GET1^DIQ(44.001,CHKDT_","_SDCLNIEN_",",1400,"E")
..S CANARY(CHKDT)=$P(BEGCANDTTM,".")_ENDCANDTTM/10000_$S($L(CANMSG):" ("_$P(CANMSG,"(",2),1:"")
.S CANARY("HDR")="Clinic already has the following cancellation(s) for that date: "
.S CANDTLOOP=0
.F S CANDTLOOP=$O(CANARY(CANDTLOOP)) Q:'CANDTLOOP D
..S X=CANDTLOOP
..D TMCHK(.X)
..S CANARY(CANDTLOOP,"MSG")="From: "_X_" To: "
..S X=+(CANARY(CANDTLOOP))
..D TMCHK(.X)
..S CANARY(CANDTLOOP,"MSG")=CANARY(CANDTLOOP,"MSG")_X
..S CANARY(CANDTLOOP,"MSG")=CANARY(CANDTLOOP,"MSG")_$S($P(CANARY(CANDTLOOP),"(",2)]"":" ("_$P(CANARY(CANDTLOOP),"(",2),1:"")
Q
TMCHK(X) ;
N %
S X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M"
Q
;
CANCLNAVA(SDCLNIEN,SDFULLPART,FMSDTTM,FMEDTTM,SI,STARTOFDAY,CANREMARKS,DH,CANAPPTS) ;
N SDATA,SDCNHDL ; for evt dvr
N CANDTTMBEGIN,CANENDTIME,CANENDDTTM,BLOCKLEN,CANCELDATE,NEWIEN,CANMES,CURAVAIL,CANSTARTTIME,Y,NEWAPPTDTTM,SDXX
S CANDTTMBEGIN=FMSDTTM
S CANSTARTTIME=$$TC^SDESCCAVAIL2($P(FMSDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SI)
S ST=$P(CANSTARTTIME,U,3)
S CANSTARTTIME=$P(CANSTARTTIME,U)
S CANENDTIME=$$TC^SDESCCAVAIL2($P(FMEDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SI)
S CANDTTMEND=$P(CANENDTIME,U,2)
S SDXX=$P(CANENDTIME,U,3)
S CANENDTIME=$P(CANENDTIME,U)
S CANCELDATE=$P(FMSDTTM,".")
;
I SDFULLPART="P" D PARTCAN(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANENDTIME,ST,SDXX,.DH,SI,.CANAPPTS)
I SDFULLPART="F" D FULLCAN(SDCLNIEN,CANDTTMBEGIN,CANREMARKS,.DH,.CANAPPTS)
Q
PARTCAN(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANENDTIME,ST,SDXX,DH,SI,CANAPPTS) ;
N FDA,NEWIEN,NEWDTTMIEN,CANMES,CURAVAIL,Y,BLOCKLEN,X,CANCELDATE,P,NOAP
S BLOCKLEN=CANDTTMEND-CANDTTMBEGIN
S CANCELDATE=$P(CANDTTMBEGIN,".")
S FDA(44.05,"+1,"_SDCLNIEN_",",.01)=CANDTTMBEGIN
S FDA(44.05,"+1,"_SDCLNIEN_",",1)=CANENDTIME
S NEWIEN(1)=CANDTTMBEGIN
D UPDATE^DIE(,"FDA","NEWIEN") K FDA,NEWIEN
; NOAP seems to be set, but never used.
S NOAP=$S($O(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001)))'>0:1,$O(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001)))>CANDTTMEND:1,1:0)
I 'NOAP S NOAP=$S($O(^SC(SDCLNIEN,"S",+$O(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001))),0))="MES":1,1:0)
I $D(^SC(SDCLNIEN,"S",CANDTTMBEGIN,0)) D
.S FDA(44.001,CANDTTMBEGIN_","_SDCLNIEN_",",.01)=CANDTTMBEGIN
.D FILE^DIE(,"FDA") K FDA
I '$D(^SC(SDCLNIEN,"S",CANDTTMBEGIN,0)) D
.S FDA(44.001,"+1,"_SDCLNIEN_",",.01)=CANDTTMBEGIN
.S CANMES="CANCELLED UNTIL "_CANENDTIME_$S(CANREMARKS?.P:"",1:" ("_CANREMARKS_")")
.S FDA(44.001,"+1,"_SDCLNIEN_",",1400)=CANMES
.S NEWDTTMIEN(1)=CANDTTMBEGIN
.D UPDATE^DIE(,"FDA","NEWDTTMIEN") K FDA,NEWDTTMIEN
; BELOW LINE OF CODE: ^SC(SC,"ST",SD,"CAN") does not have a field/DD - adding hard set of 'CAN' subscript below with new variables
; S ^SC(SC,"ST",SD,"CAN")=^SC(SC,"ST",SD,1)
S ^SC(SDCLNIEN,"ST",CANCELDATE,"CAN")=$G(^SC(SDCLNIEN,"ST",CANCELDATE,1))
S CURAVAIL=$$GET1^DIQ(44.005,CANCELDATE_","_SDCLNIEN_",",1,"E")
S CURAVAIL=CURAVAIL_$J("",SDXX-$L(CURAVAIL))
S Y=""
I $G(BLOCKLEN)<100,$L(CURAVAIL)<77 S CURAVAIL=CURAVAIL_" " ; pad 4 empty spaces needed for blocks < 60 minutes
F X=0:2:SDXX D
.S DH=$E(CURAVAIL,X+SI+SI)
.S P=$S(X<ST:DH_$E(CURAVAIL,X+1+SI+SI),X=SDXX:$S(Y="[":Y,1:DH)_$E(CURAVAIL,X+1+SI+SI),1:$S(Y="["&(X=ST):"]",1:"X")_"X")
.S Y=$S(DH="]":"",DH="[":DH,1:Y)
.S CURAVAIL=$E(CURAVAIL,1,X-1+SI+SI)_P_$E(CURAVAIL,X+2+SI+SI,999)
S:'$F(CURAVAIL,"[") I5=$F(CURAVAIL,"X"),CURAVAIL=$E(CURAVAIL,1,(I5-2))_"["_$E(CURAVAIL,I5,999)
K I5
S DH=0
; file updated clinic availability
S FDA(44.005,CANCELDATE_","_SDCLNIEN_",",1)=CURAVAIL
D FILE^DIE(,"FDA") K FDA
D EN^SDTMPHLC(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,"P",CANREMARKS)
D CANCELAPPTS(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANREMARKS,.DH,.CANAPPTS)
Q
FULLCAN(SDCLNIEN,CANDTTMBEGIN,CANREMARKS,DH,CANAPPTS) ;
N FR,TO,SD,CURAVAIL,FDA,DH
S DH=0
S SD=$P(CANDTTMBEGIN,".")
S ^SC(SDCLNIEN,"ST",SD,"CAN")=$G(^SC(SDCLNIEN,"ST",SD,1))
S CURAVAIL=" "_$E(SD,6,7)_" **CANCELLED**"
S FDA(44.005,SD_","_SDCLNIEN_",",1)=CURAVAIL
D FILE^DIE(,"FDA") K FDA
S FR=$P(CANDTTMBEGIN,"."),TO=$P(CANDTTMBEGIN,".")+.9
D EN^SDTMPHLC(SDCLNIEN,SD,,"C","**CANCELLED**")
D CANCELAPPTS(SDCLNIEN,FR,TO,CANREMARKS,.DH,.CANAPPTS)
Q
;
CANCELAPPTS(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANREMARKS,DH,CANAPPTS) ;
;Cancel any appointments that are within the timeframe.
N TDH,TMPD,DIE,DR,NODE,SDI
N CANDTLOOP,APPTIEN,IENS,J,J2,DFN,SDCNHDL,SDATA,SDTIME,SDSC,SDTTM,SDPL,TDH,TMPD,APPTSTAT,FDA
N CANCELREASONIEN,CANBY,CAPPTCNT,CAPPTIEN
S SDTIME=$$NOW^XLFDT
S CANCELREASONIEN=$$FIND1^DIC(409.2,,"B","CLINIC CANCELLED")
S CANBY="C",CAPPTCNT=0
S CANDTLOOP=CANDTTMBEGIN-.0001
F S CANDTLOOP=$O(^SC(SDCLNIEN,"S",CANDTLOOP)) Q:'CANDTLOOP!(CANDTLOOP>CANDTTMEND) D
.S APPTIEN=0 F S APPTIEN=$O(^SC(SDCLNIEN,"S",CANDTLOOP,1,APPTIEN)) Q:'APPTIEN D
..S IENS=APPTIEN_","_CANDTLOOP_","_SDCLNIEN_","
..I '$D(^SC(SDCLNIEN,"S",CANDTLOOP,1,APPTIEN,0)) I $D(^SC(SDCLNIEN,"S",CANDTLOOP,1,APPTIEN,"C")) S J=CANDTLOOP,J2=APPTIEN D DELETE^SDC1 K J,J2 Q ;delete corrupt node
..S DFN=$$GET1^DIQ(44.003,IENS,.01,"I")
..I 'DFN S J=CANDTLOOP,J2=APPTIEN D DELETE^SDC1 K J,J2 Q ;if DFN is missing delete record
..; do not process if already cancelled
..Q:$$GET1^DIQ(44.003,IENS,310,"I")="C"
..S SDCNHDL=$$HANDLE^SDAMEVT(1)
..D BEFORE^SDAMEVT(.SDATA,DFN,CANDTLOOP,SDCLNIEN,APPTIEN,SDCNHDL)
..I $$GET1^DIQ(2.98,CANDTLOOP_","_DFN_",",.01,"I")'=SDCLNIEN Q
..S SDSC=SDCLNIEN,SDTTM=CANDTLOOP,SDPL=APPTIEN,TDH=DH,TMPD=CANREMARKS
..D CANCEL^SDCNSLT
..S DH=TDH
..S APPTSTAT=$$GET1^DIQ(2.98,CANDTLOOP_","_DFN_",",.02,"I")
..; quit if cancelled
..I $D(^DPT(DFN,"S",CANDTLOOP,0)),APPTSTAT["C" Q
..S FDA(2.98,CANDTLOOP_","_DFN_",",3)="C"
..S FDA(2.98,CANDTLOOP_","_DFN_",",14)=DUZ
..S FDA(2.98,CANDTLOOP_","_DFN_",",15)=SDTIME
..S FDA(2.98,CANDTLOOP_","_DFN_",",17)=CANREMARKS
..D FILE^DIE(,"FDA") K FDA
..; clinic cancellation must be filed AFTER the patient cancellation or the ASDCN index will not fire (^SDCAN)
..S FDA(44.003,IENS,310)="C"
..D FILE^DIE(,"FDA") K FDA
..S DH=DH+1,TDH=DH,DH=TDH
..D PXRAYRSLTS(SDCLNIEN,CANDTLOOP,DFN,APPTIEN,.DH,SDCNHDL)
..S CAPPTIEN=$$APPTGET^SDECUTL(DFN,CANDTLOOP,SDCLNIEN)
..D SDEC^SDCNP0(DFN,CANDTLOOP,SDCLNIEN,"C","",$G(CANREMARKS),SDTIME,DUZ) ;alb/sat 627
..; quit if the appointment did not get cancelled
..I $$GET1^DIQ(409.84,CAPPTIEN,.17,"I")'="C" Q
..S CAPPTCNT=CAPPTCNT+1
..S CANAPPTS("CancelledAppointment",CAPPTCNT,"AppointmentID")=CAPPTIEN
..; future - consider removing EVT tag and moving CANCEL^SDAMEVT into this loop
..;D CANCEL^SDAMEVT(.SDATA,DFN,CANDTLOOP,SDCLNIEN,APPTIEN,0,SDCNHDL) K SDATA,SDCNHDL
Q
; prior X-RAY results to clinic/record tracking
PXRAYRSLTS(SDCLNIEN,CANDTTM,DFN,APPTIEN,DH,SDCNHDL) ;
; cannot change the following line since the file manager index doesn't support the filing of "N" as data on the index
N SDV1,SDIV,SDH,SDTTM,SDSC,SDPL,SDRT,CHKDIV
; direct global set on this index - cannot be replaced with a file manager call
I $D(^SC("ARAD",SDCLNIEN,CANDTTM,DFN)) S ^SC("ARAD",SDCLNIEN,CANDTTM,DFN)="N"
S CHKDIV=$$GET1^DIQ(44,SDCLNIEN,3.5,"I")
S SDIV=$S(CHKDIV]"":CHKDIV,1:" 1")
S SDV1=$S(SDIV:SDIV,1:+$O(^DG(40.8,0)))
; no index for the following line to properly kill it with fileman
I $D(^DPT("ASDPSD","C",SDIV,SDCLNIEN,CANDTTM,DFN)) K ^DPT("ASDPSD","C",SDIV,SDCLNIEN,CANDTTM,DFN)
; the following cancels record request from record tracking
S SDH=DH,SDTTM=CANDTTM,SDSC=SDCLNIEN,SDPL=APPTIEN,SDRT="D" D RT^SDUTL
S DH=SDH K SDH
D CK1^SDESCCAVAIL2(CANDTTM,DFN,SDIV)
D EVT^SDESCCAVAIL2(DFN,SDTTM,SDSC,SDPL,SDCNHDL)
K SD1,SDIV,SDPL,SDRT,SDSC,SDTTM,SDX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCCAVAIL 16969 printed Oct 16, 2024@18:56:26 Page 2
SDESCCAVAIL ;ALB/KML,MGD,BWF,JDJ - VISTA SCHEDULING RPCS CANCEL CLINIC AVAILABILITY ; January 26,2024
+1 ;;5.3;Scheduling;**800,805,809,813,819,820,824,825,871**;Aug 13, 1993;Build 13
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;
+5 ;No Direct Call
QUIT
+6 ;
CANCLAVAIL(SDCLNJSON,SDCLNIEN,SDFULLPART,SDESBEGDTTM,SDESENDDTTM,SDCANREM,SDEAS) ;Called from RPC: SDES CANCEL CLINIC AVAILABILITY
+1 ; This RPC cancels Clinic availability within a given timeframe for a given clinic.
+2 ; Input:
+3 ; SDCLNJSON [required] - Success or Error message
+4 ; SDCLNIEN [required] - The Internal Entry Number (IEN) from the HOSPITAL LOCATION File #44
+5 ; SDFULLPART [required] - Full or partial day cancellation ('F' for full, 'P' for partial)
+6 ; SDESBEGDTTM [required] - Start date/time in ISO8601 format (CCYY-MM-DDTHH:MM:SS-HH:MM)
+7 ; SDESENDDTTM [required] - End Date/time in ISO8601 format (CCYY-MM-DDTHH:MM:SS-HH:MM)
+8 ; SDCANREM [optional] - Cancellation Remarks (must be 3-160 characters if passed)
+9 ; SDEAS [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
+10 ;
+11 NEW FMSDTTM,FMEDTTM,ERRORS,SINC,STARTOFDAY,SDCLNSREC,CANAPPTS
+12 SET SDCLNIEN=$GET(SDCLNIEN)
SET SDFULLPART=$GET(SDFULLPART)
SET SDESBEGDTTM=$GET(SDESBEGDTTM)
SET SDESENDDTTM=$GET(SDESENDDTTM)
SET SDCANREM=$GET(SDCANREM)
SET SDEAS=$GET(SDEAS)
+13 ; validate the dates first, since we need them to fully validate the clinic
+14 DO VALIDATEFULLPART(.ERRORS,SDFULLPART)
+15 IF $DATA(ERRORS)
SET ERRORS("CancelClinicAvailability",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS)
QUIT
+16 SET FMSDTTM=$$VALIDATEBEGDATE(.ERRORS,SDESBEGDTTM,SDCLNIEN)
+17 IF $DATA(ERRORS)
SET ERRORS("CancelClinicAvailability",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS)
QUIT
+18 SET FMEDTTM=$$VALIDATEENDDATE(.ERRORS,SDESBEGDTTM,SDESENDDTTM,SDCLNIEN)
+19 IF $DATA(ERRORS)
SET ERRORS("CancelClinicAvailability",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS)
QUIT
+20 DO VALIDATECANREM(.ERRORS,SDCANREM)
+21 IF $DATA(ERRORS)
SET ERRORS("CancelClinicAvailability",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS)
QUIT
+22 SET SINC=""
+23 DO VALIDATECLINIC(.ERRORS,SDCLNIEN,FMSDTTM,FMEDTTM,.SINC,.STARTOFDAY)
+24 DO VALIDATEEAS(.ERRORS,SDEAS)
+25 IF $DATA(ERRORS)
Begin DoDot:1
+26 SET ERRORS("CancelClinicAvailability",1)=""
+27 DO BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS)
End DoDot:1
QUIT
+28 DO CANCLNAVA(SDCLNIEN,SDFULLPART,FMSDTTM,FMEDTTM,SINC,STARTOFDAY,$GET(SDCANREM),.DH,.CANAPPTS)
+29 SET SDCLNSREC("CancelClinicAvailability",1)="Clinic availability has been successfully cancelled."
+30 IF '$DATA(CANAPPTS)
SET SDCLNSREC("CancelClinicAvailability",1)=SDCLNSREC("CancelClinicAvailability",1)_" No appointments scheduled."
+31 MERGE SDCLNSREC=CANAPPTS
+32 DO BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.SDCLNSREC)
+33 QUIT
+34 ;
VALIDATEFULLPART(ERRORS,FP) ;
+1 ; missing full or partial flag
+2 ; Missing full/partial day cancellation flag
IF $GET(FP)=""
DO ERRLOG^SDESJSON(.ERRORS,245)
QUIT
+3 ; incorrect type
+4 ;Invalid full/partial day cancellation flag
IF $GET(FP)'="F"&($GET(FP)'="P")
DO ERRLOG^SDESJSON(.ERRORS,246)
+5 QUIT
+6 ;
VALIDATEBEGDATE(ERRORS,BDATE,CLINIC) ;
+1 NEW FMSDATE
+2 IF BDATE=""
DO ERRLOG^SDESJSON(.ERRORS,9)
QUIT ""
+3 SET FMSDATE=$$ISOTFM^SDAMUTDT(BDATE,CLINIC)
+4 IF FMSDATE<1
DO ERRLOG^SDESJSON(.ERRORS,11)
QUIT ""
+5 QUIT FMSDATE
+6 ;
VALIDATEENDDATE(ERRORS,BDATE,EDATE,CLINIC) ;
+1 NEW FMSDATE,FMEDATE
+2 IF EDATE=""
DO ERRLOG^SDESJSON(.ERRORS,10)
QUIT ""
+3 SET FMSDATE=$$ISOTFM^SDAMUTDT(BDATE,CLINIC)
+4 SET FMEDATE=$$ISOTFM^SDAMUTDT(EDATE,CLINIC)
+5 IF FMEDATE<1
DO ERRLOG^SDESJSON(.ERRORS,12)
QUIT ""
+6 ; Start date and end date must be the same
+7 IF $PIECE(FMEDATE,".")'=$PIECE(FMSDATE,".")
DO ERRLOG^SDESJSON(.ERRORS,241)
QUIT ""
+8 ;"End time must be after Start Time."
IF FMEDATE<FMSDATE
DO ERRLOG^SDESJSON(.ERRORS,242)
QUIT ""
+9 ;"End time must be after Start Time."
IF FMEDATE=FMSDATE
DO ERRLOG^SDESJSON(.ERRORS,242)
QUIT ""
+10 QUIT FMEDATE
+11 ;
VALIDATECANREM(ERRORS,REMARKS) ;
+1 IF $LENGTH(REMARKS)
IF $LENGTH(REMARKS)<3!($LENGTH(REMARKS)>160)
DO ERRLOG^SDESJSON(.ERRORS,255)
+2 QUIT
VALIDATEEAS(ERRORS,SDEAS) ;
+1 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL($GET(SDEAS))
+2 IF $PIECE($GET(SDEAS),U)=-1
DO ERRLOG^SDESJSON(.ERRORS,142)
+3 QUIT
VALIDATECLINIC(ERRORS,SDCLNIEN,FMSDTTM,FMEDTTM,SINC,STARTOFDAY) ;
+1 NEW FRTIME,TOTIME,DISPINCPERHR,HRCLNDISPBEG,HRCLNDISP,INACTIVATEDT,INACTIVATEDTEXT,REACTIVATEDT,REACTIVATEDTEXT,CANCELDATE,FDA,FDAIEN
+2 NEW X,MASTERPATTERN,MPATTERNSLOTS,DAYSCHED,DOW,REACTIVATEMSG,Y,FILENO
+3 IF SDCLNIEN=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+4 IF '$DATA(^SC(SDCLNIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+5 SET CANCELDATE=$PIECE(FMSDTTM,".")
+6 SET FRTIME=$PIECE(FMSDTTM,".",2)
SET TOTIME=$PIECE(FMEDTTM,".",2)
+7 ; DISPINCPERHR - display increments per hour
+8 SET DISPINCPERHR=$$GET1^DIQ(44,SDCLNIEN,1917,"I")
+9 ; SINC - DISPLAY INCREMENTS PER HOUR
+10 SET SINC=$SELECT(DISPINCPERHR="":4,DISPINCPERHR<3:4,DISPINCPERHR:DISPINCPERHR,1:4)
+11 ; HRCLNDISPBEG - hour clinic display begins
+12 SET HRCLNDISPBEG=$$GET1^DIQ(44,SDCLNIEN,1914,"I")
+13 IF HRCLNDISPBEG=""
SET HRCLNDISPBEG=8
+14 SET STARTOFDAY=$SELECT($LENGTH(HRCLNDISPBEG):HRCLNDISPBEG,1:8)
+15 ; Clinic inactive
+16 SET INACTIVATEDT=$$GET1^DIQ(44,SDCLNIEN,2505,"I")
+17 SET INACTIVATEDTEXT=$TRANSLATE($$FMTE^XLFDT(INACTIVATEDT,"5DF")," ","0")
+18 SET REACTIVATEDT=$$GET1^DIQ(44,SDCLNIEN,2506,"I")
+19 SET REACTIVATEDTEXT=$TRANSLATE($$FMTE^XLFDT(REACTIVATEDT,"5DF")," ","0")
+20 IF REACTIVATEDT
Begin DoDot:1
+21 SET REACTIVATEMSG=$SELECT(REACTIVATEDT:" to "_REACTIVATEDTEXT,1:"")
End DoDot:1
+22 IF INACTIVATEDT
Begin DoDot:1
+23 ; if inactivate date is after than the cancel request date, quit
+24 IF INACTIVATEDT>$PIECE(CANCELDATE,".")
QUIT
+25 ; if there is a reactivation date and the reactivation date before the cancel date, quit
+26 IF REACTIVATEDT
IF REACTIVATEDT<$PIECE(CANCELDATE,".")
QUIT
+27 DO ERRLOG^SDESJSON(.ERRORS,52,"Clinic is inactive "_$SELECT('REACTIVATEDT:"as of ",1:"from ")_INACTIVATEDTEXT_$GET(REACTIVATEMSG))
End DoDot:1
+28 if $DATA(ERRORS)
QUIT
+29 ;
+30 ; if the pattern does not exist for this date, create it from the template
+31 ; otherwise the user will be incorrectly told that the clinic does not meet on this day
+32 IF '$DATA(^SC(SDCLNIEN,"ST",CANCELDATE,1))
Begin DoDot:1
+33 SET X=CANCELDATE
+34 DO DOW^SDM0
SET DOW=Y
+35 SET MASTERPATTERN=+$ORDER(^SC(SDCLNIEN,"T"_DOW,CANCELDATE))
+36 SET FILENO=$SELECT(DOW=0:44.06,DOW=1:44.07,DOW=2:44.08,DOW=3:44.09,DOW=4:44.008,DOW=5:44.009,DOW=6:44.0001,1:"")
+37 SET MPATTERNSLOTS=$$GET1^DIQ(FILENO,MASTERPATTERN_","_SDCLNIEN_",",1)
End DoDot:1
+38 ;.S FDA(44.005,"+1,"_SDCLNIEN_",",.01)=CANCELDATE
+39 ;.S FDA(44.005,"+1,"_SDCLNIEN_",",1)=$P("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$E(CANCELDATE,6,7)_$J("",SINC+SINC-6)_MPATTERNSLOTS
+40 ;.S FDAIEN(1)=CANCELDATE
+41 ;.D UPDATE^DIE(,"FDA","FDAIEN","FERR") K FDA,FDAIEN
+42 SET DAYSCHED=$$GET1^DIQ(44.005,CANCELDATE_","_SDCLNIEN_",",1,"I")
+43 IF DAYSCHED["CANCELLED"
DO ERRLOG^SDESJSON(.ERRORS,248)
QUIT
+44 ; Clinic does not meet on that day
+45 IF DAYSCHED'["["
DO ERRLOG^SDESJSON(.ERRORS,249)
QUIT
+46 ; future consideration - should we inform the user whether or not appointments were scheduled?
+47 ;I $O(^SC(SDCLNIEN,"S",CANCELDATE))\1-CANCELDATE D ERRLOG^SDESJSON(.ERRORS,52,"NO APPOINTMENTS SCHEDULED") Q
+48 ;I $O(^SC(SC,"S",SD))\1-SD W *7,!?5,"NO APPOINTMENTS SCHEDULED" S NOAP=1 G W
+49 ;
+50 ; Loss of workload credit
+51 IF SDFULLPART="P"
IF $$COED^SDESCCAVAIL2(SDCLNIEN,FMSDTTM,FMEDTTM,1)
DO ERRLOG^SDESJSON(.ERRORS,247)
QUIT
+52 IF SDFULLPART="F"
IF $$COED^SDESCCAVAIL2(SDCLNIEN,$PIECE(FMSDTTM,"."),$PIECE(FMSDTTM,".")_.2359,1)
DO ERRLOG^SDESJSON(.ERRORS,247)
QUIT
+53 ;
+54 NEW CANARY,OVERLAP,PCANDTTM,PCANCNT,PCANLOOP,FDAYSTRT
+55 DO CHKPARTIALCAN(.CANARY,SDCLNIEN,CANCELDATE)
+56 IF SDFULLPART="F"
Begin DoDot:1
+57 SET PCANCNT=0
+58 SET CANSTARTTIME=$$TC^SDESCCAVAIL2($PIECE(FMSDTTM,".",2),$PIECE(FMSDTTM,"."),STARTOFDAY,SINC)
+59 SET ST=$PIECE(CANSTARTTIME,U,3)
+60 SET FR=$PIECE(CANSTARTTIME,U,2)
+61 IF FR<0
DO ERRLOG^SDESJSON(.ERRORS,52,$PIECE(CANSTARTTIME,U,4))
+62 IF '$DATA(CANARY)
QUIT
+63 SET PCANCNT=$ORDER(ERRORS("Error",""),-1)+1
+64 SET ERRORS("Error",PCANCNT)=$GET(CANARY("HDR"))
+65 SET PCANDTTM=0
FOR
SET PCANDTTM=$ORDER(CANARY(PCANDTTM))
if 'PCANDTTM
QUIT
Begin DoDot:2
+66 SET PCANCNT=$GET(PCANCNT)+1
+67 SET ERRORS("Error",PCANCNT)=$GET(CANARY(PCANDTTM,"MSG"))
End DoDot:2
+68 SET PCANCNT=$GET(PCANCNT)+1
+69 SET ERRORS("Error",PCANCNT)="Full day cancellation cannot be used. Do you want to cancel another portion of the day?"
End DoDot:1
QUIT
+70 SET CANSTARTTIME=$$TC^SDESCCAVAIL2($PIECE(FMSDTTM,".",2),$PIECE(FMSDTTM,"."),STARTOFDAY,SINC)
+71 SET ST=$PIECE(CANSTARTTIME,U,3)
+72 SET FR=$PIECE(CANSTARTTIME,U,2)
+73 IF FR<0
DO ERRLOG^SDESJSON(.ERRORS,52,$PIECE(CANSTARTTIME,U,4))
+74 SET CANENDTIME=$$TC^SDESCCAVAIL2($PIECE(FMEDTTM,".",2),$PIECE(FMSDTTM,"."),STARTOFDAY,SINC)
+75 SET TO=$PIECE(CANENDTIME,U,2)
+76 IF TO<0
DO ERRLOG^SDESJSON(.ERRORS,52,$PIECE(CANENDTIME,U,4))
+77 if $DATA(ERRORS)
QUIT
+78 SET OVERLAP=$$CHKOVERLAP^SDESCCAVAIL2(.CANARY,FR,TO)
+79 IF OVERLAP
Begin DoDot:1
+80 DO ERRLOG^SDESJSON(.ERRORS,250)
+81 SET PCANCNT=$ORDER(ERRORS("Error",""),-1)+1
+82 if '$DATA(CANARY)
QUIT
+83 SET PCANCNT=PCANCNT+1
+84 SET ERRORS("Error",PCANCNT)=$GET(CANARY("HDR"))
+85 SET PCANLOOP=0
FOR
SET PCANLOOP=$ORDER(CANARY(PCANLOOP))
if 'PCANLOOP
QUIT
Begin DoDot:2
+86 SET PCANCNT=PCANCNT+1
+87 SET ERRORS("Error",PCANCNT)=$GET(CANARY(PCANLOOP,"MSG"))
End DoDot:2
End DoDot:1
+88 QUIT
CHKPARTIALCAN(CANARY,SDCLNIEN,CANDATE) ;
+1 NEW CHKDT,BEGCANDTTM,ENDCANDTTM,CANMSG,CANDTLOOP,X,MSG,APPTDT,SDCTO
+2 ; if the cancellation nodes exist, use them to build the current cancellations (from SDC2+3)
+3 IF $DATA(^SC(SDCLNIEN,"SDCAN"))
IF $PIECE($ORDER(^SC(SDCLNIEN,"SDCAN",CANDATE)),".")=CANDATE
Begin DoDot:1
+4 SET CHKDT=CANDATE
+5 FOR
SET CHKDT=$ORDER(^SC(SDCLNIEN,"SDCAN",CHKDT))
if 'CHKDT!($PIECE(CHKDT,".")>CANDATE)
QUIT
Begin DoDot:2
+6 SET BEGCANDTTM=$$GET1^DIQ(44.05,CHKDT_","_SDCLNIEN_",",.01,"I")
+7 SET ENDCANDTTM=$$GET1^DIQ(44.05,CHKDT_","_SDCLNIEN_",",1,"I")
+8 SET CANMSG=$$GET1^DIQ(44.001,CHKDT_","_SDCLNIEN_",",1400,"E")
+9 SET CANARY(CHKDT)=$PIECE(BEGCANDTTM,".")_ENDCANDTTM/10000_$SELECT($LENGTH(CANMSG):" ("_$PIECE(CANMSG,"(",2),1:"")
End DoDot:2
+10 SET CANARY("HDR")="Clinic already has the following cancellation(s) for that date: "
+11 SET CANDTLOOP=0
+12 FOR
SET CANDTLOOP=$ORDER(CANARY(CANDTLOOP))
if 'CANDTLOOP
QUIT
Begin DoDot:2
+13 SET X=CANDTLOOP
+14 DO TMCHK(.X)
+15 SET CANARY(CANDTLOOP,"MSG")="From: "_X_" To: "
+16 SET X=+(CANARY(CANDTLOOP))
+17 DO TMCHK(.X)
+18 SET CANARY(CANDTLOOP,"MSG")=CANARY(CANDTLOOP,"MSG")_X
+19 SET CANARY(CANDTLOOP,"MSG")=CANARY(CANDTLOOP,"MSG")_$SELECT($PIECE(CANARY(CANDTLOOP),"(",2)]"":" ("_$PIECE(CANARY(CANDTLOOP),"(",2),1:"")
End DoDot:2
End DoDot:1
QUIT
+20 QUIT
TMCHK(X) ;
+1 NEW %
+2 SET X=$EXTRACT($PIECE(X,".",2)_"0000",1,4)
SET %=X>1159
if X>1259
SET X=X-1200
SET X=X\100_":"_$EXTRACT(X#100+100,2,3)_" "_$EXTRACT("AP",%+1)_"M"
+3 QUIT
+4 ;
CANCLNAVA(SDCLNIEN,SDFULLPART,FMSDTTM,FMEDTTM,SI,STARTOFDAY,CANREMARKS,DH,CANAPPTS) ;
+1 ; for evt dvr
NEW SDATA,SDCNHDL
+2 NEW CANDTTMBEGIN,CANENDTIME,CANENDDTTM,BLOCKLEN,CANCELDATE,NEWIEN,CANMES,CURAVAIL,CANSTARTTIME,Y,NEWAPPTDTTM,SDXX
+3 SET CANDTTMBEGIN=FMSDTTM
+4 SET CANSTARTTIME=$$TC^SDESCCAVAIL2($PIECE(FMSDTTM,".",2),$PIECE(FMSDTTM,"."),STARTOFDAY,SI)
+5 SET ST=$PIECE(CANSTARTTIME,U,3)
+6 SET CANSTARTTIME=$PIECE(CANSTARTTIME,U)
+7 SET CANENDTIME=$$TC^SDESCCAVAIL2($PIECE(FMEDTTM,".",2),$PIECE(FMSDTTM,"."),STARTOFDAY,SI)
+8 SET CANDTTMEND=$PIECE(CANENDTIME,U,2)
+9 SET SDXX=$PIECE(CANENDTIME,U,3)
+10 SET CANENDTIME=$PIECE(CANENDTIME,U)
+11 SET CANCELDATE=$PIECE(FMSDTTM,".")
+12 ;
+13 IF SDFULLPART="P"
DO PARTCAN(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANENDTIME,ST,SDXX,.DH,SI,.CANAPPTS)
+14 IF SDFULLPART="F"
DO FULLCAN(SDCLNIEN,CANDTTMBEGIN,CANREMARKS,.DH,.CANAPPTS)
+15 QUIT
PARTCAN(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANENDTIME,ST,SDXX,DH,SI,CANAPPTS) ;
+1 NEW FDA,NEWIEN,NEWDTTMIEN,CANMES,CURAVAIL,Y,BLOCKLEN,X,CANCELDATE,P,NOAP
+2 SET BLOCKLEN=CANDTTMEND-CANDTTMBEGIN
+3 SET CANCELDATE=$PIECE(CANDTTMBEGIN,".")
+4 SET FDA(44.05,"+1,"_SDCLNIEN_",",.01)=CANDTTMBEGIN
+5 SET FDA(44.05,"+1,"_SDCLNIEN_",",1)=CANENDTIME
+6 SET NEWIEN(1)=CANDTTMBEGIN
+7 DO UPDATE^DIE(,"FDA","NEWIEN")
KILL FDA,NEWIEN
+8 ; NOAP seems to be set, but never used.
+9 SET NOAP=$SELECT($ORDER(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001)))'>0:1,$ORDER(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001)))>CANDTTMEND:1,1:0)
+10 IF 'NOAP
SET NOAP=$SELECT($ORDER(^SC(SDCLNIEN,"S",+$ORDER(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001))),0))="MES":1,1:0)
+11 IF $DATA(^SC(SDCLNIEN,"S",CANDTTMBEGIN,0))
Begin DoDot:1
+12 SET FDA(44.001,CANDTTMBEGIN_","_SDCLNIEN_",",.01)=CANDTTMBEGIN
+13 DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+14 IF '$DATA(^SC(SDCLNIEN,"S",CANDTTMBEGIN,0))
Begin DoDot:1
+15 SET FDA(44.001,"+1,"_SDCLNIEN_",",.01)=CANDTTMBEGIN
+16 SET CANMES="CANCELLED UNTIL "_CANENDTIME_$SELECT(CANREMARKS?.P:"",1:" ("_CANREMARKS_")")
+17 SET FDA(44.001,"+1,"_SDCLNIEN_",",1400)=CANMES
+18 SET NEWDTTMIEN(1)=CANDTTMBEGIN
+19 DO UPDATE^DIE(,"FDA","NEWDTTMIEN")
KILL FDA,NEWDTTMIEN
End DoDot:1
+20 ; BELOW LINE OF CODE: ^SC(SC,"ST",SD,"CAN") does not have a field/DD - adding hard set of 'CAN' subscript below with new variables
+21 ; S ^SC(SC,"ST",SD,"CAN")=^SC(SC,"ST",SD,1)
+22 SET ^SC(SDCLNIEN,"ST",CANCELDATE,"CAN")=$GET(^SC(SDCLNIEN,"ST",CANCELDATE,1))
+23 SET CURAVAIL=$$GET1^DIQ(44.005,CANCELDATE_","_SDCLNIEN_",",1,"E")
+24 SET CURAVAIL=CURAVAIL_$JUSTIFY("",SDXX-$LENGTH(CURAVAIL))
+25 SET Y=""
+26 ; pad 4 empty spaces needed for blocks < 60 minutes
IF $GET(BLOCKLEN)<100
IF $LENGTH(CURAVAIL)<77
SET CURAVAIL=CURAVAIL_" "
+27 FOR X=0:2:SDXX
Begin DoDot:1
+28 SET DH=$EXTRACT(CURAVAIL,X+SI+SI)
+29 SET P=$SELECT(X<ST:DH_$EXTRACT(CURAVAIL,X+1+SI+SI),X=SDXX:$SELECT(Y="[":Y,1:DH)_$EXTRACT(CURAVAIL,X+1+SI+SI),1:$SELECT(Y="["&(X=ST):"]",1:"X")_"X")
+30 SET Y=$SELECT(DH="]":"",DH="[":DH,1:Y)
+31 SET CURAVAIL=$EXTRACT(CURAVAIL,1,X-1+SI+SI)_P_$EXTRACT(CURAVAIL,X+2+SI+SI,999)
End DoDot:1
+32 if '$FIND(CURAVAIL,"[")
SET I5=$FIND(CURAVAIL,"X")
SET CURAVAIL=$EXTRACT(CURAVAIL,1,(I5-2))_"["_$EXTRACT(CURAVAIL,I5,999)
+33 KILL I5
+34 SET DH=0
+35 ; file updated clinic availability
+36 SET FDA(44.005,CANCELDATE_","_SDCLNIEN_",",1)=CURAVAIL
+37 DO FILE^DIE(,"FDA")
KILL FDA
+38 DO EN^SDTMPHLC(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,"P",CANREMARKS)
+39 DO CANCELAPPTS(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANREMARKS,.DH,.CANAPPTS)
+40 QUIT
FULLCAN(SDCLNIEN,CANDTTMBEGIN,CANREMARKS,DH,CANAPPTS) ;
+1 NEW FR,TO,SD,CURAVAIL,FDA,DH
+2 SET DH=0
+3 SET SD=$PIECE(CANDTTMBEGIN,".")
+4 SET ^SC(SDCLNIEN,"ST",SD,"CAN")=$GET(^SC(SDCLNIEN,"ST",SD,1))
+5 SET CURAVAIL=" "_$EXTRACT(SD,6,7)_" **CANCELLED**"
+6 SET FDA(44.005,SD_","_SDCLNIEN_",",1)=CURAVAIL
+7 DO FILE^DIE(,"FDA")
KILL FDA
+8 SET FR=$PIECE(CANDTTMBEGIN,".")
SET TO=$PIECE(CANDTTMBEGIN,".")+.9
+9 DO EN^SDTMPHLC(SDCLNIEN,SD,,"C","**CANCELLED**")
+10 DO CANCELAPPTS(SDCLNIEN,FR,TO,CANREMARKS,.DH,.CANAPPTS)
+11 QUIT
+12 ;
CANCELAPPTS(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANREMARKS,DH,CANAPPTS) ;
+1 ;Cancel any appointments that are within the timeframe.
+2 NEW TDH,TMPD,DIE,DR,NODE,SDI
+3 NEW CANDTLOOP,APPTIEN,IENS,J,J2,DFN,SDCNHDL,SDATA,SDTIME,SDSC,SDTTM,SDPL,TDH,TMPD,APPTSTAT,FDA
+4 NEW CANCELREASONIEN,CANBY,CAPPTCNT,CAPPTIEN
+5 SET SDTIME=$$NOW^XLFDT
+6 SET CANCELREASONIEN=$$FIND1^DIC(409.2,,"B","CLINIC CANCELLED")
+7 SET CANBY="C"
SET CAPPTCNT=0
+8 SET CANDTLOOP=CANDTTMBEGIN-.0001
+9 FOR
SET CANDTLOOP=$ORDER(^SC(SDCLNIEN,"S",CANDTLOOP))
if 'CANDTLOOP!(CANDTLOOP>CANDTTMEND)
QUIT
Begin DoDot:1
+10 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SC(SDCLNIEN,"S",CANDTLOOP,1,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+11 SET IENS=APPTIEN_","_CANDTLOOP_","_SDCLNIEN_","
+12 ;delete corrupt node
IF '$DATA(^SC(SDCLNIEN,"S",CANDTLOOP,1,APPTIEN,0))
IF $DATA(^SC(SDCLNIEN,"S",CANDTLOOP,1,APPTIEN,"C"))
SET J=CANDTLOOP
SET J2=APPTIEN
DO DELETE^SDC1
KILL J,J2
QUIT
+13 SET DFN=$$GET1^DIQ(44.003,IENS,.01,"I")
+14 ;if DFN is missing delete record
IF 'DFN
SET J=CANDTLOOP
SET J2=APPTIEN
DO DELETE^SDC1
KILL J,J2
QUIT
+15 ; do not process if already cancelled
+16 if $$GET1^DIQ(44.003,IENS,310,"I")="C"
QUIT
+17 SET SDCNHDL=$$HANDLE^SDAMEVT(1)
+18 DO BEFORE^SDAMEVT(.SDATA,DFN,CANDTLOOP,SDCLNIEN,APPTIEN,SDCNHDL)
+19 IF $$GET1^DIQ(2.98,CANDTLOOP_","_DFN_",",.01,"I")'=SDCLNIEN
QUIT
+20 SET SDSC=SDCLNIEN
SET SDTTM=CANDTLOOP
SET SDPL=APPTIEN
SET TDH=DH
SET TMPD=CANREMARKS
+21 DO CANCEL^SDCNSLT
+22 SET DH=TDH
+23 SET APPTSTAT=$$GET1^DIQ(2.98,CANDTLOOP_","_DFN_",",.02,"I")
+24 ; quit if cancelled
+25 IF $DATA(^DPT(DFN,"S",CANDTLOOP,0))
IF APPTSTAT["C"
QUIT
+26 SET FDA(2.98,CANDTLOOP_","_DFN_",",3)="C"
+27 SET FDA(2.98,CANDTLOOP_","_DFN_",",14)=DUZ
+28 SET FDA(2.98,CANDTLOOP_","_DFN_",",15)=SDTIME
+29 SET FDA(2.98,CANDTLOOP_","_DFN_",",17)=CANREMARKS
+30 DO FILE^DIE(,"FDA")
KILL FDA
+31 ; clinic cancellation must be filed AFTER the patient cancellation or the ASDCN index will not fire (^SDCAN)
+32 SET FDA(44.003,IENS,310)="C"
+33 DO FILE^DIE(,"FDA")
KILL FDA
+34 SET DH=DH+1
SET TDH=DH
SET DH=TDH
+35 DO PXRAYRSLTS(SDCLNIEN,CANDTLOOP,DFN,APPTIEN,.DH,SDCNHDL)
+36 SET CAPPTIEN=$$APPTGET^SDECUTL(DFN,CANDTLOOP,SDCLNIEN)
+37 ;alb/sat 627
DO SDEC^SDCNP0(DFN,CANDTLOOP,SDCLNIEN,"C","",$GET(CANREMARKS),SDTIME,DUZ)
+38 ; quit if the appointment did not get cancelled
+39 IF $$GET1^DIQ(409.84,CAPPTIEN,.17,"I")'="C"
QUIT
+40 SET CAPPTCNT=CAPPTCNT+1
+41 SET CANAPPTS("CancelledAppointment",CAPPTCNT,"AppointmentID")=CAPPTIEN
+42 ; future - consider removing EVT tag and moving CANCEL^SDAMEVT into this loop
+43 ;D CANCEL^SDAMEVT(.SDATA,DFN,CANDTLOOP,SDCLNIEN,APPTIEN,0,SDCNHDL) K SDATA,SDCNHDL
End DoDot:2
End DoDot:1
+44 QUIT
+45 ; prior X-RAY results to clinic/record tracking
PXRAYRSLTS(SDCLNIEN,CANDTTM,DFN,APPTIEN,DH,SDCNHDL) ;
+1 ; cannot change the following line since the file manager index doesn't support the filing of "N" as data on the index
+2 NEW SDV1,SDIV,SDH,SDTTM,SDSC,SDPL,SDRT,CHKDIV
+3 ; direct global set on this index - cannot be replaced with a file manager call
+4 IF $DATA(^SC("ARAD",SDCLNIEN,CANDTTM,DFN))
SET ^SC("ARAD",SDCLNIEN,CANDTTM,DFN)="N"
+5 SET CHKDIV=$$GET1^DIQ(44,SDCLNIEN,3.5,"I")
+6 SET SDIV=$SELECT(CHKDIV]"":CHKDIV,1:" 1")
+7 SET SDV1=$SELECT(SDIV:SDIV,1:+$ORDER(^DG(40.8,0)))
+8 ; no index for the following line to properly kill it with fileman
+9 IF $DATA(^DPT("ASDPSD","C",SDIV,SDCLNIEN,CANDTTM,DFN))
KILL ^DPT("ASDPSD","C",SDIV,SDCLNIEN,CANDTTM,DFN)
+10 ; the following cancels record request from record tracking
+11 SET SDH=DH
SET SDTTM=CANDTTM
SET SDSC=SDCLNIEN
SET SDPL=APPTIEN
SET SDRT="D"
DO RT^SDUTL
+12 SET DH=SDH
KILL SDH
+13 DO CK1^SDESCCAVAIL2(CANDTTM,DFN,SDIV)
+14 DO EVT^SDESCCAVAIL2(DFN,SDTTM,SDSC,SDPL,SDCNHDL)
+15 KILL SD1,SDIV,SDPL,SDRT,SDSC,SDTTM,SDX
+16 QUIT
