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

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.

File size: 3.8 KB
Line 
1BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
2 ;;1.6T2;BSDX;;May 16, 2011
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.