SDESCCAVAIL2 ;ALB/BWF - VISTA SCHEDULING RPCS CANCEL CLINIC AVAILABILITY UTILITIES ; August 30, 2022
;;5.3;Scheduling;**824**;Aug 13, 1993;Build 3
;;Per VHA Directive 6402, this routine should not be modified
;
;
Q ;No Direct Call
;
COED(SDCL,SDBEG,SDEND,SDMSG) ; -- scan appts for those co'ed
N SDDA,SDATE,SD0,SDC,SDESC
S SDESC=0,SDATE=SDBEG-.0000001
F S SDATE=$O(^SC(SDCL,"S",SDATE)) Q:'SDATE!(SDATE>SDEND) D
.S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDATE,1,SDDA)) Q:'SDDA D
..I $$GET1^DIQ(44.003,SDDA_","_SDATE_","_SDCL_",",310,"I")="C" Q
..I $$GET1^DIQ(44.003,SDDA_","_SDATE_","_SDCL_",",303,"I") S SDESC=1
Q SDESC
;
CHKOVERLAP(CANARY,FROM,TO) ;
N CHKDT,SDERR
S (CHKDT,SDERR)=0
F S CHKDT=$O(CANARY(CHKDT)) Q:'CHKDT!(SDERR) D
.S SDERR=$S(FROM'<CHKDT&(FROM<CANARY(CHKDT)):1,TO>CHKDT&(TO<CANARY(CHKDT)):1,1:0) Q:SDERR
.I CHKDT'<FROM&(CHKDT<TO) S SDERR=1 Q
I $G(SDERR) Q 1
Q 0
;
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)
;
CK1(CANDTTM,DFN,SDIV) ;
N SDX,SD1,CANDATE,CANDATELOOP,SDQUIT,STATUS,CANDATE
S SDQUIT=0
S (CANDATELOOP,CANDATE)=$P(CANDTTM,".")
F S CANDATELOOP=$O(^DPT(DFN,"S",CANDATELOOP)) Q:'CANDATELOOP!(CANDATELOOP'=CANDATE) D
.S STATUS=$$GET1^DIQ(2.98,CANDATELOOP_","_DFN_",",3,"I")
.I STATUS'["C",STATUS'["N" S SDQUIT=1
Q:SDQUIT
F SD1=2,4 I $D(^SC("AAS",CANDTTM,CANDATE,DFN)) S SDQUIT=1 Q:SDQUIT
I $D(^SCE(+$$EXAE^SDOE(DFN,CANDATE,CANDATE),0)) S SDQUIT=1 Q:SDQUIT
; future - try to locate index for the below line to properly kill it with fileman
K ^DPT("ASDPSD","B",SDIV,CANDATE,DFN)
Q
;
EVT(DFN,SDTTM,SDSC,SDPL,SDCNHDL) ; -- separate tag if need to NEW vars
; -- cancel event
N FR,I,SDTIME,DH,SC
D CANCEL^SDAMEVT(.SDATA,DFN,SDTTM,SDSC,SDPL,0,SDCNHDL) K SDATA,SDCNHDL
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCCAVAIL2 2227 printed Oct 16, 2024@18:56:27 Page 2
SDESCCAVAIL2 ;ALB/BWF - VISTA SCHEDULING RPCS CANCEL CLINIC AVAILABILITY UTILITIES ; August 30, 2022
+1 ;;5.3;Scheduling;**824**;Aug 13, 1993;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;
+5 ;No Direct Call
QUIT
+6 ;
COED(SDCL,SDBEG,SDEND,SDMSG) ; -- scan appts for those co'ed
+1 NEW SDDA,SDATE,SD0,SDC,SDESC
+2 SET SDESC=0
SET SDATE=SDBEG-.0000001
+3 FOR
SET SDATE=$ORDER(^SC(SDCL,"S",SDATE))
if 'SDATE!(SDATE>SDEND)
QUIT
Begin DoDot:1
+4 SET SDDA=0
FOR
SET SDDA=$ORDER(^SC(SDCL,"S",SDATE,1,SDDA))
if 'SDDA
QUIT
Begin DoDot:2
+5 IF $$GET1^DIQ(44.003,SDDA_","_SDATE_","_SDCL_",",310,"I")="C"
QUIT
+6 IF $$GET1^DIQ(44.003,SDDA_","_SDATE_","_SDCL_",",303,"I")
SET SDESC=1
End DoDot:2
End DoDot:1
+7 QUIT SDESC
+8 ;
CHKOVERLAP(CANARY,FROM,TO) ;
+1 NEW CHKDT,SDERR
+2 SET (CHKDT,SDERR)=0
+3 FOR
SET CHKDT=$ORDER(CANARY(CHKDT))
if 'CHKDT!(SDERR)
QUIT
Begin DoDot:1
+4 SET SDERR=$SELECT(FROM'<CHKDT&(FROM<CANARY(CHKDT)):1,TO>CHKDT&(TO<CANARY(CHKDT)):1,1:0)
if SDERR
QUIT
+5 IF CHKDT'<FROM&(CHKDT<TO)
SET SDERR=1
QUIT
End DoDot:1
+6 IF $GET(SDERR)
QUIT 1
+7 QUIT 0
+8 ;
TC(TIME,SD,STARTOFDAY,SI) ;
+1 NEW %DT,X,Y,SDXX,FTIME,MSG
+2 ; fix times less than 4 characters
+3 SET FTIME=SD_"."_TIME
+4 SET FTIME=$PIECE($$FMTE^XLFDT(FTIME,"T"),"@",2)
+5 SET FTIME=$TRANSLATE(FTIME,":","")
+6 SET X=$$FMTE^XLFDT(SD)_"@"_FTIME
SET %DT="T"
+7 DO ^%DT
+8 IF Y<0!(X["?")
QUIT ""
+9 SET X=$EXTRACT($PIECE(Y_"0000",".",2),1,4)
+10 SET SDXX=$EXTRACT(X,3,4)
+11 SET SDXX=X\100-STARTOFDAY*SI+(SDXX*SI\60)*2
+12 IF SDXX<0
SET MSG="Day Starts at "_STARTOFDAY
SET Y=-1
+13 IF SDXX>72
SET MSG="Day Ends prior to provided end time "_X
SET Y=-1
+14 QUIT X_U_Y_U_SDXX_U_$GET(MSG)
+15 ;
CK1(CANDTTM,DFN,SDIV) ;
+1 NEW SDX,SD1,CANDATE,CANDATELOOP,SDQUIT,STATUS,CANDATE
+2 SET SDQUIT=0
+3 SET (CANDATELOOP,CANDATE)=$PIECE(CANDTTM,".")
+4 FOR
SET CANDATELOOP=$ORDER(^DPT(DFN,"S",CANDATELOOP))
if 'CANDATELOOP!(CANDATELOOP'=CANDATE)
QUIT
Begin DoDot:1
+5 SET STATUS=$$GET1^DIQ(2.98,CANDATELOOP_","_DFN_",",3,"I")
+6 IF STATUS'["C"
IF STATUS'["N"
SET SDQUIT=1
End DoDot:1
+7 if SDQUIT
QUIT
+8 FOR SD1=2,4
IF $DATA(^SC("AAS",CANDTTM,CANDATE,DFN))
SET SDQUIT=1
if SDQUIT
QUIT
+9 IF $DATA(^SCE(+$$EXAE^SDOE(DFN,CANDATE,CANDATE),0))
SET SDQUIT=1
if SDQUIT
QUIT
+10 ; future - try to locate index for the below line to properly kill it with fileman
+11 KILL ^DPT("ASDPSD","B",SDIV,CANDATE,DFN)
+12 QUIT
+13 ;
EVT(DFN,SDTTM,SDSC,SDPL,SDCNHDL) ; -- separate tag if need to NEW vars
+1 ; -- cancel event
+2 NEW FR,I,SDTIME,DH,SC
+3 DO CANCEL^SDAMEVT(.SDATA,DFN,SDTTM,SDSC,SDPL,0,SDCNHDL)
KILL SDATA,SDCNHDL
+4 QUIT
+5 ;
