SDEC05 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
;
Q
;
;
APBLKOV(SDECY,SDECSTART,SDECEND,SDECRES,SDECWI) ;APPT BLOCKS OVERLAP
;APBLKOV(SDECY,SDECSTART,SDECEND,SDECRES,SDECWI) external parameter tag is in SDEC
;SDECRES is resource name
;SDECWI is for walk-in appointments. 1 - Include walkins, otherwise do not include them.
;
N SDECERR,SDECIEN,SDECDEP,SDECBS,SDECI,SDECNEND,SDECNSTART,SDECPEND,SDECRESD,SDECRESN,SDECS,SDECAD,SDECNOD,SDECPAT
N %DT,X,Y
K ^TMP("SDEC",$J)
S SDECERR=""
S SDECY="^TMP(""SDEC"","_$J_")",SDECI=0
S ^TMP("SDEC",$J,SDECI)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030APPTREQTYPE"_$C(30)
D
. S SDECBS=0
. ;
. ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
. ;
. ;S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@")
. ;S:SDECEND["@0000" SDECEND=$P(SDECEND,"@")
. ;S %DT="T",X=SDECSTART D ^%DT S SDECSTART=Y
. S SDECSTART=$$NETTOFM^SDECDATE(SDECSTART,"Y","N") ;
. I SDECSTART=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
. ;S %DT="T",X=SDECEND D ^%DT S SDECEND=Y
. S SDECEND=$$NETTOFM^SDECDATE(SDECEND,"Y","N") ;
. I SDECEND=-1 S ^TMP("SDEC",$J,1)=$C(31) Q
. I $L(SDECEND,".")=1 S SDECEND=SDECEND+.9999 ;Go to end of day
. S SDECRESN=SDECRES
. Q:SDECRESN=""
. Q:'$D(^SDEC(409.831,"B",SDECRESN))
. S SDECRESD=$O(^SDEC(409.831,"B",SDECRESN,0))
. Q:'+SDECRESD
. Q:'$D(^SDEC(409.84,"ARSRC",SDECRESD))
. D STRES(SDECRESD,SDECSTART,SDECEND,$G(SDECWI))
. Q
;
S ^TMP("SDEC",$J,$G(SDECI,0))=^TMP("SDEC",$J,$G(SDECI,0))_$C(31)
Q
;
APBLKALL(SDECY,SDECSTART,SDECEND) ;List of all appointments for all resources
;APBLKALL(SDECY,SDECSTART,SDECEND) external parameter tag is in SDEC
; Input: SDECSTART - Start Date
; SDECEND - End Date
;
N SDECDATA,SDECRIEN,SDECRESN,SDECI
S SDECRIEN=0 F S SDECRIEN=$O(^SDEC(409.831,SDECRIEN)) Q:'SDECRIEN D
.S SDECRESN=$$GET1^DIQ(409.831,SDECRIEN,.01,"E")
.Q:SDECRESN=""
.; Call existing API to gather appointments for each resource found
.K SDECDATA
.D APBLKOV^SDEC(.SDECDATA,$G(SDECSTART),$G(SDECEND),$G(SDECRESN),1) ;Call tag in ^SDEC
.D GATHER(SDECDATA,SDECRESN)
.K ^TMP("SDEC",$J)
M ^TMP("SDEC",$J)=^TMP("SDEC05",$J)
K ^TMP("SDEC05",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S ^TMP("SDEC",$J,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030RES_NAME^T00030APPTREQTYPE"_$C(30)
S SDECI=$O(^TMP("SDEC",$J,""),-1)
S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)
Q
;
GATHER(SDECDAT,SDECRESN) ;
; Called by APBLKBR to retrieve data gathered for each resource.
N X,SDECADAT,SDECI
S X=0 F S X=$O(@SDECDAT@(X)) Q:'X D
.S SDECADAT=$G(@SDECDAT@(X)) Q:SDECADAT=$C(31)
.S SDECI=$O(^TMP("SDEC05",$J,""),-1) S SDECI=$G(SDECI)+1
.S SDECADAT=$P(SDECADAT,$C(30),1)
.S ^TMP("SDEC05",$J,SDECI)=$P(SDECADAT,U,1,3)_U_SDECRESN_U_$P(SDECADAT,U,4)_$C(30)
Q
;
STRES(SDECRESD,SDECSTART,SDECEND,SDECWI) ;
;$O THRU "ARSRC" XREF OF ^SDEC(409.84,
;Start at the beginning of the day -- appts can't overlap days
S SDECS=$P(SDECSTART,"."),SDECS=SDECS-.0001
F S SDECS=$O(^SDEC(409.84,"ARSRC",SDECRESD,SDECS)) Q:'+SDECS Q:SDECS>SDECEND D
. S SDECAD=0 F S SDECAD=$O(^SDEC(409.84,"ARSRC",SDECRESD,SDECS,SDECAD)) Q:'+SDECAD D STCOMM(SDECAD,$G(SDECWI)) ;SDECAD Is the AppointmentID
. Q
Q
;
STCOMM(SDECAD,SDECWI) ;
N SDAPTYP
S SDECNEND=0,SDECNSTART=0,SDECPEND=0
Q:'$D(^SDEC(409.84,SDECAD,0))
S SDECNOD=^SDEC(409.84,SDECAD,0)
S SDECPAT=$P(SDECNOD,U,5)
Q:$P(SDECNOD,U,10)=1 ;NO-SHOW Flag
Q:$P(SDECNOD,U,12)]"" ;CANCELLED APPT
I '$G(SDECWI) Q:$P(SDECNOD,U,13)="y" ;WALKIN
S SDECNSTART=$P(SDECNOD,U)
S SDECNEND=$P(SDECNOD,U,2)
I SDECNEND'>SDECSTART Q ;End is less than start
;
; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
;
;S Y=SDECNSTART X ^DD("DD") S SDECNSTART=$TR(Y,"@"," ")
S SDECNSTART=$$FMTONET^SDECDATE(SDECNSTART,"Y") ;
;S Y=SDECNEND X ^DD("DD") S SDECNEND=$TR(Y,"@"," ")
S SDECNEND=$$FMTONET^SDECDATE(SDECNEND,"Y") ;
;appt request type
S SDAPTYP=$P($G(^SDEC(409.84,SDECAD,2)),U,1)
S:SDAPTYP'="" SDAPTYP=$S($P(SDAPTYP,";",2)["SDWL":"E",$P(SDAPTYP,";",2)["GMR":"C",$P(SDAPTYP,";",2)="SD(403.5,":"R",1:"")_"|"_$P(SDAPTYP,";",1)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECNSTART_U_SDECNEND_U_SDECPAT_U_SDAPTYP_$C(30)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC05 4396 printed Apr 09, 2024@22:01:39 Page 2
SDEC05 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
+2 ;
+3 QUIT
+4 ;
+5 ;
APBLKOV(SDECY,SDECSTART,SDECEND,SDECRES,SDECWI) ;APPT BLOCKS OVERLAP
+1 ;APBLKOV(SDECY,SDECSTART,SDECEND,SDECRES,SDECWI) external parameter tag is in SDEC
+2 ;SDECRES is resource name
+3 ;SDECWI is for walk-in appointments. 1 - Include walkins, otherwise do not include them.
+4 ;
+5 NEW SDECERR,SDECIEN,SDECDEP,SDECBS,SDECI,SDECNEND,SDECNSTART,SDECPEND,SDECRESD,SDECRESN,SDECS,SDECAD,SDECNOD,SDECPAT
+6 NEW %DT,X,Y
+7 KILL ^TMP("SDEC",$JOB)
+8 SET SDECERR=""
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
SET SDECI=0
+10 SET ^TMP("SDEC",$JOB,SDECI)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030APPTREQTYPE"_$CHAR(30)
+11 Begin DoDot:1
+12 SET SDECBS=0
+13 ;
+14 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+15 ;
+16 ;S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@")
+17 ;S:SDECEND["@0000" SDECEND=$P(SDECEND,"@")
+18 ;S %DT="T",X=SDECSTART D ^%DT S SDECSTART=Y
+19 ;
SET SDECSTART=$$NETTOFM^SDECDATE(SDECSTART,"Y","N")
+20 IF SDECSTART=-1
SET ^TMP("SDEC",$JOB,1)=$CHAR(31)
QUIT
+21 ;S %DT="T",X=SDECEND D ^%DT S SDECEND=Y
+22 ;
SET SDECEND=$$NETTOFM^SDECDATE(SDECEND,"Y","N")
+23 IF SDECEND=-1
SET ^TMP("SDEC",$JOB,1)=$CHAR(31)
QUIT
+24 ;Go to end of day
IF $LENGTH(SDECEND,".")=1
SET SDECEND=SDECEND+.9999
+25 SET SDECRESN=SDECRES
+26 if SDECRESN=""
QUIT
+27 if '$DATA(^SDEC(409.831,"B",SDECRESN))
QUIT
+28 SET SDECRESD=$ORDER(^SDEC(409.831,"B",SDECRESN,0))
+29 if '+SDECRESD
QUIT
+30 if '$DATA(^SDEC(409.84,"ARSRC",SDECRESD))
QUIT
+31 DO STRES(SDECRESD,SDECSTART,SDECEND,$GET(SDECWI))
+32 QUIT
End DoDot:1
+33 ;
+34 SET ^TMP("SDEC",$JOB,$GET(SDECI,0))=^TMP("SDEC",$JOB,$GET(SDECI,0))_$CHAR(31)
+35 QUIT
+36 ;
APBLKALL(SDECY,SDECSTART,SDECEND) ;List of all appointments for all resources
+1 ;APBLKALL(SDECY,SDECSTART,SDECEND) external parameter tag is in SDEC
+2 ; Input: SDECSTART - Start Date
+3 ; SDECEND - End Date
+4 ;
+5 NEW SDECDATA,SDECRIEN,SDECRESN,SDECI
+6 SET SDECRIEN=0
FOR
SET SDECRIEN=$ORDER(^SDEC(409.831,SDECRIEN))
if 'SDECRIEN
QUIT
Begin DoDot:1
+7 SET SDECRESN=$$GET1^DIQ(409.831,SDECRIEN,.01,"E")
+8 if SDECRESN=""
QUIT
+9 ; Call existing API to gather appointments for each resource found
+10 KILL SDECDATA
+11 ;Call tag in ^SDEC
DO APBLKOV^SDEC(.SDECDATA,$GET(SDECSTART),$GET(SDECEND),$GET(SDECRESN),1)
+12 DO GATHER(SDECDATA,SDECRESN)
+13 KILL ^TMP("SDEC",$JOB)
End DoDot:1
+14 MERGE ^TMP("SDEC",$JOB)=^TMP("SDEC05",$JOB)
+15 KILL ^TMP("SDEC05",$JOB)
+16 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+17 SET ^TMP("SDEC",$JOB,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030RES_NAME^T00030APPTREQTYPE"_$CHAR(30)
+18 SET SDECI=$ORDER(^TMP("SDEC",$JOB,""),-1)
+19 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_$CHAR(31)
+20 QUIT
+21 ;
GATHER(SDECDAT,SDECRESN) ;
+1 ; Called by APBLKBR to retrieve data gathered for each resource.
+2 NEW X,SDECADAT,SDECI
+3 SET X=0
FOR
SET X=$ORDER(@SDECDAT@(X))
if 'X
QUIT
Begin DoDot:1
+4 SET SDECADAT=$GET(@SDECDAT@(X))
if SDECADAT=$CHAR(31)
QUIT
+5 SET SDECI=$ORDER(^TMP("SDEC05",$JOB,""),-1)
SET SDECI=$GET(SDECI)+1
+6 SET SDECADAT=$PIECE(SDECADAT,$CHAR(30),1)
+7 SET ^TMP("SDEC05",$JOB,SDECI)=$PIECE(SDECADAT,U,1,3)_U_SDECRESN_U_$PIECE(SDECADAT,U,4)_$CHAR(30)
End DoDot:1
+8 QUIT
+9 ;
STRES(SDECRESD,SDECSTART,SDECEND,SDECWI) ;
+1 ;$O THRU "ARSRC" XREF OF ^SDEC(409.84,
+2 ;Start at the beginning of the day -- appts can't overlap days
+3 SET SDECS=$PIECE(SDECSTART,".")
SET SDECS=SDECS-.0001
+4 FOR
SET SDECS=$ORDER(^SDEC(409.84,"ARSRC",SDECRESD,SDECS))
if '+SDECS
QUIT
if SDECS>SDECEND
QUIT
Begin DoDot:1
+5 ;SDECAD Is the AppointmentID
SET SDECAD=0
FOR
SET SDECAD=$ORDER(^SDEC(409.84,"ARSRC",SDECRESD,SDECS,SDECAD))
if '+SDECAD
QUIT
DO STCOMM(SDECAD,$GET(SDECWI))
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
STCOMM(SDECAD,SDECWI) ;
+1 NEW SDAPTYP
+2 SET SDECNEND=0
SET SDECNSTART=0
SET SDECPEND=0
+3 if '$DATA(^SDEC(409.84,SDECAD,0))
QUIT
+4 SET SDECNOD=^SDEC(409.84,SDECAD,0)
+5 SET SDECPAT=$PIECE(SDECNOD,U,5)
+6 ;NO-SHOW Flag
if $PIECE(SDECNOD,U,10)=1
QUIT
+7 ;CANCELLED APPT
if $PIECE(SDECNOD,U,12)]""
QUIT
+8 ;WALKIN
IF '$GET(SDECWI)
if $PIECE(SDECNOD,U,13)="y"
QUIT
+9 SET SDECNSTART=$PIECE(SDECNOD,U)
+10 SET SDECNEND=$PIECE(SDECNOD,U,2)
+11 ;End is less than start
IF SDECNEND'>SDECSTART
QUIT
+12 ;
+13 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+14 ;
+15 ;S Y=SDECNSTART X ^DD("DD") S SDECNSTART=$TR(Y,"@"," ")
+16 ;
SET SDECNSTART=$$FMTONET^SDECDATE(SDECNSTART,"Y")
+17 ;S Y=SDECNEND X ^DD("DD") S SDECNEND=$TR(Y,"@"," ")
+18 ;
SET SDECNEND=$$FMTONET^SDECDATE(SDECNEND,"Y")
+19 ;appt request type
+20 SET SDAPTYP=$PIECE($GET(^SDEC(409.84,SDECAD,2)),U,1)
+21 if SDAPTYP'=""
SET SDAPTYP=$SELECT($PIECE(SDAPTYP,";",2)["SDWL":"E",$PIECE(SDAPTYP,";",2)["GMR":"C",$PIECE(SDAPTYP,";",2)="SD(403.5,":"R",1:"")_"|"_$PIECE(SDAPTYP,";",1)
+22 SET SDECI=SDECI+1
+23 SET ^TMP("SDEC",$JOB,SDECI)=SDECNSTART_U_SDECNEND_U_SDECPAT_U_SDAPTYP_$CHAR(30)
+24 QUIT
