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

Last change on this file since 1034 was 968, checked in by Sam Habiel, 14 years ago

Bumped version up to 1.41

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