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

Last change on this file since 1427 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.6 KB
RevLine 
[1161]1BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
[1187]2 ;;1.6T2;BSDX;;May 16, 2011
[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.