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