BSDX02 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("CRSCH^BSDX02(.BSDXY,BSDXRES,BSDXSTART,BSDXEND)")
Q
;
CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
;Called by BSDX CREATE APPT SCHEDULE
;Create Resource Appointment Schedule recordset
;On error, returns 0 in APPOINTMENTID field and error text in NOTE field
;
;$O Thru ^BSDXAPPT("ARSRC", RESOURCE, STARTTIME, APPTID)
;BMXRES is a | delimited list of resource names
;BSDXWKIN - If 1, then return walkins, otherwise skip them
;9-27-2004 Added walkin to returned datatable
;TODO: Change BSDXRES from names to IDs
;
N BSDXERR,BSDXIEN,BSDXDEPD,BSDXDEPN,BSDXRESD,BSDXI,BSDXJ,BSDXRESN,BSDXS,BSDXAD,BSDXZ,BSDXQ,BSDXNOD,BSDXTMP
N BSDXPAT,BSDXNOT,BSDXZPCD,BSDXPCD
K ^BSDXTMP($J)
S BSDXERR=""
S BSDXY="^BSDXTMP("_$J_")"
S BSDXTMP="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^"
S BSDXTMP=BSDXTMP_"T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^"
S BSDXTMP=BSDXTMP_"D00030CHECKOUT^I00020VPROVIDER^T00020CANCELLED^T00250NOTE"_$C(30)
S ^BSDXTMP($J,0)=BSDXTMP
D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
;
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
;
S BSDXI=0
D STRES
;
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
STRES ;
F BSDXJ=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDXJ) D
. Q:BSDXRESN=""
. Q:'$D(^BSDXRES("B",BSDXRESN))
. S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
. Q:'+BSDXRESD
. Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
. S BSDXS=BSDXSTART-.0001
. 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,BSDXRESN)
Q
;
STCOMM(BSDXAD,BSDXRESN) ;
;BSDXAD is the appointment IEN
N BSDXC,BSDXCAN,BSDXQ,BSDXZ,BSDXSUBC,BSDXHRN,BSDXPATD,BSDXATID,BSDXISWK
Q:'$D(^BSDXAPPT(BSDXAD,0))
S BSDXNOD=^BSDXAPPT(BSDXAD,0)
S BSDXCAN=($P(BSDXNOD,U,12)]"") ;CANCELLED flag 1=cancelled; 0=not cancelled
S BSDXISWK=0
S:$P(BSDXNOD,U,13)="y" BSDXISWK=1
I +$G(BSDXWKIN) Q:BSDXISWK ;Don't return walkins if appt is WALKIN and BSDXWKIN is 1
S BSDXCO=$TR($$FMTE^XLFDT($P(BSDXNOD,U,14)),"@"," ") ;APPOINTMENT CHECKOUT TIME
S BSDXVPRV=$P(BSDXNOD,U,16) ;POINTER TO V PROVIDER TABLE ^AUPNVPRV
S BSDXZ=BSDXAD_"^"
F BSDXQ=1:1:4 D
. S Y=$P(BSDXNOD,U,BSDXQ)
. X ^DD("DD") S Y=$TR(Y,"@"," ")
. S BSDXZ=BSDXZ_Y_"^"
S BSDXPATD=$P(BSDXNOD,U,5)
S BSDXZ=BSDXZ_BSDXPATD_"^" ;PATIENT ID
S BSDXPAT=""
I BSDXPATD]"",$D(^DPT(BSDXPATD,0)) S BSDXPAT=$P(^DPT(BSDXPATD,0),U)
S BSDXZ=BSDXZ_BSDXPAT_"^" ;PATIENT NAME
S BSDXZ=BSDXZ_BSDXRESN_"^" ;RESOURCENAME
S BSDXZ=BSDXZ_+$P(BSDXNOD,U,10)_"^" ;NOSHOW
S BSDXHRN=""
I $D(DUZ(2)),DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPATD,41,DUZ(2),0)),U,2) ;HRN
S BSDXZ=BSDXZ_BSDXHRN_"^"
S BSDXATID=$P(BSDXNOD,U,6)
S:'+BSDXATID BSDXATID=0 ;UNKNOWN TYPE
S BSDXZ=BSDXZ_BSDXATID_"^"_BSDXISWK_"^"
S BSDXZ=BSDXZ_BSDXCO_"^" ;CHECKOUT TIME
S BSDXZ=BSDXZ_BSDXVPRV_"^" ;POINTER TO NEW PERSON
S BSDXZ=BSDXZ_BSDXCAN_"^" ;CANCELLED
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXZ
;NOTE
S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D
. S BSDXNOT=$G(^BSDXAPPT(BSDXAD,1,BSDXQ,0))
. S:$E(BSDXNOT,$L(BSDXNOT)-1,$L(BSDXNOT))'=" " BSDXNOT=BSDXNOT_" "
. S BSDXI=BSDXI+1
. S ^BSDXTMP($J,BSDXI)=BSDXNOT
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(30)
Q
;
ERR(BSDXI,BSDXERR) ;Error processing
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)="0^^^^^^^^^^^"_BSDXERR_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
ETRAP ;EP Error trap entry
D ^%ZTER
I '$D(BSDXI) N BSDXI S BSDXI=999999
S BSDXI=BSDXI+1
D ERR(BSDXI,"BSDX31 Error: "_$G(%ZTERROR))
Q
BSDX02 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("CRSCH^BSDX02(.BSDXY,BSDXRES,BSDXSTART,BSDXEND)")
+4 QUIT
+5 ;
CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
+1 ;Called by BSDX CREATE APPT SCHEDULE
+2 ;Create Resource Appointment Schedule recordset
+3 ;On error, returns 0 in APPOINTMENTID field and error text in NOTE field
+4 ;
+5 ;$O Thru ^BSDXAPPT("ARSRC", RESOURCE, STARTTIME, APPTID)
+6 ;BMXRES is a | delimited list of resource names
+7 ;BSDXWKIN - If 1, then return walkins, otherwise skip them
+8 ;9-27-2004 Added walkin to returned datatable
+9 ;TODO: Change BSDXRES from names to IDs
+10 ;
+11 NEW BSDXERR,BSDXIEN,BSDXDEPD,BSDXDEPN,BSDXRESD,BSDXI,BSDXJ,BSDXRESN,BSDXS,BSDXAD,BSDXZ,BSDXQ,BSDXNOD,BSDXTMP
+12 NEW BSDXPAT,BSDXNOT,BSDXZPCD,BSDXPCD
+13 KILL ^BSDXTMP($JOB)
+14 SET BSDXERR=""
+15 SET BSDXY="^BSDXTMP("_$JOB_")"
+16 SET BSDXTMP="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^"
+17 SET BSDXTMP=BSDXTMP_"T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^"
+18 SET BSDXTMP=BSDXTMP_"D00030CHECKOUT^I00020VPROVIDER^T00020CANCELLED^T00250NOTE"_$CHAR(30)
+19 SET ^BSDXTMP($JOB,0)=BSDXTMP
+20 DO ^XBKVAR
SET X="ETRAP^BSDX02"
SET @^%ZOSF("TRAP")
+21 ;
+22 IF BSDXSTART["@0000"
SET BSDXSTART=$PIECE(BSDXSTART,"@")
+23 IF BSDXEND["@0000"
SET BSDXEND=$PIECE(BSDXEND,"@")
+24 SET %DT="T"
SET X=BSDXSTART
DO ^%DT
SET BSDXSTART=Y
+25 IF BSDXSTART=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+26 SET %DT="T"
SET X=BSDXEND
DO ^%DT
SET BSDXEND=Y
+27 IF BSDXEND=-1
SET ^BSDXTMP($JOB,1)=$CHAR(31)
QUIT
+28 ;
+29 SET BSDXI=0
+30 DO STRES
+31 ;
+32 SET BSDXI=BSDXI+1
+33 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+34 QUIT
+35 ;
STRES ;
+1 FOR BSDXJ=1:1:$LENGTH(BSDXRES,"|")
SET BSDXRESN=$PIECE(BSDXRES,"|",BSDXJ)
Begin DoDot:1
+2 IF BSDXRESN=""
QUIT
+3 IF '$DATA(^BSDXRES("B",BSDXRESN))
QUIT
+4 SET BSDXRESD=$ORDER(^BSDXRES("B",BSDXRESN,0))
+5 IF '+BSDXRESD
QUIT
+6 IF '$DATA(^BSDXAPPT("ARSRC",BSDXRESD))
QUIT
+7 SET BSDXS=BSDXSTART-.0001
+8 FOR
SET BSDXS=$ORDER(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS))
IF '+BSDXS
QUIT
IF BSDXS>BSDXEND
QUIT
Begin DoDot:2
+9 SET BSDXAD=0
FOR
SET BSDXAD=$ORDER(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD))
IF '+BSDXAD
QUIT
DO STCOMM(BSDXAD,BSDXRESN)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
STCOMM(BSDXAD,BSDXRESN) ;
+1 ;BSDXAD is the appointment IEN
+2 NEW BSDXC,BSDXCAN,BSDXQ,BSDXZ,BSDXSUBC,BSDXHRN,BSDXPATD,BSDXATID,BSDXISWK
+3 IF '$DATA(^BSDXAPPT(BSDXAD,0))
QUIT
+4 SET BSDXNOD=^BSDXAPPT(BSDXAD,0)
+5 ;CANCELLED flag 1=cancelled; 0=not cancelled
SET BSDXCAN=($PIECE(BSDXNOD,U,12)]"")
+6 SET BSDXISWK=0
+7 IF $PIECE(BSDXNOD,U,13)="y"
SET BSDXISWK=1
+8 ;Don't return walkins if appt is WALKIN and BSDXWKIN is 1
IF +$GET(BSDXWKIN)
IF BSDXISWK
QUIT
+9 ;APPOINTMENT CHECKOUT TIME
SET BSDXCO=$TRANSLATE($$FMTE^XLFDT($PIECE(BSDXNOD,U,14)),"@"," ")
+10 ;POINTER TO V PROVIDER TABLE ^AUPNVPRV
SET BSDXVPRV=$PIECE(BSDXNOD,U,16)
+11 SET BSDXZ=BSDXAD_"^"
+12 FOR BSDXQ=1:1:4
Begin DoDot:1
+13 SET Y=$PIECE(BSDXNOD,U,BSDXQ)
+14 XECUTE ^DD("DD")
SET Y=$TRANSLATE(Y,"@"," ")
+15 SET BSDXZ=BSDXZ_Y_"^"
End DoDot:1
+16 SET BSDXPATD=$PIECE(BSDXNOD,U,5)
+17 ;PATIENT ID
SET BSDXZ=BSDXZ_BSDXPATD_"^"
+18 SET BSDXPAT=""
+19 IF BSDXPATD]""
IF $DATA(^DPT(BSDXPATD,0))
SET BSDXPAT=$PIECE(^DPT(BSDXPATD,0),U)
+20 ;PATIENT NAME
SET BSDXZ=BSDXZ_BSDXPAT_"^"
+21 ;RESOURCENAME
SET BSDXZ=BSDXZ_BSDXRESN_"^"
+22 ;NOSHOW
SET BSDXZ=BSDXZ_+$PIECE(BSDXNOD,U,10)_"^"
+23 SET BSDXHRN=""
+24 ;HRN
IF $DATA(DUZ(2))
IF DUZ(2)>0
SET BSDXHRN=$PIECE($GET(^AUPNPAT(BSDXPATD,41,DUZ(2),0)),U,2)
+25 SET BSDXZ=BSDXZ_BSDXHRN_"^"
+26 SET BSDXATID=$PIECE(BSDXNOD,U,6)
+27 ;UNKNOWN TYPE
IF '+BSDXATID
SET BSDXATID=0
+28 SET BSDXZ=BSDXZ_BSDXATID_"^"_BSDXISWK_"^"
+29 ;CHECKOUT TIME
SET BSDXZ=BSDXZ_BSDXCO_"^"
+30 ;POINTER TO NEW PERSON
SET BSDXZ=BSDXZ_BSDXVPRV_"^"
+31 ;CANCELLED
SET BSDXZ=BSDXZ_BSDXCAN_"^"
+32 SET BSDXI=BSDXI+1
+33 SET ^BSDXTMP($JOB,BSDXI)=BSDXZ
+34 ;NOTE
+35 SET BSDXNOT=""
SET BSDXQ=0
FOR
SET BSDXQ=$ORDER(^BSDXAPPT(BSDXAD,1,BSDXQ))
IF '+BSDXQ
QUIT
Begin DoDot:1
+36 SET BSDXNOT=$GET(^BSDXAPPT(BSDXAD,1,BSDXQ,0))
+37 IF $EXTRACT(BSDXNOT,$LENGTH(BSDXNOT)-1,$LENGTH(BSDXNOT))'=" "
SET BSDXNOT=BSDXNOT_" "
+38 SET BSDXI=BSDXI+1
+39 SET ^BSDXTMP($JOB,BSDXI)=BSDXNOT
End DoDot:1
+40 SET BSDXI=BSDXI+1
+41 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)
+42 QUIT
+43 ;
ERR(BSDXI,BSDXERR) ;Error processing
+1 SET BSDXI=BSDXI+1
+2 SET ^BSDXTMP($JOB,BSDXI)="0^^^^^^^^^^^"_BSDXERR_$CHAR(30)
+3 SET BSDXI=BSDXI+1
+4 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+5 QUIT
+6 ;
ETRAP ;EP Error trap entry
+1 DO ^%ZTER
+2 IF '$DATA(BSDXI)
NEW BSDXI
SET BSDXI=999999
+3 SET BSDXI=BSDXI+1
+4 DO ERR(BSDXI,"BSDX31 Error: "_$GET(%ZTERROR))
+5 QUIT
