source: Scheduling/trunk/m/BSDX06.m@ 1472

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

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.

File size: 2.1 KB
RevLine 
[1161]1BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
[1472]2 ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
[1161]3 ; Licensed under LGPL
4 ; Change Log:
5 ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
6 ; dates in FM format for i18n
[614]7 ;
8 ;
9TPBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
10 ;Called by BSDXD TYPE BLOCKS OVERLAP
11 ;(Duplicates old qryTypeBlocksOverlapB)
12 ;BSDXRES is resource name
13 ;
14 ;Test lines:
[874]15 ;D TPBLKOV^BSDX06(.RES,"3030513","3030516","REMILLARD,MIKE") ZW RES
16 ;BSDX TYPE BLOCKS OVERLAP^303513^3030516^REMILLARD,MIKE
[614]17 ;S ^HW("BSDXD06")=BSDXSTART_U_BSDXEND_U_BSDXRES
18 ;
19 N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXTPID,BSDXNOD,BSDXAD
20 K ^BSDXTMP($J)
21 S BSDXERR=""
22 S BSDXY="^BSDXTMP("_$J_")"
23 S ^BSDXTMP($J,0)="D00030StartTime^D00030EndTime^I00010AppointmentTypeID^I00010AvailabilityID^T00030ResourceName"_$C(30)
24 S BSDXI=0
25 D
26 . S BSDXBS=0
[874]27 . I $L(BSDXEND,".")=1 S BSDXEND=BSDXEND+.9999 ;Go to end of day if only date (not time) is passed
[614]28 . S BSDXRESN=BSDXRES
29 . Q:BSDXRESN=""
30 . Q:'$D(^BSDXRES("B",BSDXRESN))
31 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
32 . Q:'+BSDXRESD
33 . D STCOMM(BSDXRESN,BSDXRESD)
34 . Q
35 ;
36 S BSDXI=$G(BSDXI)+1
37 S ^BSDXTMP($J,BSDXI)=$C(31)
38 Q
39 ;
40STCOMM(BSDXRESN,BSDXRESD) ;EP
41 ;
42 Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
43 Q:'$D(^BSDXRES(BSDXRESD,0))
44 ;$O THRU "ARSCT" XREF OF ^BSDXAB
45 S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
46 ;Start at the beginning of the day -- AV Blocks can't overlap days
47 S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
48 F S BSDXS=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
49 . S BSDXAD=0 F S BSDXAD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D
50 . . Q:'$D(^BSDXAB(BSDXAD,0))
51 . . S BSDXNOD=^BSDXAB(BSDXAD,0)
52 . . S BSDXNSTART=$P(BSDXNOD,U,2)
53 . . S BSDXNEND=$P(BSDXNOD,U,3)
54 . . I BSDXNEND'>BSDXSTART Q
55 . . S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
56 . . S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
57 . . S BSDXTPID=$P(BSDXNOD,U,5)
58 . . S BSDXI=BSDXI+1
59 . . S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXTPID_U_BSDXAD_U_BSDXRESN_$C(30)
60 . . Q
61 . Q
62 Q
Note: See TracBrowser for help on using the repository browser.