BSDX04 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
CASSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
;
;D DEBUG^%Serenji("CASSCH^BSDX04(.BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH)")
;
Q
;
CASSET ;EP
;Error Trap
D ^%ZTER
I '$D(BSDXI) N BSDXI S BSDXI=99999
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
;Called by BSDX CREATE ASGND SLOT SCHED
;Create Assigned Slot Schedule recordset
;This call is used both to create a schedule of availability for the calendar display
;and to search for availability in the Find Appointment function
;
;BSDXRES is resource name
;
;BSDXTYPES is |-delimited list of Access Type Names
;If BSDXTYPES is "" then the screen passes all types.
;
;BSDXSRCH is |-delimited search info for the Find Appointment function
;First piece is 1 if we are in a Find Appointment call
;Second piece is weekday info in the format MTWHFSU
;Third piece is AM PM info in the form AP
;If 2nd or 3rd pieces are null, the screen for that piece is skipped
;
;Test lines:
;D CASSCH^BSDX04(.RES,"REMILLARD,MIKE","1-8-2000@0001","1-12-2004@2300") ZW RES
;BSDX CREATE ASGND SLOT SCHED^ROGERS,BUCK^8-15-2003@0001^8-22-2003@2300^2
;S ^HW("BSDX04")=BSDXRES_U_BSDXSTART_U_BSDXEND
;
N BSDXERR,BSDXIEN,BSDXDEP,BSDXTYPED,BSDXTYPE,BSDXALO,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXZ,BSDXTMP,BSDXQ,BSDXNOT,BSDXNOD,BSDXAD
N BSDXSUBCD
S X="CASSET^BSDX04",@^%ZOSF("TRAP")
K ^BSDXTMP($J)
S BSDXERR=""
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010SLOTS^T00030RESOURCE^T00010ACCESS_TYPE^T00250NOTE^I00030AVAILABILITYID"_$C(30)
S BSDXALO=0,BSDXI=2
;
;Get Access Type IDs
N BSDXK,BSDXTYPED,BSDXL
I '+BSDXSRCH S BSDXTYPED=""
I +BSDXSRCH F BSDXK=1:1:$L(BSDXTYPES,"|") D
. S BSDXL=$P(BSDXTYPES,"|",BSDXK)
. I BSDXL="" S $P(BSDXTYPED,"|",BSDXK)=0 Q
. I '$D(^BSDXTYPE("B",BSDXL)) S $P(BSDXTYPED,"|",BSDXK)=0 Q
. S $P(BSDXTYPED,"|",BSDXK)=$O(^BSDXTYPE("B",BSDXL,0))
;
D
. S BSDXBS=0
. S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
. S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
. ;S:BSDXEND["@0:00" 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
. S BSDXRESN=BSDXRES
. Q:BSDXRESN=""
. Q:'$D(^BSDXRES("B",BSDXRESN))
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0)) Q:'+BSDXRESD
. Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
. D STRES(BSDXRESN,BSDXRESD)
. Q
;
;start, end, slots, resource, accesstype, note, availabilityid
;I '+BSDXSRCH,BSDXALO D
I BSDXALO D
. ;If first block start time > input start time then pad with new block
. I BSDXBS>BSDXSTART K BSDXTMP D
. . S Y=BSDXSTART X ^DD("DD") S Y=$TR(Y,"@"," ")
. . S BSDXTMP=Y
. . S Y=BSDXBS X ^DD("DD") S Y=$TR(Y,"@"," ")
. . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
. . S ^BSDXTMP($J,1)=BSDXTMP
. ;
. ;If first block start time < input start time then trim
. I BSDXBS<BSDXSTART D
. . S Y=BSDXSTART
. . X ^DD("DD") S Y=$TR(Y,"@"," ")
. . S $P(^BSDXTMP($J,2),U,1)=Y
. ;
. ;If last block end time < input end time then pad end with new block
. I BSDXPEND<BSDXEND D
. . S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ")
. . S BSDXTMP=Y
. . S Y=BSDXEND X ^DD("DD") S Y=$TR(Y,"@"," ")
. . S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
. . S ^BSDXTMP($J,BSDXI-1)=BSDXTMP
. ;
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
STRES(BSDXRESN,BSDXRESD) ;
;BSDXRESD is a Resource ID
;$O THRU "ARSCT" XREF OF ^BSDXAB
S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
F S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
. S BSDXAD=0 F S BSDXAD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ;BSDXAD Is the AvailabilityID
. Q
Q
;
STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ;
N BSDXNSTART,BSDXNEND,BSDXNOD,Y,BSDXQ,BSDXZ,BSDXATID,BSDXATOK
Q:'$D(^BSDXAB(BSDXAD,0))
S BSDXNOD=^BSDXAB(BSDXAD,0)
S BSDXATID=$P(BSDXNOD,U,5)
;
;Screen for Access Type
;S BSDXATOK=0
;I BSDXTYPED="" S BSDXATOK=1
;E D
;. F J=1:1:$L(BSDXTYPED,"|") I BSDXATID=$P(BSDXTYPED,"|",J) S BSDXATOK=1 Q
;Q:'BSDXATOK
;
;I +BSDXSRCH
;Screen for Weekday
;
;Screen for AM PM
;
S BSDXZ=""
S BSDXNSTART=$P(BSDXNOD,U,2)
S BSDXNEND=$P(BSDXNOD,U,3)
I BSDXNEND'>BSDXSTART Q ;End is less than start
I +BSDXBS=0 S BSDXBS=$P(BSDXNOD,U,2) ;First block start time
F BSDXQ=2:1:3 D ;Start and End times
. S Y=$P(BSDXNOD,U,BSDXQ)
. X ^DD("DD") S Y=$TR(Y,"@"," ")
. S BSDXZ=BSDXZ_Y_"^"
S BSDXZ=BSDXZ_$P(BSDXNOD,U,4)_"^" ;SLOTS
S BSDXZ=BSDXZ_BSDXRESN_"^" ;Resource name
S BSDXZ=BSDXZ_BSDXATID_"^" ;Access type ID
S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAB(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D
. S BSDXNOT=BSDXNOT_$G(^BSDXAB(BSDXAD,1,BSDXQ,0))_" "
S BSDXZ=BSDXZ_BSDXNOT ;_"^"
;I '+BSDXSRCH,BSDXPEND,BSDXNSTART>BSDXPEND D ;Fill in gap between appointment
I BSDXPEND,BSDXNSTART>BSDXPEND D ;Fill in gap between appointment
. S Y=BSDXPEND X ^DD("DD") S Y=$TR(Y,"@"," ")
. S BSDXTMP=Y
. S Y=BSDXNSTART X ^DD("DD") S Y=$TR(Y,"@"," ")
. S BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$C(30)
. S ^BSDXTMP($J,BSDXI-1)=BSDXTMP
S BSDXPEND=BSDXNEND
S ^BSDXTMP($J,BSDXI)=BSDXZ_"^"_BSDXAD_$C(30)
S BSDXI=BSDXI+2
S BSDXALO=1 ;At Least One record will be returned
Q
BSDX04 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
CASSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
+1 ;
+2 ;D DEBUG^%Serenji("CASSCH^BSDX04(.BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH)")
+3 ;
+4 QUIT
+5 ;
CASSET ;EP
+1 ;Error Trap
+2 DO ^%ZTER
+3 IF '$DATA(BSDXI)
NEW BSDXI
SET BSDXI=99999
+4 SET BSDXI=BSDXI+1
+5 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+6 QUIT
+7 ;
CASSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXTYPES,BSDXSRCH) ;EP
+1 ;Called by BSDX CREATE ASGND SLOT SCHED
+2 ;Create Assigned Slot Schedule recordset
+3 ;This call is used both to create a schedule of availability for the calendar display
+4 ;and to search for availability in the Find Appointment function
+5 ;
+6 ;BSDXRES is resource name
+7 ;
+8 ;BSDXTYPES is |-delimited list of Access Type Names
+9 ;If BSDXTYPES is "" then the screen passes all types.
+10 ;
+11 ;BSDXSRCH is |-delimited search info for the Find Appointment function
+12 ;First piece is 1 if we are in a Find Appointment call
+13 ;Second piece is weekday info in the format MTWHFSU
+14 ;Third piece is AM PM info in the form AP
+15 ;If 2nd or 3rd pieces are null, the screen for that piece is skipped
+16 ;
+17 ;Test lines:
+18 ;D CASSCH^BSDX04(.RES,"REMILLARD,MIKE","1-8-2000@0001","1-12-2004@2300") ZW RES
+19 ;BSDX CREATE ASGND SLOT SCHED^ROGERS,BUCK^8-15-2003@0001^8-22-2003@2300^2
+20 ;S ^HW("BSDX04")=BSDXRES_U_BSDXSTART_U_BSDXEND
+21 ;
+22 NEW BSDXERR,BSDXIEN,BSDXDEP,BSDXTYPED,BSDXTYPE,BSDXALO,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXZ,BSDXTMP,BSDXQ,BSDXNOT,BSDXNOD,BSDXAD
+23 NEW BSDXSUBCD
+24 SET X="CASSET^BSDX04"
SET @^%ZOSF("TRAP")
+25 KILL ^BSDXTMP($JOB)
+26 SET BSDXERR=""
+27 SET BSDXY="^BSDXTMP("_$JOB_")"
+28 SET ^BSDXTMP($JOB,0)="D00030START_TIME^D00030END_TIME^I00010SLOTS^T00030RESOURCE^T00010ACCESS_TYPE^T00250NOTE^I00030AVAILABILITYID"_$CHAR(30)
+29 SET BSDXALO=0
SET BSDXI=2
+30 ;
+31 ;Get Access Type IDs
+32 NEW BSDXK,BSDXTYPED,BSDXL
+33 IF '+BSDXSRCH
SET BSDXTYPED=""
+34 IF +BSDXSRCH
FOR BSDXK=1:1:$LENGTH(BSDXTYPES,"|")
Begin DoDot:1
+35 SET BSDXL=$PIECE(BSDXTYPES,"|",BSDXK)
+36 IF BSDXL=""
SET $PIECE(BSDXTYPED,"|",BSDXK)=0
QUIT
+37 IF '$DATA(^BSDXTYPE("B",BSDXL))
SET $PIECE(BSDXTYPED,"|",BSDXK)=0
QUIT
+38 SET $PIECE(BSDXTYPED,"|",BSDXK)=$ORDER(^BSDXTYPE("B",BSDXL,0))
End DoDot:1
+39 ;
+40 Begin DoDot:1
+41 SET BSDXBS=0
+42 IF BSDXSTART["@0000"
SET BSDXSTART=$PIECE(BSDXSTART,"@")
+43 IF BSDXEND["@0000"
SET BSDXEND=$PIECE(BSDXEND,"@")
+44 ;S:BSDXEND["@0:00" BSDXEND=$P(BSDXEND,"@")
+45 SET %DT="T"
SET X=BSDXSTART
DO ^%DT
SET BSDXSTART=Y
+46 IF BSDXSTART=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+47 SET %DT="T"
SET X=BSDXEND
DO ^%DT
SET BSDXEND=Y
+48 IF BSDXEND=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+49 SET BSDXRESN=BSDXRES
+50 IF BSDXRESN=""
QUIT
+51 IF '$DATA(^BSDXRES("B",BSDXRESN))
QUIT
+52 SET BSDXRESD=$ORDER(^BSDXRES("B",BSDXRESN,0))
IF '+BSDXRESD
QUIT
+53 IF '$DATA(^BSDXAB("ARSCT",BSDXRESD))
QUIT
+54 DO STRES(BSDXRESN,BSDXRESD)
+55 QUIT
End DoDot:1
+56 ;
+57 ;start, end, slots, resource, accesstype, note, availabilityid
+58 ;I '+BSDXSRCH,BSDXALO D
+59 IF BSDXALO
Begin DoDot:1
+60 ;If first block start time > input start time then pad with new block
+61 IF BSDXBS>BSDXSTART
KILL BSDXTMP
Begin DoDot:2
+62 SET Y=BSDXSTART
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+63 SET BSDXTMP=Y
+64 SET Y=BSDXBS
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+65 SET BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$CHAR(30)
+66 SET ^BSDXTMP($JOB,1)=BSDXTMP
End DoDot:2
+67 ;
+68 ;If first block start time < input start time then trim
+69 IF BSDXBS<BSDXSTART
Begin DoDot:2
+70 SET Y=BSDXSTART
+71 XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+72 SET $PIECE(^BSDXTMP($JOB,2),U,1)=Y
End DoDot:2
+73 ;
+74 ;If last block end time < input end time then pad end with new block
+75 IF BSDXPEND<BSDXEND
Begin DoDot:2
+76 SET Y=BSDXPEND
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+77 SET BSDXTMP=Y
+78 SET Y=BSDXEND
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+79 SET BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$CHAR(30)
+80 SET ^BSDXTMP($JOB,BSDXI-1)=BSDXTMP
End DoDot:2
+81 ;
End DoDot:1
+82 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+83 QUIT
+84 ;
STRES(BSDXRESN,BSDXRESD) ;
+1 ;BSDXRESD is a Resource ID
+2 ;$O THRU "ARSCT" XREF OF ^BSDXAB
+3 SET BSDXS=$PIECE(BSDXSTART,".")
SET BSDXS=BSDXS-.0001
+4 SET BSDXNEND=0
SET BSDXNSTART=0
SET BSDXPEND=0
+5 FOR
SET BSDXS=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXS))
IF '+BSDXS
QUIT
IF BSDXS>BSDXEND
QUIT
Begin DoDot:1
+6 ;BSDXAD Is the AvailabilityID
SET BSDXAD=0
FOR
SET BSDXAD=$ORDER(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD))
IF '+BSDXAD
QUIT
DO STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD)
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
STCOMM(BSDXRESN,BSDXRESD,BSDXS,BSDXAD) ;
+1 NEW BSDXNSTART,BSDXNEND,BSDXNOD,Y,BSDXQ,BSDXZ,BSDXATID,BSDXATOK
+2 IF '$DATA(^BSDXAB(BSDXAD,0))
QUIT
+3 SET BSDXNOD=^BSDXAB(BSDXAD,0)
+4 SET BSDXATID=$PIECE(BSDXNOD,U,5)
+5 ;
+6 ;Screen for Access Type
+7 ;S BSDXATOK=0
+8 ;I BSDXTYPED="" S BSDXATOK=1
+9 ;E D
+10 ;. F J=1:1:$L(BSDXTYPED,"|") I BSDXATID=$P(BSDXTYPED,"|",J) S BSDXATOK=1 Q
+11 ;Q:'BSDXATOK
+12 ;
+13 ;I +BSDXSRCH
+14 ;Screen for Weekday
+15 ;
+16 ;Screen for AM PM
+17 ;
+18 SET BSDXZ=""
+19 SET BSDXNSTART=$PIECE(BSDXNOD,U,2)
+20 SET BSDXNEND=$PIECE(BSDXNOD,U,3)
+21 ;End is less than start
IF BSDXNEND'>BSDXSTART
QUIT
+22 ;First block start time
IF +BSDXBS=0
SET BSDXBS=$PIECE(BSDXNOD,U,2)
+23 ;Start and End times
FOR BSDXQ=2:1:3
Begin DoDot:1
+24 SET Y=$PIECE(BSDXNOD,U,BSDXQ)
+25 XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+26 SET BSDXZ=BSDXZ_Y_"^"
End DoDot:1
+27 ;SLOTS
SET BSDXZ=BSDXZ_$PIECE(BSDXNOD,U,4)_"^"
+28 ;Resource name
SET BSDXZ=BSDXZ_BSDXRESN_"^"
+29 ;Access type ID
SET BSDXZ=BSDXZ_BSDXATID_"^"
+30 SET BSDXNOT=""
SET BSDXQ=0
FOR
SET BSDXQ=$ORDER(^BSDXAB(BSDXAD,1,BSDXQ))
IF '+BSDXQ
QUIT
Begin DoDot:1
+31 SET BSDXNOT=BSDXNOT_$GET(^BSDXAB(BSDXAD,1,BSDXQ,0))_" "
End DoDot:1
+32 ;_"^"
SET BSDXZ=BSDXZ_BSDXNOT
+33 ;I '+BSDXSRCH,BSDXPEND,BSDXNSTART>BSDXPEND D ;Fill in gap between appointment
+34 ;Fill in gap between appointment
IF BSDXPEND
IF BSDXNSTART>BSDXPEND
Begin DoDot:1
+35 SET Y=BSDXPEND
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+36 SET BSDXTMP=Y
+37 SET Y=BSDXNSTART
XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+38 SET BSDXTMP=BSDXTMP_"^"_Y_"^0^"_BSDXRESN_"^0^^0"_$CHAR(30)
+39 SET ^BSDXTMP($JOB,BSDXI-1)=BSDXTMP
End DoDot:1
+40 SET BSDXPEND=BSDXNEND
+41 SET ^BSDXTMP($JOB,BSDXI)=BSDXZ_"^"_BSDXAD_$CHAR(30)
+42 SET BSDXI=BSDXI+2
+43 ;At Least One record will be returned
SET BSDXALO=1
+44 QUIT
