BSDX05 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES,BSDXWI) ;EP
;Called by BSDX APPT BLOCKS OVERLAP
;(Duplicates old qryAppointmentBlocksOverlapB)
;BSDXRES is resource name
;BSDXWI is for walk-in appointments. 1 - Include walkins, otherwise do not include them.
;
;Test lines:
;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
;
N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD,BSDXPAT
K ^BSDXTMP($J)
S BSDXERR=""
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID"_$C(30)
D
. S BSDXBS=0
. S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
. S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
. S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
. I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
. S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
. I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
. I $L(BSDXEND,".")=1 S BSDXEND=BSDXEND+.9999 ;Go to end of day
. S BSDXRESN=BSDXRES
. Q:BSDXRESN=""
. Q:'$D(^BSDXRES("B",BSDXRESN))
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
. Q:'+BSDXRESD
. Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
. D STRES(BSDXRESD,BSDXSTART,BSDXEND,$G(BSDXWI))
. Q
;
S BSDXI=$G(BSDXI)+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
APBLKALL(BSDXY,BSDXSTART,BSDXEND) ;EP
; List of all appointments for all resources. - BWF/MSC, added 3-1-2010
; Called by BSDX ALL APPOINTMENTS
;
; Input: BSDXSTART - Start Date
; BSDXEND - End Date
;
;Test Lines:
;D APBLKALL^BSDX05(.RES,"11-8-2000","11-8-2004") ZW RES
;BSDX ALL APPOINTMENTS^11-8-2000^11-8-2004
;
N BSDXRIEN,BSDXRESN,BSDXI
S BSDXRIEN=0 F S BSDXRIEN=$O(^BSDXRES(BSDXRIEN)) Q:'BSDXRIEN D
.S BSDXRESN=$$GET1^DIQ(9002018.1,BSDXRIEN,.01,"E")
.Q:BSDXRESN=""
.; Call existing API to gather appointments for each resource found
.D APBLKOV(.BSDXDATA,BSDXSTART,BSDXEND,BSDXRESN,1)
.D GATHER(BSDXDATA,BSDXRESN)
.K ^BSDXTMP($J)
M ^BSDXTMP($J)=^BSDXTMP("BSDX05",$J)
K ^BSDXTMP("BSDX05",$J)
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030RES_NAME"_$C(30)
S BSDXI=$O(^BSDXTMP($J,""),-1),BSDXI=$G(BSDXI)+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
GATHER(BSDXDAT,BSDXRESN) ;
; Called by APBLKBR to retrieve data gathered for each resource.
N X,BSDXADAT,BSDXI
S X=0 F S X=$O(@BSDXDAT@(X)) Q:'X D
.S BSDXADAT=$G(@BSDXDAT@(X)) Q:BSDXADAT=$C(31)
.S BSDXI=$O(^BSDXTMP("BSDX05",$J,""),-1) S BSDXI=$G(BSDXI)+1
.S ^BSDXTMP("BSDX05",$J,BSDXI)=$P(BSDXADAT,$C(30))_U_BSDXRESN_$C(30)
Q
;
STRES(BSDXRESD,BSDXSTART,BSDXEND,BSDXWI) ;
;$O THRU "ARSRC" XREF OF ^BSDXAPPT
;Start at the beginning of the day -- appts can't overlap days
S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
S BSDXI=0
F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
. S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD,$G(BSDXWI)) ;BSDXAD Is the AppointmentID
. Q
Q
;
STCOMM(BSDXAD,BSDXWI) ;
S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
Q:'$D(^BSDXAPPT(BSDXAD,0))
S BSDXNOD=^BSDXAPPT(BSDXAD,0)
S BSDXPAT=$P(BSDXNOD,U,5)
Q:$P(BSDXNOD,U,10)=1 ;NO-SHOW Flag
Q:$P(BSDXNOD,U,12)]"" ;CANCELLED APPT
I '$G(BSDXWI) Q:$P(BSDXNOD,U,13)="y" ;WALKIN
S BSDXNSTART=$P(BSDXNOD,U)
S BSDXNEND=$P(BSDXNOD,U,2)
I BSDXNEND'>BSDXSTART Q ;End is less than start
S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXPAT_$C(30)
Q
BSDX05 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES,BSDXWI) ;EP
+1 ;Called by BSDX APPT BLOCKS OVERLAP
+2 ;(Duplicates old qryAppointmentBlocksOverlapB)
+3 ;BSDXRES is resource name
+4 ;BSDXWI is for walk-in appointments. 1 - Include walkins, otherwise do not include them.
+5 ;
+6 ;Test lines:
+7 ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
+8 ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
+9 ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
+10 ;
+11 NEW BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD,BSDXPAT
+12 KILL ^BSDXTMP($JOB)
+13 SET BSDXERR=""
+14 SET BSDXY="^BSDXTMP("_$JOB_")"
+15 SET ^BSDXTMP($JOB,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID"_$CHAR(30)
+16 Begin DoDot:1
+17 SET BSDXBS=0
+18 IF BSDXSTART["@0000"
SET BSDXSTART=$PIECE(BSDXSTART,"@")
+19 IF BSDXEND["@0000"
SET BSDXEND=$PIECE(BSDXEND,"@")
+20 SET %DT="T"
SET X=BSDXSTART
DO ^%DT
SET BSDXSTART=Y
+21 IF BSDXSTART=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+22 SET %DT="T"
SET X=BSDXEND
DO ^%DT
SET BSDXEND=Y
+23 IF BSDXEND=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+24 ;Go to end of day
IF $LENGTH(BSDXEND,".")=1
SET BSDXEND=BSDXEND+.9999
+25 SET BSDXRESN=BSDXRES
+26 IF BSDXRESN=""
QUIT
+27 IF '$DATA(^BSDXRES("B",BSDXRESN))
QUIT
+28 SET BSDXRESD=$ORDER(^BSDXRES("B",BSDXRESN,0))
+29 IF '+BSDXRESD
QUIT
+30 IF '$DATA(^BSDXAPPT("ARSRC",BSDXRESD))
QUIT
+31 DO STRES(BSDXRESD,BSDXSTART,BSDXEND,$GET(BSDXWI))
+32 QUIT
End DoDot:1
+33 ;
+34 SET BSDXI=$GET(BSDXI)+1
+35 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+36 QUIT
+37 ;
APBLKALL(BSDXY,BSDXSTART,BSDXEND) ;EP
+1 ; List of all appointments for all resources. - BWF/MSC, added 3-1-2010
+2 ; Called by BSDX ALL APPOINTMENTS
+3 ;
+4 ; Input: BSDXSTART - Start Date
+5 ; BSDXEND - End Date
+6 ;
+7 ;Test Lines:
+8 ;D APBLKALL^BSDX05(.RES,"11-8-2000","11-8-2004") ZW RES
+9 ;BSDX ALL APPOINTMENTS^11-8-2000^11-8-2004
+10 ;
+11 NEW BSDXRIEN,BSDXRESN,BSDXI
+12 SET BSDXRIEN=0
FOR
SET BSDXRIEN=$ORDER(^BSDXRES(BSDXRIEN))
IF 'BSDXRIEN
QUIT
Begin DoDot:1
+13 SET BSDXRESN=$$GET1^DIQ(9002018.1,BSDXRIEN,.01,"E")
+14 IF BSDXRESN=""
QUIT
+15 ; Call existing API to gather appointments for each resource found
+16 DO APBLKOV(.BSDXDATA,BSDXSTART,BSDXEND,BSDXRESN,1)
+17 DO GATHER(BSDXDATA,BSDXRESN)
+18 KILL ^BSDXTMP($JOB)
End DoDot:1
+19 MERGE ^BSDXTMP($JOB)=^BSDXTMP("BSDX05",$JOB)
+20 KILL ^BSDXTMP("BSDX05",$JOB)
+21 SET BSDXY="^BSDXTMP("_$JOB_")"
+22 SET ^BSDXTMP($JOB,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030RES_NAME"_$CHAR(30)
+23 SET BSDXI=$ORDER(^BSDXTMP($JOB,""),-1)
SET BSDXI=$GET(BSDXI)+1
+24 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+25 QUIT
+26 ;
GATHER(BSDXDAT,BSDXRESN) ;
+1 ; Called by APBLKBR to retrieve data gathered for each resource.
+2 NEW X,BSDXADAT,BSDXI
+3 SET X=0
FOR
SET X=$ORDER(@BSDXDAT@(X))
IF 'X
QUIT
Begin DoDot:1
+4 SET BSDXADAT=$GET(@BSDXDAT@(X))
IF BSDXADAT=$CHAR(31)
QUIT
+5 SET BSDXI=$ORDER(^BSDXTMP("BSDX05",$JOB,""),-1)
SET BSDXI=$GET(BSDXI)+1
+6 SET ^BSDXTMP("BSDX05",$JOB,BSDXI)=$PIECE(BSDXADAT,$CHAR(30))_U_BSDXRESN_$CHAR(30)
End DoDot:1
+7 QUIT
+8 ;
STRES(BSDXRESD,BSDXSTART,BSDXEND,BSDXWI) ;
+1 ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
+2 ;Start at the beginning of the day -- appts can't overlap days
+3 SET BSDXS=$PIECE(BSDXSTART,".")
SET BSDXS=BSDXS-.0001
+4 SET BSDXI=0
+5 FOR
SET BSDXS=$ORDER(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS))
IF '+BSDXS
QUIT
IF BSDXS>BSDXEND
QUIT
Begin DoDot:1
+6 ;BSDXAD Is the AppointmentID
SET BSDXAD=0
FOR
SET BSDXAD=$ORDER(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD))
IF '+BSDXAD
QUIT
DO STCOMM(BSDXAD,$GET(BSDXWI))
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
STCOMM(BSDXAD,BSDXWI) ;
+1 SET BSDXNEND=0
SET BSDXNSTART=0
SET BSDXPEND=0
+2 IF '$DATA(^BSDXAPPT(BSDXAD,0))
QUIT
+3 SET BSDXNOD=^BSDXAPPT(BSDXAD,0)
+4 SET BSDXPAT=$PIECE(BSDXNOD,U,5)
+5 ;NO-SHOW Flag
IF $PIECE(BSDXNOD,U,10)=1
QUIT
+6 ;CANCELLED APPT
IF $PIECE(BSDXNOD,U,12)]""
QUIT
+7 ;WALKIN
IF '$GET(BSDXWI)
IF $PIECE(BSDXNOD,U,13)="y"
QUIT
+8 SET BSDXNSTART=$PIECE(BSDXNOD,U)
+9 SET BSDXNEND=$PIECE(BSDXNOD,U,2)
+10 ;End is less than start
IF BSDXNEND'>BSDXSTART
QUIT
+11 SET Y=BSDXNSTART
XECUTE ^DD("DD")
SET BSDXNSTART=$TRANSLATE(Y,"@"," ")
+12 SET Y=BSDXNEND
XECUTE ^DD("DD")
SET BSDXNEND=$TRANSLATE(Y,"@"," ")
+13 SET BSDXI=BSDXI+1
+14 SET ^BSDXTMP($JOB,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXPAT_$CHAR(30)
+15 QUIT
