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

Last change on this file since 1581 was 1563, checked in by Tariq Hamkari, 12 years ago

updated the BSDX version to 1.7

  • fix "BSDX01.m" routine , it was take too long time to retrieve patient radiology exams.
File size: 2.1 KB
Line 
1BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
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.