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

Last change on this file since 1519 was 1481, checked in by Sam Habiel, 12 years ago

Updated routine version numbers to 1.7T2.
Changes the Writes in the post-init to MESXPDUTL in BSDX2E.
Changed the check for BMX to be for BMX 4 rather than BMX 2.

File size: 3.8 KB
Line 
1BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
2 ;;1.7T2;BSDX;;Jul 11, 2012;Build 18
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
8AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
9 ;Entry point for debugging
10 ;
11 ;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)")
12 Q
13 ;
14AVDELDT(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
45ERROR ;
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 ;
52ERR(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 ;
60AVDEL(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 ;
90CALLDIK(BSDXAVID) ;
91 ;Delete AVAILABILITY entries
92 ;
93 S DIK="^BSDXAB("
94 S DA=BSDXAVID
95 D ^DIK
96 ;
97 Q
98 ;
99APTINBLK(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
Note: See TracBrowser for help on using the repository browser.