- BSDX05 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- ;
- ;
- APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES,BSDXWI) ;EP
- ;Called by BSDX APPT BLOCKS OVERLAP
- ;(Duplicates old qryAppointmentBlocksOverlapB)
- ;BSDXRES is resource name
- ;BSDXWI is for walk-in appointments. 1 - Include walkins, otherwise do not include them.
- ;
- ;Test lines:
- ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
- ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
- ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
- ;
- N BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD,BSDXPAT
- K ^BSDXTMP($J)
- S BSDXERR=""
- S BSDXY="^BSDXTMP("_$J_")"
- S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID"_$C(30)
- D
- . S BSDXBS=0
- . S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
- . S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
- . S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
- . I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
- . S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
- . I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
- . I $L(BSDXEND,".")=1 S BSDXEND=BSDXEND+.9999 ;Go to end of day
- . S BSDXRESN=BSDXRES
- . Q:BSDXRESN=""
- . Q:'$D(^BSDXRES("B",BSDXRESN))
- . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
- . Q:'+BSDXRESD
- . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
- . D STRES(BSDXRESD,BSDXSTART,BSDXEND,$G(BSDXWI))
- . Q
- ;
- S BSDXI=$G(BSDXI)+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- ;
- APBLKALL(BSDXY,BSDXSTART,BSDXEND) ;EP
- ; List of all appointments for all resources. - BWF/MSC, added 3-1-2010
- ; Called by BSDX ALL APPOINTMENTS
- ;
- ; Input: BSDXSTART - Start Date
- ; BSDXEND - End Date
- ;
- ;Test Lines:
- ;D APBLKALL^BSDX05(.RES,"11-8-2000","11-8-2004") ZW RES
- ;BSDX ALL APPOINTMENTS^11-8-2000^11-8-2004
- ;
- N BSDXRIEN,BSDXRESN,BSDXI
- S BSDXRIEN=0 F S BSDXRIEN=$O(^BSDXRES(BSDXRIEN)) Q:'BSDXRIEN D
- .S BSDXRESN=$$GET1^DIQ(9002018.1,BSDXRIEN,.01,"E")
- .Q:BSDXRESN=""
- .; Call existing API to gather appointments for each resource found
- .D APBLKOV(.BSDXDATA,BSDXSTART,BSDXEND,BSDXRESN,1)
- .D GATHER(BSDXDATA,BSDXRESN)
- .K ^BSDXTMP($J)
- M ^BSDXTMP($J)=^BSDXTMP("BSDX05",$J)
- K ^BSDXTMP("BSDX05",$J)
- S BSDXY="^BSDXTMP("_$J_")"
- S ^BSDXTMP($J,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030RES_NAME"_$C(30)
- S BSDXI=$O(^BSDXTMP($J,""),-1),BSDXI=$G(BSDXI)+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- ;
- GATHER(BSDXDAT,BSDXRESN) ;
- ; Called by APBLKBR to retrieve data gathered for each resource.
- N X,BSDXADAT,BSDXI
- S X=0 F S X=$O(@BSDXDAT@(X)) Q:'X D
- .S BSDXADAT=$G(@BSDXDAT@(X)) Q:BSDXADAT=$C(31)
- .S BSDXI=$O(^BSDXTMP("BSDX05",$J,""),-1) S BSDXI=$G(BSDXI)+1
- .S ^BSDXTMP("BSDX05",$J,BSDXI)=$P(BSDXADAT,$C(30))_U_BSDXRESN_$C(30)
- Q
- ;
- STRES(BSDXRESD,BSDXSTART,BSDXEND,BSDXWI) ;
- ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
- ;Start at the beginning of the day -- appts can't overlap days
- S BSDXS=$P(BSDXSTART,"."),BSDXS=BSDXS-.0001
- S BSDXI=0
- F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
- . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD,$G(BSDXWI)) ;BSDXAD Is the AppointmentID
- . Q
- Q
- ;
- STCOMM(BSDXAD,BSDXWI) ;
- S BSDXNEND=0,BSDXNSTART=0,BSDXPEND=0
- Q:'$D(^BSDXAPPT(BSDXAD,0))
- S BSDXNOD=^BSDXAPPT(BSDXAD,0)
- S BSDXPAT=$P(BSDXNOD,U,5)
- Q:$P(BSDXNOD,U,10)=1 ;NO-SHOW Flag
- Q:$P(BSDXNOD,U,12)]"" ;CANCELLED APPT
- I '$G(BSDXWI) Q:$P(BSDXNOD,U,13)="y" ;WALKIN
- S BSDXNSTART=$P(BSDXNOD,U)
- S BSDXNEND=$P(BSDXNOD,U,2)
- I BSDXNEND'>BSDXSTART Q ;End is less than start
- S Y=BSDXNSTART X ^DD("DD") S BSDXNSTART=$TR(Y,"@"," ")
- S Y=BSDXNEND X ^DD("DD") S BSDXNEND=$TR(Y,"@"," ")
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXPAT_$C(30)
- Q
- BSDX05 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- +1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- +2 ;
- +3 ;
- APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES,BSDXWI) ;EP
- +1 ;Called by BSDX APPT BLOCKS OVERLAP
- +2 ;(Duplicates old qryAppointmentBlocksOverlapB)
- +3 ;BSDXRES is resource name
- +4 ;BSDXWI is for walk-in appointments. 1 - Include walkins, otherwise do not include them.
- +5 ;
- +6 ;Test lines:
- +7 ;D APBLKOV^BSDX05(.RES,"11-8-2000","11-8-2004","WHITT") ZW RES
- +8 ;BSDX APPT BLOCKS OVERLAP^11-8-2000^11-8-2004^WHITT
- +9 ;S ^HW("BSDXD05")=BSDXSTART_U_BSDXEND_U_BSDXRES
- +10 ;
- +11 NEW BSDXERR,BSDXIEN,BSDXDEP,BSDXBS,BSDXI,BSDXNEND,BSDXNSTART,BSDXPEND,BSDXRESD,BSDXRESN,BSDXS,BSDXAD,BSDXNOD,BSDXPAT
- +12 KILL ^BSDXTMP($JOB)
- +13 SET BSDXERR=""
- +14 SET BSDXY="^BSDXTMP("_$JOB_")"
- +15 SET ^BSDXTMP($JOB,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID"_$CHAR(30)
- +16 Begin DoDot:1
- +17 SET BSDXBS=0
- +18 IF BSDXSTART["@0000"
- SET BSDXSTART=$PIECE(BSDXSTART,"@")
- +19 IF BSDXEND["@0000"
- SET BSDXEND=$PIECE(BSDXEND,"@")
- +20 SET %DT="T"
- SET X=BSDXSTART
- DO ^%DT
- SET BSDXSTART=Y
- +21 IF BSDXSTART=-1
- SET ^BSDXTMP($JOB,1)=$CHAR(31)
- QUIT
- +22 SET %DT="T"
- SET X=BSDXEND
- DO ^%DT
- SET BSDXEND=Y
- +23 IF BSDXEND=-1
- SET ^BSDXTMP($JOB,1)=$CHAR(31)
- QUIT
- +24 ;Go to end of day
- IF $LENGTH(BSDXEND,".")=1
- SET BSDXEND=BSDXEND+.9999
- +25 SET BSDXRESN=BSDXRES
- +26 IF BSDXRESN=""
- QUIT
- +27 IF '$DATA(^BSDXRES("B",BSDXRESN))
- QUIT
- +28 SET BSDXRESD=$ORDER(^BSDXRES("B",BSDXRESN,0))
- +29 IF '+BSDXRESD
- QUIT
- +30 IF '$DATA(^BSDXAPPT("ARSRC",BSDXRESD))
- QUIT
- +31 DO STRES(BSDXRESD,BSDXSTART,BSDXEND,$GET(BSDXWI))
- +32 QUIT
- End DoDot:1
- +33 ;
- +34 SET BSDXI=$GET(BSDXI)+1
- +35 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +36 QUIT
- +37 ;
- APBLKALL(BSDXY,BSDXSTART,BSDXEND) ;EP
- +1 ; List of all appointments for all resources. - BWF/MSC, added 3-1-2010
- +2 ; Called by BSDX ALL APPOINTMENTS
- +3 ;
- +4 ; Input: BSDXSTART - Start Date
- +5 ; BSDXEND - End Date
- +6 ;
- +7 ;Test Lines:
- +8 ;D APBLKALL^BSDX05(.RES,"11-8-2000","11-8-2004") ZW RES
- +9 ;BSDX ALL APPOINTMENTS^11-8-2000^11-8-2004
- +10 ;
- +11 NEW BSDXRIEN,BSDXRESN,BSDXI
- +12 SET BSDXRIEN=0
- FOR
- SET BSDXRIEN=$ORDER(^BSDXRES(BSDXRIEN))
- IF 'BSDXRIEN
- QUIT
- Begin DoDot:1
- +13 SET BSDXRESN=$$GET1^DIQ(9002018.1,BSDXRIEN,.01,"E")
- +14 IF BSDXRESN=""
- QUIT
- +15 ; Call existing API to gather appointments for each resource found
- +16 DO APBLKOV(.BSDXDATA,BSDXSTART,BSDXEND,BSDXRESN,1)
- +17 DO GATHER(BSDXDATA,BSDXRESN)
- +18 KILL ^BSDXTMP($JOB)
- End DoDot:1
- +19 MERGE ^BSDXTMP($JOB)=^BSDXTMP("BSDX05",$JOB)
- +20 KILL ^BSDXTMP("BSDX05",$JOB)
- +21 SET BSDXY="^BSDXTMP("_$JOB_")"
- +22 SET ^BSDXTMP($JOB,0)="D00030START_TIME^D00030END_TIME^I00010PAT_ID^T00030RES_NAME"_$CHAR(30)
- +23 SET BSDXI=$ORDER(^BSDXTMP($JOB,""),-1)
- SET BSDXI=$GET(BSDXI)+1
- +24 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +25 QUIT
- +26 ;
- GATHER(BSDXDAT,BSDXRESN) ;
- +1 ; Called by APBLKBR to retrieve data gathered for each resource.
- +2 NEW X,BSDXADAT,BSDXI
- +3 SET X=0
- FOR
- SET X=$ORDER(@BSDXDAT@(X))
- IF 'X
- QUIT
- Begin DoDot:1
- +4 SET BSDXADAT=$GET(@BSDXDAT@(X))
- IF BSDXADAT=$CHAR(31)
- QUIT
- +5 SET BSDXI=$ORDER(^BSDXTMP("BSDX05",$JOB,""),-1)
- SET BSDXI=$GET(BSDXI)+1
- +6 SET ^BSDXTMP("BSDX05",$JOB,BSDXI)=$PIECE(BSDXADAT,$CHAR(30))_U_BSDXRESN_$CHAR(30)
- End DoDot:1
- +7 QUIT
- +8 ;
- STRES(BSDXRESD,BSDXSTART,BSDXEND,BSDXWI) ;
- +1 ;$O THRU "ARSRC" XREF OF ^BSDXAPPT
- +2 ;Start at the beginning of the day -- appts can't overlap days
- +3 SET BSDXS=$PIECE(BSDXSTART,".")
- SET BSDXS=BSDXS-.0001
- +4 SET BSDXI=0
- +5 FOR
- SET BSDXS=$ORDER(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS))
- IF '+BSDXS
- QUIT
- IF BSDXS>BSDXEND
- QUIT
- Begin DoDot:1
- +6 ;BSDXAD Is the AppointmentID
- SET BSDXAD=0
- FOR
- SET BSDXAD=$ORDER(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD))
- IF '+BSDXAD
- QUIT
- DO STCOMM(BSDXAD,$GET(BSDXWI))
- +7 QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- STCOMM(BSDXAD,BSDXWI) ;
- +1 SET BSDXNEND=0
- SET BSDXNSTART=0
- SET BSDXPEND=0
- +2 IF '$DATA(^BSDXAPPT(BSDXAD,0))
- QUIT
- +3 SET BSDXNOD=^BSDXAPPT(BSDXAD,0)
- +4 SET BSDXPAT=$PIECE(BSDXNOD,U,5)
- +5 ;NO-SHOW Flag
- IF $PIECE(BSDXNOD,U,10)=1
- QUIT
- +6 ;CANCELLED APPT
- IF $PIECE(BSDXNOD,U,12)]""
- QUIT
- +7 ;WALKIN
- IF '$GET(BSDXWI)
- IF $PIECE(BSDXNOD,U,13)="y"
- QUIT
- +8 SET BSDXNSTART=$PIECE(BSDXNOD,U)
- +9 SET BSDXNEND=$PIECE(BSDXNOD,U,2)
- +10 ;End is less than start
- IF BSDXNEND'>BSDXSTART
- QUIT
- +11 SET Y=BSDXNSTART
- XECUTE ^DD("DD")
- SET BSDXNSTART=$TRANSLATE(Y,"@"," ")
- +12 SET Y=BSDXNEND
- XECUTE ^DD("DD")
- SET BSDXNEND=$TRANSLATE(Y,"@"," ")
- +13 SET BSDXI=BSDXI+1
- +14 SET ^BSDXTMP($JOB,BSDXI)=BSDXNSTART_U_BSDXNEND_U_BSDXPAT_$CHAR(30)
- +15 QUIT
