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

Last change on this file since 1460 was 1187, checked in by Sam Habiel, 13 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
RevLine 
[1161]1BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
[1187]2 ;;1.6T2;BSDX;;May 16, 2011
[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.