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

Last change on this file since 1453 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: 2.0 KB
Line 
1BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
2 ;;1.6T2;BSDX;;May 16, 2011
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
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:
15 ;D TPBLKOV^BSDX06(.RES,"3030513","3030516","REMILLARD,MIKE") ZW RES
16 ;BSDX TYPE BLOCKS OVERLAP^303513^3030516^REMILLARD,MIKE
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
27 . I $L(BSDXEND,".")=1 S BSDXEND=BSDXEND+.9999 ;Go to end of day if only date (not time) is passed
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.