1 | BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
---|
2 | ;;1.6;BSDX;;Aug 31, 2011;Build 25
|
---|
3 | ; Licensed under LGPL
|
---|
4 | ;
|
---|
5 | ; Change Log:
|
---|
6 | ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH
|
---|
7 | Q
|
---|
8 | AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
|
---|
9 | ;Entry point for debugging
|
---|
10 | ;
|
---|
11 | ;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)")
|
---|
12 | Q
|
---|
13 | ;
|
---|
14 | AVDELDT(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
|
---|
15 | ;Cancel availability in a date range
|
---|
16 | ;Called by BSDX CANCEL AV BY DATE
|
---|
17 | ;
|
---|
18 | ;BSDXRESD is BSDX RESOURCE ien
|
---|
19 | ;BSDXSTART and BSDXEND are FM dates (change in v 1.3)
|
---|
20 | ;
|
---|
21 | S X="ERROR^BSDX13",@^%ZOSF("TRAP")
|
---|
22 | N BMXIEN,BSDXI
|
---|
23 | S BSDXI=0
|
---|
24 | S BSDXY="^BSDXTMP("_$J_")"
|
---|
25 | K ^BSDXTMP($J)
|
---|
26 | S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
|
---|
27 | ; S X=BSDXSTART ; commented out *v1.3
|
---|
28 | ; S %DT="X" D ^%DT
|
---|
29 | ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid Start Date") Q
|
---|
30 | ; S BSDXSTART=$P(Y,".")
|
---|
31 | ; S X=BSDXEND
|
---|
32 | ; S %DT="X" D ^%DT
|
---|
33 | ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid End Date") Q
|
---|
34 | S BSDXEND=$P(BSDXEND,".")_".99999"
|
---|
35 | I '+BSDXRESD D ERR(0,"AVDELDT-BSDX13: Invalid Resource ID") Q
|
---|
36 | ;
|
---|
37 | F S BSDXSTART=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART)) Q:'+BSDXSTART Q:BSDXSTART>BSDXEND D
|
---|
38 | . S BMXIEN=0
|
---|
39 | . F S BMXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART,BMXIEN)) Q:'+BMXIEN D
|
---|
40 | . . D CALLDIK(BMXIEN)
|
---|
41 | ;
|
---|
42 | S BSDXI=BSDXI+1
|
---|
43 | S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
|
---|
44 | Q
|
---|
45 | ERROR ;
|
---|
46 | D ^%ZTER
|
---|
47 | I '+$G(BSDXI) N BSDXI S BSDXI=999999
|
---|
48 | S BSDXI=BSDXI+1
|
---|
49 | D ERR(0,"BSDX13 M Error: <"_$G(%ZTERZE)_">")
|
---|
50 | Q
|
---|
51 | ;
|
---|
52 | ERR(BSDXERID,ERRTXT) ;Error processing
|
---|
53 | S:'+$G(BSDXI) BSDXI=999999
|
---|
54 | S BSDXI=BSDXI+1
|
---|
55 | S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
|
---|
56 | S BSDXI=BSDXI+1
|
---|
57 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | AVDEL(BSDXY,BSDXAVID) ;EP
|
---|
61 | ;Called by BSDX CANCEL AVAILABILITY
|
---|
62 | ;Deletes Access block
|
---|
63 | ;BSDXAVID is entry number in BSDX AVAILABILITY file
|
---|
64 | ;Returns error code in recordset field ERRORID
|
---|
65 | ;
|
---|
66 | S X="ERROR^BSDX13",@^%ZOSF("TRAP")
|
---|
67 | N BSDXNOD,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXEND,BSDXRSID
|
---|
68 | ;
|
---|
69 | S BSDXI=0
|
---|
70 | S BSDXY="^BSDXTMP("_$J_")"
|
---|
71 | K ^BSDXTMP($J)
|
---|
72 | S ^BSDXTMP($J,0)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
|
---|
73 | I '+BSDXAVID D ERR(70) Q
|
---|
74 | I '$D(^BSDXAB(BSDXAVID,0)) D ERR(70) Q
|
---|
75 | ;
|
---|
76 | ;
|
---|
77 | ;TODO: Test for existing appointments in availability block
|
---|
78 | ; (corresponds to old qryAppointmentBlocksOverlapC
|
---|
79 | ; and AVBlockHasAppointments)
|
---|
80 | ;
|
---|
81 | ;I $$APTINBLK(BSDXAVID) D ERR(20) Q
|
---|
82 | ;
|
---|
83 | ;Delete AVAILABILITY entries
|
---|
84 | D CALLDIK(BSDXAVID)
|
---|
85 | ;
|
---|
86 | S BSDXI=BSDXI+1
|
---|
87 | S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
|
---|
88 | Q
|
---|
89 | ;
|
---|
90 | CALLDIK(BSDXAVID) ;
|
---|
91 | ;Delete AVAILABILITY entries
|
---|
92 | ;
|
---|
93 | S DIK="^BSDXAB("
|
---|
94 | S DA=BSDXAVID
|
---|
95 | D ^DIK
|
---|
96 | ;
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | APTINBLK(BSDXAVID) ;
|
---|
100 | ;
|
---|
101 | ;NOTE: This Subroutine Not called in current version. Keep code for later use.
|
---|
102 | ;
|
---|
103 | ;N BSDXS,BSDXID,BSDXHIT,BSDXNOD,BSDXE,BSDXSTART,BSDXEND,BSDXRSID
|
---|
104 | ;S BSDXNOD=^BSDXAB(BSDXAVID,0)
|
---|
105 | ;S BSDXSTART=$P(BSDXNOD,U,3)
|
---|
106 | ;S BSDXEND=$P(BSDXNOD,U,4)
|
---|
107 | ;S BSDXRSID=$P(BSDXNOD,U,1)
|
---|
108 | ;I '$D(^BSDXDAPRS("ARSRC",BSDXRSID)) Q 0
|
---|
109 | ;;If any appointments start at the AV block start time:
|
---|
110 | ;I $D(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXSTART)) Q 1
|
---|
111 | ;;Find the first appt time BSDXS on the same day as the av block
|
---|
112 | ;S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,$P(BSDXSTART,".")))
|
---|
113 | ;I BSDXS>BSDXEND Q 0
|
---|
114 | ;;For all the appts that day with start times less
|
---|
115 | ;;than the av block's end time, find any whose end time is
|
---|
116 | ;;greater than the av block's start time
|
---|
117 | ;S BSDXHIT=0
|
---|
118 | ;S BSDXS=BSDXS-.0001
|
---|
119 | ;F S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS)) Q:'+BSDXS Q:BSDXS'<BSDXEND D Q:BSDXHIT
|
---|
120 | ;. S BSDXID=0 F S BSDXID=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS,BSDXID)) Q:'+BSDXID D Q:BSDXHIT
|
---|
121 | ;. . Q:'$D(^BSDXDAPT(BSDXID,0))
|
---|
122 | ;. . S BSDXNOD=^BSDXDAPT(BSDXID,0)
|
---|
123 | ;. . S BSDXE=$P(BSDXNOD,U,2)
|
---|
124 | ;. . I BSDXE>BSDXSTART S BSDXHIT=1 Q
|
---|
125 | ;;
|
---|
126 | ;I BSDXHIT Q 1
|
---|
127 | Q 0
|
---|
128 | ;
|
---|
129 | ;ERR(ERRNO) ;Error processing
|
---|
130 | ;N BSDXERR
|
---|
131 | ;S BSDXERR=ERRNO+134234112 ;vbObjectError
|
---|
132 | ;S BSDXI=BSDXI+1
|
---|
133 | ;S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
---|
134 | ;S BSDXI=BSDXI+1
|
---|
135 | ;S ^BSDXTMP($J,BSDXI)=$C(31)
|
---|
136 | ;Q
|
---|