BSDX02.m

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