Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESCCAVAIL

SDESCCAVAIL.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ;
  1.  Q  ;No Direct Call
  1.  ;
  1. 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.
  1.  ; Input:
  1.  ;   SDCLNJSON   [required] - Success or Error message
  1.  ;   SDCLNIEN    [required] - The Internal Entry Number (IEN) from the HOSPITAL LOCATION File #44
  1.  ;   SDFULLPART  [required] - Full or partial day cancellation ('F' for full, 'P' for partial)
  1.  ;   SDESBEGDTTM [required] - Start date/time in ISO8601 format (CCYY-MM-DDTHH:MM:SS-HH:MM)
  1.  ;   SDESENDDTTM [required] - End Date/time in ISO8601 format (CCYY-MM-DDTHH:MM:SS-HH:MM)
  1.  ;   SDCANREM    [optional] - Cancellation Remarks (must be 3-160 characters if passed)
  1.  ;   SDEAS       [optional] - Enterprise Appointment Scheduling (EAS) Tracking Number associated to an appointment.
  1.  ;
  1.  N FMSDTTM,FMEDTTM,ERRORS,SINC,STARTOFDAY,SDCLNSREC,CANAPPTS
  1.  S SDCLNIEN=$G(SDCLNIEN),SDFULLPART=$G(SDFULLPART),SDESBEGDTTM=$G(SDESBEGDTTM),SDESENDDTTM=$G(SDESENDDTTM),SDCANREM=$G(SDCANREM),SDEAS=$G(SDEAS)
  1.  ; validate the dates first, since we need them to fully validate the clinic
  1.  D VALIDATEFULLPART(.ERRORS,SDFULLPART)
  1.  I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
  1.  S FMSDTTM=$$VALIDATEBEGDATE(.ERRORS,SDESBEGDTTM,SDCLNIEN)
  1.  I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
  1.  S FMEDTTM=$$VALIDATEENDDATE(.ERRORS,SDESBEGDTTM,SDESENDDTTM,SDCLNIEN)
  1.  I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
  1.  D VALIDATECANREM(.ERRORS,SDCANREM)
  1.  I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS) Q
  1.  S SINC=""
  1.  D VALIDATECLINIC(.ERRORS,SDCLNIEN,FMSDTTM,FMEDTTM,.SINC,.STARTOFDAY)
  1.  D VALIDATEEAS(.ERRORS,SDEAS)
  1.  I $D(ERRORS) D  Q
  1.  .S ERRORS("CancelClinicAvailability",1)=""
  1.  .D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.ERRORS)
  1.  D CANCLNAVA(SDCLNIEN,SDFULLPART,FMSDTTM,FMEDTTM,SINC,STARTOFDAY,$G(SDCANREM),.DH,.CANAPPTS)
  1.  S SDCLNSREC("CancelClinicAvailability",1)="Clinic availability has been successfully cancelled."
  1.  I '$D(CANAPPTS) S SDCLNSREC("CancelClinicAvailability",1)=SDCLNSREC("CancelClinicAvailability",1)_" No appointments scheduled."
  1.  M SDCLNSREC=CANAPPTS
  1.  D BUILDJSON^SDESBUILDJSON(.SDCLNJSON,.SDCLNSREC)
  1.  Q
  1.  ;
  1. VALIDATEFULLPART(ERRORS,FP) ;
  1.  ; missing full or partial flag
  1.  I $G(FP)="" D ERRLOG^SDESJSON(.ERRORS,245) Q  ; Missing full/partial day cancellation flag
  1.  ; incorrect type
  1.  I $G(FP)'="F"&($G(FP)'="P") D ERRLOG^SDESJSON(.ERRORS,246)  ;Invalid full/partial day cancellation flag
  1.  Q
  1.  ;
  1. VALIDATEBEGDATE(ERRORS,BDATE,CLINIC) ;
  1.  N FMSDATE
  1.  I BDATE="" D ERRLOG^SDESJSON(.ERRORS,9) Q ""
  1.  S FMSDATE=$$ISOTFM^SDAMUTDT(BDATE,CLINIC)
  1.  I FMSDATE<1 D ERRLOG^SDESJSON(.ERRORS,11) Q ""
  1.  Q FMSDATE
  1.  ;
  1. VALIDATEENDDATE(ERRORS,BDATE,EDATE,CLINIC) ;
  1.  N FMSDATE,FMEDATE
  1.  I EDATE="" D ERRLOG^SDESJSON(.ERRORS,10) Q ""
  1.  S FMSDATE=$$ISOTFM^SDAMUTDT(BDATE,CLINIC)
  1.  S FMEDATE=$$ISOTFM^SDAMUTDT(EDATE,CLINIC)
  1.  I FMEDATE<1 D ERRLOG^SDESJSON(.ERRORS,12) Q ""
  1.  ; Start date and end date must be the same
  1.  I $P(FMEDATE,".")'=$P(FMSDATE,".") D ERRLOG^SDESJSON(.ERRORS,241) Q ""
  1.  I FMEDATE<FMSDATE D ERRLOG^SDESJSON(.ERRORS,242) Q ""  ;"End time must be after Start Time."
  1.  I FMEDATE=FMSDATE D ERRLOG^SDESJSON(.ERRORS,242) Q ""  ;"End time must be after Start Time."
  1.  Q FMEDATE
  1.  ;
  1. VALIDATECANREM(ERRORS,REMARKS) ;
  1.  I $L(REMARKS),$L(REMARKS)<3!($L(REMARKS)>160) D ERRLOG^SDESJSON(.ERRORS,255)
  1.  Q
  1. VALIDATEEAS(ERRORS,SDEAS) ;
  1.  I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL($G(SDEAS))
  1.  I $P($G(SDEAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142)
  1.  Q
  1. VALIDATECLINIC(ERRORS,SDCLNIEN,FMSDTTM,FMEDTTM,SINC,STARTOFDAY) ;
  1.  N FRTIME,TOTIME,DISPINCPERHR,HRCLNDISPBEG,HRCLNDISP,INACTIVATEDT,INACTIVATEDTEXT,REACTIVATEDT,REACTIVATEDTEXT,CANCELDATE,FDA,FDAIEN
  1.  N X,MASTERPATTERN,MPATTERNSLOTS,DAYSCHED,DOW,REACTIVATEMSG,Y,FILENO
  1.  I SDCLNIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q
  1.  I '$D(^SC(SDCLNIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
  1.  S CANCELDATE=$P(FMSDTTM,".")
  1.  S FRTIME=$P(FMSDTTM,".",2),TOTIME=$P(FMEDTTM,".",2)
  1.  ; DISPINCPERHR - display increments per hour
  1.  S DISPINCPERHR=$$GET1^DIQ(44,SDCLNIEN,1917,"I")
  1.  ; SINC - DISPLAY INCREMENTS PER HOUR
  1.  S SINC=$S(DISPINCPERHR="":4,DISPINCPERHR<3:4,DISPINCPERHR:DISPINCPERHR,1:4)
  1.  ; HRCLNDISPBEG - hour clinic display begins
  1.  S HRCLNDISPBEG=$$GET1^DIQ(44,SDCLNIEN,1914,"I")
  1.  I HRCLNDISPBEG="" S HRCLNDISPBEG=8
  1.  S STARTOFDAY=$S($L(HRCLNDISPBEG):HRCLNDISPBEG,1:8)
  1.  ; Clinic inactive
  1.  S INACTIVATEDT=$$GET1^DIQ(44,SDCLNIEN,2505,"I")
  1.  S INACTIVATEDTEXT=$TR($$FMTE^XLFDT(INACTIVATEDT,"5DF")," ","0")
  1.  S REACTIVATEDT=$$GET1^DIQ(44,SDCLNIEN,2506,"I")
  1.  S REACTIVATEDTEXT=$TR($$FMTE^XLFDT(REACTIVATEDT,"5DF")," ","0")
  1.  I REACTIVATEDT D
  1.  .S REACTIVATEMSG=$S(REACTIVATEDT:" to "_REACTIVATEDTEXT,1:"")
  1.  I INACTIVATEDT D
  1.  .; if inactivate date is after than the cancel request date, quit
  1.  .I INACTIVATEDT>$P(CANCELDATE,".") Q
  1.  .; if there is a reactivation date and the reactivation date before the cancel date, quit
  1.  .I REACTIVATEDT,REACTIVATEDT<$P(CANCELDATE,".") Q
  1.  .D ERRLOG^SDESJSON(.ERRORS,52,"Clinic is inactive "_$S('REACTIVATEDT:"as of ",1:"from ")_INACTIVATEDTEXT_$G(REACTIVATEMSG))
  1.  Q:$D(ERRORS)
  1.  ;
  1.  ; if the pattern does not exist for this date, create it from the template
  1.  ; otherwise the user will be incorrectly told that the clinic does not meet on this day
  1.  I '$D(^SC(SDCLNIEN,"ST",CANCELDATE,1)) D
  1.  .S X=CANCELDATE
  1.  .D DOW^SDM0 S DOW=Y
  1.  .S MASTERPATTERN=+$O(^SC(SDCLNIEN,"T"_DOW,CANCELDATE))
  1.  .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:"")
  1.  .S MPATTERNSLOTS=$$GET1^DIQ(FILENO,MASTERPATTERN_","_SDCLNIEN_",",1)
  1.  ;.S FDA(44.005,"+1,"_SDCLNIEN_",",.01)=CANCELDATE
  1.  ;.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
  1.  ;.S FDAIEN(1)=CANCELDATE
  1.  ;.D UPDATE^DIE(,"FDA","FDAIEN","FERR") K FDA,FDAIEN
  1.  S DAYSCHED=$$GET1^DIQ(44.005,CANCELDATE_","_SDCLNIEN_",",1,"I")
  1.  I DAYSCHED["CANCELLED" D ERRLOG^SDESJSON(.ERRORS,248) Q
  1.  ; Clinic does not meet on that day
  1.  I DAYSCHED'["[" D ERRLOG^SDESJSON(.ERRORS,249) Q
  1.  ; future consideration - should we inform the user whether or not appointments were scheduled?
  1.  ;I $O(^SC(SDCLNIEN,"S",CANCELDATE))\1-CANCELDATE D ERRLOG^SDESJSON(.ERRORS,52,"NO APPOINTMENTS SCHEDULED") Q
  1.  ;I $O(^SC(SC,"S",SD))\1-SD W *7,!?5,"NO APPOINTMENTS SCHEDULED" S NOAP=1 G W
  1.  ;
  1.  ; Loss of workload credit
  1.  I SDFULLPART="P",$$COED^SDESCCAVAIL2(SDCLNIEN,FMSDTTM,FMEDTTM,1) D ERRLOG^SDESJSON(.ERRORS,247) Q
  1.  I SDFULLPART="F",$$COED^SDESCCAVAIL2(SDCLNIEN,$P(FMSDTTM,"."),$P(FMSDTTM,".")_.2359,1) D ERRLOG^SDESJSON(.ERRORS,247) Q
  1.  ;
  1.  N CANARY,OVERLAP,PCANDTTM,PCANCNT,PCANLOOP,FDAYSTRT
  1.  D CHKPARTIALCAN(.CANARY,SDCLNIEN,CANCELDATE)
  1.  I SDFULLPART="F" D  Q
  1.  .S PCANCNT=0
  1.  .S CANSTARTTIME=$$TC^SDESCCAVAIL2($P(FMSDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SINC)
  1.  .S ST=$P(CANSTARTTIME,U,3)
  1.  .S FR=$P(CANSTARTTIME,U,2)
  1.  .I FR<0 D ERRLOG^SDESJSON(.ERRORS,52,$P(CANSTARTTIME,U,4))
  1.  .I '$D(CANARY) Q
  1.  .S PCANCNT=$O(ERRORS("Error",""),-1)+1
  1.  .S ERRORS("Error",PCANCNT)=$G(CANARY("HDR"))
  1.  .S PCANDTTM=0 F  S PCANDTTM=$O(CANARY(PCANDTTM)) Q:'PCANDTTM  D
  1.  ..S PCANCNT=$G(PCANCNT)+1
  1.  ..S ERRORS("Error",PCANCNT)=$G(CANARY(PCANDTTM,"MSG"))
  1.  .S PCANCNT=$G(PCANCNT)+1
  1.  .S ERRORS("Error",PCANCNT)="Full day cancellation cannot be used. Do you want to cancel another portion of the day?"
  1.  S CANSTARTTIME=$$TC^SDESCCAVAIL2($P(FMSDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SINC)
  1.  S ST=$P(CANSTARTTIME,U,3)
  1.  S FR=$P(CANSTARTTIME,U,2)
  1.  I FR<0 D ERRLOG^SDESJSON(.ERRORS,52,$P(CANSTARTTIME,U,4))
  1.  S CANENDTIME=$$TC^SDESCCAVAIL2($P(FMEDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SINC)
  1.  S TO=$P(CANENDTIME,U,2)
  1.  I TO<0 D ERRLOG^SDESJSON(.ERRORS,52,$P(CANENDTIME,U,4))
  1.  Q:$D(ERRORS)
  1.  S OVERLAP=$$CHKOVERLAP^SDESCCAVAIL2(.CANARY,FR,TO)
  1.  I OVERLAP D
  1.  .D ERRLOG^SDESJSON(.ERRORS,250)
  1.  .S PCANCNT=$O(ERRORS("Error",""),-1)+1
  1.  .Q:'$D(CANARY)
  1.  .S PCANCNT=PCANCNT+1
  1.  .S ERRORS("Error",PCANCNT)=$G(CANARY("HDR"))
  1.  .S PCANLOOP=0 F  S PCANLOOP=$O(CANARY(PCANLOOP)) Q:'PCANLOOP  D
  1.  ..S PCANCNT=PCANCNT+1
  1.  ..S ERRORS("Error",PCANCNT)=$G(CANARY(PCANLOOP,"MSG"))
  1.  Q
  1. CHKPARTIALCAN(CANARY,SDCLNIEN,CANDATE) ;
  1.  N CHKDT,BEGCANDTTM,ENDCANDTTM,CANMSG,CANDTLOOP,X,MSG,APPTDT,SDCTO
  1.  ; if the cancellation nodes exist, use them to build the current cancellations (from SDC2+3)
  1.  I $D(^SC(SDCLNIEN,"SDCAN")),$P($O(^SC(SDCLNIEN,"SDCAN",CANDATE)),".")=CANDATE D  Q
  1.  .S CHKDT=CANDATE
  1.  .F  S CHKDT=$O(^SC(SDCLNIEN,"SDCAN",CHKDT)) Q:'CHKDT!($P(CHKDT,".")>CANDATE)  D
  1.  ..S BEGCANDTTM=$$GET1^DIQ(44.05,CHKDT_","_SDCLNIEN_",",.01,"I")
  1.  ..S ENDCANDTTM=$$GET1^DIQ(44.05,CHKDT_","_SDCLNIEN_",",1,"I")
  1.  ..S CANMSG=$$GET1^DIQ(44.001,CHKDT_","_SDCLNIEN_",",1400,"E")
  1.  ..S CANARY(CHKDT)=$P(BEGCANDTTM,".")_ENDCANDTTM/10000_$S($L(CANMSG):"   ("_$P(CANMSG,"(",2),1:"")
  1.  .S CANARY("HDR")="Clinic already has the following cancellation(s) for that date: "
  1.  .S CANDTLOOP=0
  1.  .F  S CANDTLOOP=$O(CANARY(CANDTLOOP)) Q:'CANDTLOOP  D
  1.  ..S X=CANDTLOOP
  1.  ..D TMCHK(.X)
  1.  ..S CANARY(CANDTLOOP,"MSG")="From: "_X_"   To: "
  1.  ..S X=+(CANARY(CANDTLOOP))
  1.  ..D TMCHK(.X)
  1.  ..S CANARY(CANDTLOOP,"MSG")=CANARY(CANDTLOOP,"MSG")_X
  1.  ..S CANARY(CANDTLOOP,"MSG")=CANARY(CANDTLOOP,"MSG")_$S($P(CANARY(CANDTLOOP),"(",2)]"":"  ("_$P(CANARY(CANDTLOOP),"(",2),1:"")
  1.  Q
  1. TMCHK(X) ;
  1.  N %
  1.  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"
  1.  Q
  1.  ;
  1. CANCLNAVA(SDCLNIEN,SDFULLPART,FMSDTTM,FMEDTTM,SI,STARTOFDAY,CANREMARKS,DH,CANAPPTS) ;
  1.  N SDATA,SDCNHDL ; for evt dvr
  1.  N CANDTTMBEGIN,CANENDTIME,CANENDDTTM,BLOCKLEN,CANCELDATE,NEWIEN,CANMES,CURAVAIL,CANSTARTTIME,Y,NEWAPPTDTTM,SDXX
  1.  S CANDTTMBEGIN=FMSDTTM
  1.  S CANSTARTTIME=$$TC^SDESCCAVAIL2($P(FMSDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SI)
  1.  S ST=$P(CANSTARTTIME,U,3)
  1.  S CANSTARTTIME=$P(CANSTARTTIME,U)
  1.  S CANENDTIME=$$TC^SDESCCAVAIL2($P(FMEDTTM,".",2),$P(FMSDTTM,"."),STARTOFDAY,SI)
  1.  S CANDTTMEND=$P(CANENDTIME,U,2)
  1.  S SDXX=$P(CANENDTIME,U,3)
  1.  S CANENDTIME=$P(CANENDTIME,U)
  1.  S CANCELDATE=$P(FMSDTTM,".")
  1.  ;
  1.  I SDFULLPART="P" D PARTCAN(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANENDTIME,ST,SDXX,.DH,SI,.CANAPPTS)
  1.  I SDFULLPART="F" D FULLCAN(SDCLNIEN,CANDTTMBEGIN,CANREMARKS,.DH,.CANAPPTS)
  1.  Q
  1. PARTCAN(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANENDTIME,ST,SDXX,DH,SI,CANAPPTS) ;
  1.  N FDA,NEWIEN,NEWDTTMIEN,CANMES,CURAVAIL,Y,BLOCKLEN,X,CANCELDATE,P,NOAP
  1.  S BLOCKLEN=CANDTTMEND-CANDTTMBEGIN
  1.  S CANCELDATE=$P(CANDTTMBEGIN,".")
  1.  S FDA(44.05,"+1,"_SDCLNIEN_",",.01)=CANDTTMBEGIN
  1.  S FDA(44.05,"+1,"_SDCLNIEN_",",1)=CANENDTIME
  1.  S NEWIEN(1)=CANDTTMBEGIN
  1.  D UPDATE^DIE(,"FDA","NEWIEN") K FDA,NEWIEN
  1.  ; NOAP seems to be set, but never used.
  1.  S NOAP=$S($O(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001)))'>0:1,$O(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001)))>CANDTTMEND:1,1:0)
  1.  I 'NOAP S NOAP=$S($O(^SC(SDCLNIEN,"S",+$O(^SC(SDCLNIEN,"S",(CANDTTMBEGIN-.0001))),0))="MES":1,1:0)
  1.  I $D(^SC(SDCLNIEN,"S",CANDTTMBEGIN,0)) D
  1.  .S FDA(44.001,CANDTTMBEGIN_","_SDCLNIEN_",",.01)=CANDTTMBEGIN
  1.  .D FILE^DIE(,"FDA") K FDA
  1.  I '$D(^SC(SDCLNIEN,"S",CANDTTMBEGIN,0)) D
  1.  .S FDA(44.001,"+1,"_SDCLNIEN_",",.01)=CANDTTMBEGIN
  1.  .S CANMES="CANCELLED UNTIL "_CANENDTIME_$S(CANREMARKS?.P:"",1:" ("_CANREMARKS_")")
  1.  .S FDA(44.001,"+1,"_SDCLNIEN_",",1400)=CANMES
  1.  .S NEWDTTMIEN(1)=CANDTTMBEGIN
  1.  .D UPDATE^DIE(,"FDA","NEWDTTMIEN") K FDA,NEWDTTMIEN
  1.  ; 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
  1.  ; S ^SC(SC,"ST",SD,"CAN")=^SC(SC,"ST",SD,1)
  1.  S ^SC(SDCLNIEN,"ST",CANCELDATE,"CAN")=$G(^SC(SDCLNIEN,"ST",CANCELDATE,1))
  1.  S CURAVAIL=$$GET1^DIQ(44.005,CANCELDATE_","_SDCLNIEN_",",1,"E")
  1.  S CURAVAIL=CURAVAIL_$J("",SDXX-$L(CURAVAIL))
  1.  S Y=""
  1.  I $G(BLOCKLEN)<100,$L(CURAVAIL)<77 S CURAVAIL=CURAVAIL_"    " ; pad 4 empty spaces needed for blocks < 60 minutes
  1.  F X=0:2:SDXX D
  1.  .S DH=$E(CURAVAIL,X+SI+SI)
  1.  .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")
  1.  .S Y=$S(DH="]":"",DH="[":DH,1:Y)
  1.  .S CURAVAIL=$E(CURAVAIL,1,X-1+SI+SI)_P_$E(CURAVAIL,X+2+SI+SI,999)
  1.  S:'$F(CURAVAIL,"[") I5=$F(CURAVAIL,"X"),CURAVAIL=$E(CURAVAIL,1,(I5-2))_"["_$E(CURAVAIL,I5,999)
  1.  K I5
  1.  S DH=0
  1.  ; file updated clinic availability
  1.  S FDA(44.005,CANCELDATE_","_SDCLNIEN_",",1)=CURAVAIL
  1.  D FILE^DIE(,"FDA") K FDA
  1.  D EN^SDTMPHLC(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,"P",CANREMARKS)
  1.  D CANCELAPPTS(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANREMARKS,.DH,.CANAPPTS)
  1.  Q
  1. FULLCAN(SDCLNIEN,CANDTTMBEGIN,CANREMARKS,DH,CANAPPTS) ;
  1.  N FR,TO,SD,CURAVAIL,FDA,DH
  1.  S DH=0
  1.  S SD=$P(CANDTTMBEGIN,".")
  1.  S ^SC(SDCLNIEN,"ST",SD,"CAN")=$G(^SC(SDCLNIEN,"ST",SD,1))
  1.  S CURAVAIL="   "_$E(SD,6,7)_"    **CANCELLED**"
  1.  S FDA(44.005,SD_","_SDCLNIEN_",",1)=CURAVAIL
  1.  D FILE^DIE(,"FDA") K FDA
  1.  S FR=$P(CANDTTMBEGIN,"."),TO=$P(CANDTTMBEGIN,".")+.9
  1.  D EN^SDTMPHLC(SDCLNIEN,SD,,"C","**CANCELLED**")
  1.  D CANCELAPPTS(SDCLNIEN,FR,TO,CANREMARKS,.DH,.CANAPPTS)
  1.  Q
  1.  ;
  1. CANCELAPPTS(SDCLNIEN,CANDTTMBEGIN,CANDTTMEND,CANREMARKS,DH,CANAPPTS) ;
  1.  ;Cancel any appointments that are within the timeframe.
  1.  N TDH,TMPD,DIE,DR,NODE,SDI
  1.  N CANDTLOOP,APPTIEN,IENS,J,J2,DFN,SDCNHDL,SDATA,SDTIME,SDSC,SDTTM,SDPL,TDH,TMPD,APPTSTAT,FDA
  1.  N CANCELREASONIEN,CANBY,CAPPTCNT,CAPPTIEN
  1.  S SDTIME=$$NOW^XLFDT
  1.  S CANCELREASONIEN=$$FIND1^DIC(409.2,,"B","CLINIC CANCELLED")
  1.  S CANBY="C",CAPPTCNT=0
  1.  S CANDTLOOP=CANDTTMBEGIN-.0001
  1.  F  S CANDTLOOP=$O(^SC(SDCLNIEN,"S",CANDTLOOP)) Q:'CANDTLOOP!(CANDTLOOP>CANDTTMEND)  D
  1.  .S APPTIEN=0 F  S APPTIEN=$O(^SC(SDCLNIEN,"S",CANDTLOOP,1,APPTIEN)) Q:'APPTIEN  D
  1.  ..S IENS=APPTIEN_","_CANDTLOOP_","_SDCLNIEN_","
  1.  ..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
  1.  ..S DFN=$$GET1^DIQ(44.003,IENS,.01,"I")
  1.  ..I 'DFN S J=CANDTLOOP,J2=APPTIEN D DELETE^SDC1 K J,J2 Q  ;if DFN is missing delete record
  1.  ..; do not process if already cancelled
  1.  ..Q:$$GET1^DIQ(44.003,IENS,310,"I")="C"
  1.  ..S SDCNHDL=$$HANDLE^SDAMEVT(1)
  1.  ..D BEFORE^SDAMEVT(.SDATA,DFN,CANDTLOOP,SDCLNIEN,APPTIEN,SDCNHDL)
  1.  ..I $$GET1^DIQ(2.98,CANDTLOOP_","_DFN_",",.01,"I")'=SDCLNIEN Q
  1.  ..S SDSC=SDCLNIEN,SDTTM=CANDTLOOP,SDPL=APPTIEN,TDH=DH,TMPD=CANREMARKS
  1.  ..D CANCEL^SDCNSLT
  1.  ..S DH=TDH
  1.  ..S APPTSTAT=$$GET1^DIQ(2.98,CANDTLOOP_","_DFN_",",.02,"I")
  1.  ..; quit if cancelled
  1.  ..I $D(^DPT(DFN,"S",CANDTLOOP,0)),APPTSTAT["C" Q
  1.  ..S FDA(2.98,CANDTLOOP_","_DFN_",",3)="C"
  1.  ..S FDA(2.98,CANDTLOOP_","_DFN_",",14)=DUZ
  1.  ..S FDA(2.98,CANDTLOOP_","_DFN_",",15)=SDTIME
  1.  ..S FDA(2.98,CANDTLOOP_","_DFN_",",17)=CANREMARKS
  1.  ..D FILE^DIE(,"FDA") K FDA
  1.  ..; clinic cancellation must be filed AFTER the patient cancellation or the ASDCN index will not fire (^SDCAN)
  1.  ..S FDA(44.003,IENS,310)="C"
  1.  ..D FILE^DIE(,"FDA") K FDA
  1.  ..S DH=DH+1,TDH=DH,DH=TDH
  1.  ..D PXRAYRSLTS(SDCLNIEN,CANDTLOOP,DFN,APPTIEN,.DH,SDCNHDL)
  1.  ..S CAPPTIEN=$$APPTGET^SDECUTL(DFN,CANDTLOOP,SDCLNIEN)
  1.  ..D SDEC^SDCNP0(DFN,CANDTLOOP,SDCLNIEN,"C","",$G(CANREMARKS),SDTIME,DUZ)   ;alb/sat 627
  1.  ..; quit if the appointment did not get cancelled
  1.  ..I $$GET1^DIQ(409.84,CAPPTIEN,.17,"I")'="C" Q
  1.  ..S CAPPTCNT=CAPPTCNT+1
  1.  ..S CANAPPTS("CancelledAppointment",CAPPTCNT,"AppointmentID")=CAPPTIEN
  1.  ..; future - consider removing EVT tag and moving CANCEL^SDAMEVT into this loop
  1.  ..;D CANCEL^SDAMEVT(.SDATA,DFN,CANDTLOOP,SDCLNIEN,APPTIEN,0,SDCNHDL) K SDATA,SDCNHDL
  1.  Q
  1.  ; prior X-RAY results to clinic/record tracking
  1. 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
  1.  N SDV1,SDIV,SDH,SDTTM,SDSC,SDPL,SDRT,CHKDIV
  1.  ; direct global set on this index - cannot be replaced with a file manager call
  1.  I $D(^SC("ARAD",SDCLNIEN,CANDTTM,DFN)) S ^SC("ARAD",SDCLNIEN,CANDTTM,DFN)="N"
  1.  S CHKDIV=$$GET1^DIQ(44,SDCLNIEN,3.5,"I")
  1.  S SDIV=$S(CHKDIV]"":CHKDIV,1:" 1")
  1.  S SDV1=$S(SDIV:SDIV,1:+$O(^DG(40.8,0)))
  1.  ; no index for the following line to properly kill it with fileman
  1.  I $D(^DPT("ASDPSD","C",SDIV,SDCLNIEN,CANDTTM,DFN)) K ^DPT("ASDPSD","C",SDIV,SDCLNIEN,CANDTTM,DFN)
  1.  ; the following cancels record request from record tracking
  1.  S SDH=DH,SDTTM=CANDTTM,SDSC=SDCLNIEN,SDPL=APPTIEN,SDRT="D" D RT^SDUTL
  1.  S DH=SDH K SDH
  1.  D CK1^SDESCCAVAIL2(CANDTTM,DFN,SDIV)
  1.  D EVT^SDESCCAVAIL2(DFN,SDTTM,SDSC,SDPL,SDCNHDL)
  1.  K SD1,SDIV,SDPL,SDRT,SDSC,SDTTM,SDX
  1.  Q