| 1 | BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
|
|---|
| 2 | ;;1.6T2;BSDX;;May 16, 2011
|
|---|
| 3 | ; Licensed under LGPL
|
|---|
| 4 | ;
|
|---|
| 5 | ; Change Log:
|
|---|
| 6 | ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
|
|---|
| 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 | ;
|
|---|
| 13 | APBLKOV(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 | ;
|
|---|
| 45 | STRES(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 | ;
|
|---|
| 55 | STCOMM(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
|
|---|
