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

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

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason

File size: 3.8 KB
Line 
1BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm
2 ;;1.4;BSDX;;Sep 07, 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.