source: Scheduling/trunk/m/BSDX05.m@ 1582

Last change on this file since 1582 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.6 KB
RevLine 
[1161]1BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
[1563]2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
[1161]3 ; Licensed under LGPL
[1041]4 ;
[888]5 ; Change Log:
6 ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
[1041]7 ; UJO/SMH - Dec 8 2010: In STCOMM, the logic was that an appointment
8 ; that was a walk-in didn't count towards slot calculations.
9 ; I checked PIMS, and Walk-ins do indeed count towards slot calculations.
10 ; Therefore, I commented this line out:
11 ; ;Q:$P(BSDXNOD,U,13)="y" ;WALKIN
12 ;
13APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES) ;EP
14 ;Called by BSDX APPT BLOCKS OVERLAP
15 ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
16 ;(Duplicates old qryAppointmentBlocksOverlapB)
17 ;BSDXRES is resource name
18 ;
19 ;Test lines:
20 ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
21 ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
22 ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
23 ;
24 N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD
25 K ^BSDXTMP($J)
26 S BSDXERR=""
27 S BSDXY="^BSDXTMP("_$J_")"
28 S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME"_$C(30)
29 D
30 . S BSDXBS=0
31 . S BSDXEND=BSDXEND+.9999 ;Go to end of day
32 . S BSDXRESN=BSDXRES
33 . Q:BSDXRESN=""
34 . Q:'$D(^BSDXRES("B",BSDXRESN))
35 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
36 . Q:'+BSDXRESD
37 . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
38 . D STRES(BSDXRESD,BSDXSTART,BSDXEND)
39 . Q
40 ;
41 S BSDXI=$G(BSDXI)+1
42 S ^BSDXTMP($J,BSDXI)=$C(31)
43 Q
44 ;
45STRES(BSDXRESD,BSDXSTART,BSDXEND) ;
46 ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
47 ;Start at the beginning of the day -- appts can't overlap days
48 S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
49 S BSDXI=0
50 F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
51 . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD) ;BSDXAD Is the AppointmentID
52 . Q
53 Q
54 ;
55STCOMM(BSDXAD) ;
56 S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
57 Q:'$D(^BSDXAPPT(BSDXAD,0))
58 S BSDXNOD=^BSDXAPPT(BSDXAD,0)
59 Q:$P(BSDXNOD,U,10)=1 ;NO-SHOW Flag
60 Q:$P(BSDXNOD,U,12)]"" ;CANCELLED APPT
61 ; Q:$P(BSDXNOD,U,13)="y" ;WALKIN -- new in V 1.42. See top comments.
62 S BSDXNSTART=$P(BSDXNOD,U)
63 S BSDXNEND=$P(BSDXNOD,U,2)
64 I BSDXNEND'>BSDXSTART Q ;End is less than start
65 S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
66 S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
67 S BSDXI=BSDXI+1
68 S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_$C(30)
69 Q
Note: See TracBrowser for help on using the repository browser.