source: Scheduling/trunk/m/BSDX13.m@ 760

Last change on this file since 760 was 614, checked in by Sam Habiel, 15 years ago

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