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

SDES2CANCLNAVAIL.m

Go to the documentation of this file. 
  1. SDES2CANCLNAVAIL ;ALB/BLB,BLB,TJB,BLB,JAS,BLB,BWF - SDES2 CANCEL CLINIC AVAILABILITY ; JULY 1, 2024
  1.  ;;5.3;Scheduling;**869,873,875,880,886,893,898**;Aug 13, 1993;Build 5
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ;
  1. CANCEL(JSON,SDCONTEXT,CANCEL) ;
  1.  N ERRORS,RETURN
  1.  ;
  1.  D VALIDATE(.ERRORS,.SDCONTEXT,.CANCEL,$G(CANCEL("CLINIC IEN")),$G(CANCEL("FULL PARTIAL FLAG")),$G(CANCEL("REMARKS")))
  1.  I $D(ERRORS) S ERRORS("CancelClinicAvailability",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
  1.  ;
  1.  D CANCELAPPTS(CANCEL("CLINIC IEN"),CANCEL("START DATE TIME"),CANCEL("END DATE TIME"),CANCEL("FULL PARTIAL FLAG"),$G(CANCEL("REMARKS")),.SDCONTEXT,.RETURN)
  1.  D CANCELAVAIL(CANCEL("CLINIC IEN"),CANCEL("START DATE TIME"),CANCEL("END DATE TIME"),CANCEL("FULL PARTIAL FLAG"),$G(CANCEL("REMARKS")))
  1.  ;
  1.  S RETURN("CancelClinicAvailability",1)="Clinic availability has been successfully cancelled."
  1.  D BUILDJSON^SDES2JSON(.JSON,.RETURN)
  1.  Q
  1.  ;
  1. CANCELAVAIL(CLINICIEN,STARTDATETIME,ENDDATETIME,FLAG,CANCELREMARKS) ;
  1.  N PARTIALCANCELIEN,PARTIALCANCELFDA,CANCELDATE,DATE,ADDAPPTNODEFDA,CANCELMESSAGEFDA,NEWAPPTDATE,NEWSCHEDULEFDA,DATEINC,FULLDAYCANCELFDA,FULLDAYCANCELIEN
  1.  N HRCLNDISPBEG,STARTOFDAY,INCREMENT,CANENDTIME,CANSTARTTIME,ST,SDXX,BLOCKLEN,CANDTTMEND,DH,DISPINCPERHR,I5,P,PARTIALCANAVAIL,X,Y
  1.  ;
  1.  S HRCLNDISPBEG=$$GET1^DIQ(44,CLINICIEN,1914,"I")
  1.  I HRCLNDISPBEG="" S HRCLNDISPBEG=8
  1.  S STARTOFDAY=$S($L(HRCLNDISPBEG):HRCLNDISPBEG,1:8)
  1.  S DISPINCPERHR=$$GET1^DIQ(44,CLINICIEN,1917,"I")
  1.  S INCREMENT=$S(DISPINCPERHR="":4,DISPINCPERHR<3:4,DISPINCPERHR:DISPINCPERHR,1:4)
  1.  S CANENDTIME=$$TC($P(ENDDATETIME,".",2),$P(STARTDATETIME,"."),STARTOFDAY,INCREMENT)
  1.  S CANSTARTTIME=$$TC($P(STARTDATETIME,".",2),$P(STARTDATETIME,"."),STARTOFDAY,INCREMENT)
  1.  S ST=$P(CANSTARTTIME,U,3)
  1.  S CANDTTMEND=$P(CANENDTIME,U,2)
  1.  S SDXX=$P(CANENDTIME,U,3)
  1.  S CANCELDATE=$P(STARTDATETIME,".")
  1.  ;
  1.  I FLAG="F" D
  1.  .S FULLDAYCANCELFDA(44.1902,"+1,"_CLINICIEN_",",.01)=CANCELDATE
  1.  .S FULLDAYCANCELFDA(44.1902,"+1,"_CLINICIEN_",",.02)=CANCELREMARKS
  1.  .S FULLDAYCANCELIEN(1)=CANCELDATE
  1.  .D UPDATE^DIE(,"FULLDAYCANCELFDA","FULLDAYCANCELIEN") K FULLDAYCANCELFDA
  1.  ;
  1.  I FLAG="P" D
  1.  .S PARTIALCANCELFDA(44.05,"+1,"_CLINICIEN_",",.01)=STARTDATETIME
  1.  .S PARTIALCANCELFDA(44.05,"+1,"_CLINICIEN_",",1)=$P(CANENDTIME,"^")
  1.  .S PARTIALCANCELIEN(1)=STARTDATETIME
  1.  .D UPDATE^DIE(,"PARTIALCANCELFDA","PARTIALCANCELIEN") K PARTIALCANCELFDA
  1.  .
  1.  .I $D(^SC(CLINICIEN,"S",STARTDATETIME,0)) D
  1.  ..S ADDAPPTNODEFDA(44.001,STARTDATETIME_","_CLINICIEN_",",.01)=STARTDATETIME
  1.  ..S ADDAPPTNODEFDA(44.001,STARTDATETIME_","_CLINICIEN_",",1400)=CANCELREMARKS
  1.  ..D FILE^DIE(,"ADDAPPTNODEFDA") K ADDAPPTNODEFDA
  1.  .;
  1.  .I '$D(^SC(CLINICIEN,"S",STARTDATETIME,0)) D
  1.  ..S CANCELMESSAGEFDA(44.001,"+1,"_CLINICIEN_",",.01)=STARTDATETIME
  1.  ..S CANCELMESSAGEFDA(44.001,"+1,"_CLINICIEN_",",1400)=CANCELREMARKS
  1.  ..S NEWAPPTDATE(1)=STARTDATETIME
  1.  ..D UPDATE^DIE(,"CANCELMESSAGEFDA","NEWAPPTDATE") K CANCELMESSAGEFDA
  1.  .;
  1.  .S PARTIALCANAVAIL=$$GET1^DIQ(44.005,$P(STARTDATETIME,".")_","_CLINICIEN_",",1,"E")
  1.  .S PARTIALCANAVAIL=PARTIALCANAVAIL_$J("",SDXX-$L(PARTIALCANAVAIL))
  1.  .S Y=""
  1.  .S BLOCKLEN=CANDTTMEND-STARTDATETIME
  1.  .I $G(BLOCKLEN)<100,$L(PARTIALCANAVAIL)<77 S PARTIALCANAVAIL=PARTIALCANAVAIL_"    " ; pad 4 empty spaces needed for blocks < 60 minutes
  1.  .F X=0:2:SDXX D
  1.  ..S DH=$E(PARTIALCANAVAIL,X+INCREMENT+INCREMENT)
  1.  ..S P=$S(X<ST:DH_$E(PARTIALCANAVAIL,X+1+INCREMENT+INCREMENT),X=SDXX:$S(Y="[":Y,1:DH)_$E(PARTIALCANAVAIL,X+1+INCREMENT+INCREMENT),1:$S(Y="["&(X=ST):"]",1:"X")_"X")
  1.  ..S Y=$S(DH="]":"",DH="[":DH,1:Y)
  1.  ..S PARTIALCANAVAIL=$E(PARTIALCANAVAIL,1,X-1+INCREMENT+INCREMENT)_P_$E(PARTIALCANAVAIL,X+2+INCREMENT+INCREMENT,999)
  1.  .S:'$F(PARTIALCANAVAIL,"[") I5=$F(PARTIALCANAVAIL,"X"),PARTIALCANAVAIL=$E(PARTIALCANAVAIL,1,(I5-2))_"["_$E(PARTIALCANAVAIL,I5,999)
  1.  ;
  1.  ;
  1.  F DATEINC=0:1 S DATE=$$FMADD^XLFDT($P(STARTDATETIME,"."),DATEINC)  Q:'DATE!(DATE>$P(ENDDATETIME,"."))  D
  1.  .S ^SC(CLINICIEN,"ST",$P(DATE,"."),"CAN")=$G(^SC(CLINICIEN,"ST",$P(DATE,"."),1))
  1.  .S NEWSCHEDULEFDA(44.005,DATE_","_CLINICIEN_",",1)=$S(FLAG="P":PARTIALCANAVAIL,1:"   "_$E($P(DATE,"."),6,7)_"    **CANCELLED**")
  1.  .D FILE^DIE(,"NEWSCHEDULEFDA") K NEWSCHEDULEFDA
  1.  Q
  1.  ;
  1. CANCELAPPTS(CLINICIEN,STARTDATETIME,ENDDATETIME,FLAG,CANCELREMARKS,SDCONTEXT,RETURN) ;
  1.  N CANCELAPPT,DATETIME,JSONCANCELRETURN,CANCELLED,RESOURCEIEN,APPTIEN,COUNT
  1.  ;
  1.  I ENDDATETIME'["." S ENDDATETIME=ENDDATETIME_.2359
  1.  S RESOURCEIEN=$$GETRESOURCE(CLINICIEN)
  1.  S COUNT=0
  1.  S DATETIME=STARTDATETIME-.0001
  1.  F  S DATETIME=$O(^SC(CLINICIEN,"S",DATETIME)) Q:'DATETIME!(DATETIME>=ENDDATETIME)  D
  1.  .S APPTIEN=0
  1.  .F  S APPTIEN=$O(^SDEC(409.84,"ARSRC",RESOURCEIEN,DATETIME,APPTIEN)) Q:'APPTIEN  D
  1.  ..I $$GET1^DIQ(409.84,APPTIEN,.12,"I") Q
  1.  ..;
  1.  ..S COUNT=COUNT+1
  1.  ..S CANCELAPPT("APPT IEN")=APPTIEN
  1.  ..S CANCELAPPT("DFN")=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
  1.  ..S CANCELAPPT("CLINIC IEN")=CLINICIEN
  1.  ..S CANCELAPPT("CANCEL REASON")="CLINIC CANCELLED"
  1.  ..S CANCELAPPT("CANCELLED BY")="C"
  1.  ..D CANCELAPPT^SDES2CANCELAPPT(.JSONCANCELRETURN,.SDCONTEXT,.CANCELAPPT)
  1.  ..D DECODE^XLFJSON("JSONCANCELRETURN","CANCELLED")
  1.  ..S RETURN("CancelledAppointment",COUNT,"AppointmentID")=$G(CANCELLED("Appointment","Cancelled")) K CANCELLED
  1.  ..;
  1.  ..I FLAG="P" D
  1.  ...D EN^SDTMPHLC(CLINICIEN,STARTDATETIME,ENDDATETIME,"P",CANCELREMARKS)
  1.  ..I FLAG="F" D
  1.  ...D EN^SDTMPHLC(CLINICIEN,$P(STARTDATETIME,"."),,"C","**CANCELLED**")
  1.  Q
  1.  ;
  1. VALIDATE(ERRORS,SDCONTEXT,CANCEL,CLINICIEN,FLAG,REMARKS) ;
  1.  N VAL
  1.  D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
  1.  D VALFILEIEN^SDES2VALUTIL(.VAL,.ERRORS,44,CLINICIEN,1,,18,19)
  1.  ;
  1.  S CANCEL("START DATE TIME")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(CANCEL("START DATE TIME")),CLINICIEN,1,9,11)
  1.  S CANCEL("END DATE TIME")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(CANCEL("END DATE TIME")),CLINICIEN,1,10,12)
  1.  I $G(CANCEL("START DATE TIME"))>$G(CANCEL("END DATE TIME")) D ERRLOG^SDESJSON(.ERRORS,13)
  1.  ;
  1.  D VALIDATEFLAG(.ERRORS,FLAG,$G(CANCEL("START DATE TIME")),$G(CANCEL("END DATE TIME")))
  1.  I $L(REMARKS),$L(REMARKS)<3!($L(REMARKS)>160) D ERRLOG^SDESJSON(.ERRORS,255)
  1.  I $D(ERRORS) Q
  1.  ;
  1.  D VALCLINICDETAILS(.ERRORS,CLINICIEN,$G(CANCEL("START DATE TIME")),$G(CANCEL("END DATE TIME")),FLAG) ;
  1.  Q
  1.  ;
  1. VALCLINICDETAILS(ERRORS,CLINICIEN,STARTDATETIME,ENDDATETIME,FLAG) ;
  1.  N SCHEDULEDATE,CANCELDATETIME,CANCELSTART,CANCELEND,SUBIEN,APPTDATETIME,DATEINC
  1.  ;
  1.  I FLAG="P",$P(STARTDATETIME,".")'=$P(ENDDATETIME,".") D ERRLOG^SDESJSON(.ERRORS,576) Q
  1.  F DATEINC=0:1 S SCHEDULEDATE=$$FMADD^XLFDT($P(STARTDATETIME,"."),DATEINC)  Q:'SCHEDULEDATE!(SCHEDULEDATE>$P(ENDDATETIME,"."))!($D(ERRORS))  D
  1.  .I $$INACTIVE^SDESUTIL(CLINICIEN,SCHEDULEDATE) D ERRLOG^SDESJSON(.ERRORS,525) Q
  1.  .I $$GET1^DIQ(44.005,SCHEDULEDATE_","_CLINICIEN_",",1,"I")["CANCELLED" D ERRLOG^SDESJSON(.ERRORS,248) Q
  1.  .I $$GET1^DIQ(44.005,SCHEDULEDATE_","_CLINICIEN_",",1,"I")'["[" D ERRLOG^SDESJSON(.ERRORS,249) Q
  1.  .;
  1.  .S APPTDATETIME=STARTDATETIME-.0001
  1.  .F  S APPTDATETIME=$O(^SC(CLINICIEN,"S",APPTDATETIME)) Q:'APPTDATETIME!(APPTDATETIME>=ENDDATETIME)!($D(ERRORS))  D
  1.  ..S SUBIEN=0
  1.  ..F  S SUBIEN=$O(^SC(CLINICIEN,"S",APPTDATETIME,1,SUBIEN)) Q:'SUBIEN!($D(ERRORS))  D
  1.  ...I $$GET1^DIQ(44.003,SUBIEN_","_APPTDATETIME_","_CLINICIEN_",",310)="CANCELLED" Q
  1.  ...I $$GET1^DIQ(44.003,SUBIEN_","_APPTDATETIME_","_CLINICIEN_",",303,"I") D ERRLOG^SDESJSON(.ERRORS,247)
  1.  .;
  1.  .I FLAG="P",$D(^SC(CLINICIEN,"ST",$P(SCHEDULEDATE,"."),"CAN")) D
  1.  ..S CANCELDATETIME=$P(STARTDATETIME,".")
  1.  ..F  S CANCELDATETIME=$O(^SC(CLINICIEN,"SDCAN",CANCELDATETIME)) Q:'CANCELDATETIME!($P(CANCELDATETIME,".")>$P(STARTDATETIME,"."))!($D(ERRORS))  D
  1.  ...S CANCELSTART=$$GET1^DIQ(44.05,CANCELDATETIME_","_CLINICIEN_",",.01,"I")
  1.  ...S CANCELEND=$P(CANCELSTART,".")_"."_$P($$GET1^DIQ(44.05,CANCELDATETIME_","_CLINICIEN_",",1,"I"),".",1)*1
  1.  ...I STARTDATETIME>=CANCELEND!(ENDDATETIME<=CANCELSTART)!(CANCELSTART>=ENDDATETIME)!(CANCELEND<=STARTDATETIME) Q
  1.  ...D ERRLOG^SDESJSON(.ERRORS,250)
  1.  Q
  1.  ;
  1. VALIDATEFLAG(ERRORS,FLAG,STARTDATETIME,ENDDATETIME) ;
  1.  I '$L($G(FLAG)) D ERRLOG^SDESJSON(.ERRORS,245) Q
  1.  I $G(FLAG)'="F",$G(FLAG)'="P" D ERRLOG^SDESJSON(.ERRORS,246)
  1.  ;
  1.  I $G(FLAG)="F" D
  1.  .I STARTDATETIME["."!(ENDDATETIME[".") D ERRLOG^SDESJSON(.ERRORS,552) Q
  1.  I $G(FLAG)="P" D
  1.  .I STARTDATETIME'["."!(ENDDATETIME'[".") D ERRLOG^SDESJSON(.ERRORS,551)
  1.  Q
  1.  ;
  1. GETRESOURCE(CLINICIEN) ;
  1.  S RESOURCEIEN=0
  1.  F  S RESOURCEIEN=$O(^SDEC(409.831,"ALOC",CLINICIEN,RESOURCEIEN)) Q:'RESOURCEIEN!(RESOURCEIEN)  D
  1.  .I $$GET1^DIQ(409.831,RESOURCEIEN,.012,"E")="CLINIC" D
  1.  .S RESOURCEIEN=$O(^SDEC(409.831,"ALOC",CLINICIEN,RESOURCEIEN))
  1.  Q RESOURCEIEN
  1.  ;
  1. TC(TIME,SD,STARTOFDAY,SI) ;
  1.  N %DT,X,Y,SDXX,FTIME,MSG
  1.  ; fix times less than 4 characters
  1.  S FTIME=SD_"."_TIME
  1.  S FTIME=$P($$FMTE^XLFDT(FTIME,"T"),"@",2)
  1.  S FTIME=$TR(FTIME,":","")
  1.  S X=$$FMTE^XLFDT(SD)_"@"_FTIME,%DT="T"
  1.  D ^%DT
  1.  I Y<0!(X["?") Q ""
  1.  S X=$E($P(Y_"0000",".",2),1,4)
  1.  S SDXX=$E(X,3,4)
  1.  S SDXX=X\100-STARTOFDAY*SI+(SDXX*SI\60)*2
  1.  I SDXX<0 S MSG="Day Starts at "_STARTOFDAY,Y=-1
  1.  I SDXX>72 S MSG="Day Ends prior to provided end time "_X,Y=-1
  1.  Q X_U_Y_U_SDXX_U_$G(MSG)
  1.  ;