Routine: BSDX38

BSDX38 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 ;  DAP = return appointment data for given patient - RPC

 ;return appointment data for given patient - RPC

DAP(BSDXY,DFN) ;return appointment data for given patient - RPC

 ; RPC Name is BSDX APPT EVENT LOG

 ;  .BSDXY   = returned pointer to appointment data

 ;   DFN = patient code - pointer to ^DPT(DFN)

 N AMN,AMT,AMU,APN,APT,BSDXI,BSDXTMP,CIN,CIT,CIU,COE,COF,CON,COT,COU,CRM,CRS

 N DPTS,DPTSR,NSN,NST,NSU,PAT,PN,RBD,RSD,S,SC,SDCL,SDCLS,SDCLSC,SDW

 D ^XBKVAR S X="ERROR^BSDXERR",@^%ZOSF("TRAP")

 S BSDXI=0

 K ^BSDXTMP($J)

 S BSDXY="^BSDXTMP("_$J_")"

 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)

 ;check for valid Patient

 I '+DFN D ERR^BSDXERR("Invalid Patient ID.") Q

 I '$D(^DPT(DFN,0)) D ERR^BSDXERR("Invalid Patient ID.") Q

 ; data header

 S BSDXTMP="T00020PATIENT_IEN^T00020PATIENT_NAME^T00020CLINIC_IEN^T00020WARD_IEN^T00020APPT_TIME^T00020APPT_NUMBER"

 S BSDXTMP=BSDXTMP_"^T00020APPT_MADE_TIME^T00020APPT_MADE_USER^T00020APPT_MADE_USER_NAME^T00020ROUT_SLIP_DATE"

 S BSDXTMP=BSDXTMP_"^T00020CHECKIN_TIME^T00020CHECKIN_USER^T00020CHECKIN_USER_NAME"

 S BSDXTMP=BSDXTMP_"^T00020CHECKOUT_TIME^T00020CHECKOUT_USER^T00020CHECKOUT_USER_NAME^T00020CHECKOUT_FILED_TIME"

 S BSDXTMP=BSDXTMP_"^T00020NO_SHO_CANCEL_TIME^T00020NO_SHO_CANCEL_USER^T00020NO_SHO_CANCEL_USER_NAME^T00020CHECKED_OUT"

 S BSDXTMP=BSDXTMP_"^T00020REBOOK_DATE^T00100CANCEL_REASON^T00100CANCEL_REMARK"_$C(30)

 S ^BSDXTMP($J,0)=BSDXTMP

 S PN=$$GET1^DIQ(2,DFN_",",.01)

 S APN=0

 S SDCLS=""

 S SDCLSC=""

 ;loop thru patient appointments

 S S=0 F  S S=$O(^DPT(DFN,"S",S)) Q:S'>0  D

 . S DPTS=$G(^DPT(DFN,"S",S,0))

 . S DPTSR=$G(^DPT(DFN,"S",S,"R"))

 . S SDCL=$P(DPTS,U)        ;get clinic

 . S PAT="",SC=0 F  S SC=$O(^SC(SDCL,"S",S,1,SC)) Q:SC'>0  D  Q:PAT=DFN  ;get appt record from clinic

 . . S SDCLS=$G(^SC(SDCL,"S",S,1,SC,0))

 . . S SDCLSC=$G(^SC(SDCL,"S",S,1,SC,"C"))

 . . S PAT=$P(SDCLS,U)

 . . I PAT=DFN Q

 . S BSDXTMP=DFN_U                                 ;01 PATIENT_IEN

 . S BSDXTMP=BSDXTMP_PN_U                          ;02 PATIENT_NAME

 . S BSDXTMP=BSDXTMP_SDCL_U                        ;03 CLINIC_IEN

 . S SDW=$S($D(^DPT(DFN,.1)):^(.1),1:"Outpatient") ;04 WARD_IEN

 . S BSDXTMP=BSDXTMP_SDW_U

 . S APT=$TR($$FMTE^XLFDT(S),"@"," ")              ;05 APPT_TIME

 . S BSDXTMP=BSDXTMP_APT_U

 . S APN=APN+1                                     ;06 APPT_NUMBER

 . S BSDXTMP=BSDXTMP_APN_U

 . S AMT=$P(DPTS,U,19)                             ;07 APPT_MADE_TIME

 . S:AMT'="" AMT=$TR($$FMTE^XLFDT(AMT),"@"," ")

 . S BSDXTMP=BSDXTMP_AMT_U

 . S AMU=$P(DPTS,U,18)                             ;08 APPT_MADE_USER

 . S BSDXTMP=BSDXTMP_AMU_U

 . S AMN=$$GET1^DIQ(200,AMU_",",.01)               ;09 APPT_MADE_USER_NAME

 . S BSDXTMP=BSDXTMP_AMN_U

 . S RSD=$P(DPTS,U,13)                             ;10 ROUT_SLIP_DATE

 . S:RSD'="" RSD=$TR($$FMTE^XLFDT(RSD),"@"," ")

 . S BSDXTMP=BSDXTMP_RSD_U

 . S CIT=$P(SDCLSC,U)                              ;11 CHECKIN_TIME

 . S:CIT'="" CIT=$TR($$FMTE^XLFDT(CIT),"@"," ")

 . S BSDXTMP=BSDXTMP_CIT_U

 . S CIU=$P(SDCLSC,U,2)                            ;12 CHECKIN_USER

 . S BSDXTMP=BSDXTMP_CIU_U

 . S CIN=$$GET1^DIQ(200,CIU_",",.01)               ;13 CHECKIN_USER_NAME

 . S BSDXTMP=BSDXTMP_CIN_U

 . S COT=$P(SDCLSC,U,3)                            ;14 CHECKOUT_TIME

 . S:COT'="" COT=$TR($$FMTE^XLFDT(COT),"@"," ")

 . S BSDXTMP=BSDXTMP_COT_U

 . S COU=$P(SDCLSC,U,4)                            ;15 CHECKOUT_USER

 . S BSDXTMP=BSDXTMP_COU_U

 . S CON=$$GET1^DIQ(200,COU_",",.01)               ;16 CHECKOUT_USER_NAME

 . S BSDXTMP=BSDXTMP_CON_U

 . S COE=$P(SDCLSC,U,6)                            ;17 CHECKOUT_FILED_TIME

 . S:COE'="" COE=$TR($$FMTE^XLFDT(COE),"@"," ")

 . S BSDXTMP=BSDXTMP_COE_U

 . S NST=$P(DPTS,U,14)                             ;18 NO_SHO_CANCEL_TIME

 . S:NST'="" NST=$TR($$FMTE^XLFDT(NST),"@"," ")

 . S BSDXTMP=BSDXTMP_NST_U

 . S NSU=$P(DPTS,U,12)                             ;19 NO_SHO_CANCEL_USER

 . S BSDXTMP=BSDXTMP_NSU_U

 . S NSN=$$GET1^DIQ(200,NSU_",",.01)               ;20 NO_SHO_CANCEL_USER_NAME

 . S BSDXTMP=BSDXTMP_NSN_U

 . S COF=$S($P(SDCLSC,U,3)'="":"YES",SDCLSC'="":"NO",1:"") ;21 CHECKED_OUT

 . S BSDXTMP=BSDXTMP_COF_U

 . S RBD=$P(DPTS,U,10)                             ;22 REBOOK_DATE

 . S:RBD'="" RBD=$TR($$FMTE^XLFDT(RBD),"@"," ")

 . S BSDXTMP=BSDXTMP_RBD_U

 . S BSDXI=BSDXI+1

 . S ^BSDXTMP($J,BSDXI)=BSDXTMP

 . S CRS=$P(DPTS,U,15)                             ;23 CANCEL_REASON

 . S BSDXI=BSDXI+1

 . S ^BSDXTMP($J,BSDXI)=CRS_U

 . S CRM=$P(DPTSR,U)                               ;24 CANCEL_REMARK

 . S BSDXI=BSDXI+1

 . S ^BSDXTMP($J,BSDXI)=CRM

 . S BSDXI=BSDXI+1

 . S ^BSDXTMP($J,BSDXI)=$C(30)

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=$C(31)

NOSHOW(DFN,SDT,CIFN,PAT) ;Input:  DFN=Patient IFN, SDT=Appointment D/T

 ;  CIFN=Clinic IFN, PAT=Zero node of pat. appt., DA=Clinic appt. IFN

 ;                        Output:  1 or 0 for noshow yes/no

 N NSQUERY,NS S NS=1,NSQUERY=$$STATUS^SDAM1(DFN,SDT,CIFN,PAT)

 I $P(NSQUERY,";",3)["ACTION REQ" S NS=0

NOSHOWQ Q NS

 ;return boolean to represent that a clinic allows variable appointment length - RPC

VAL(BSDXY,SDCL) ;return boolean to represent that a clinic allows variable appointment length - RPC

 ; BSDX CLINIC VAR APPT

 N BSDXI

 D ^XBKVAR S X="ERROR^BSDXERR",@^%ZOSF("TRAP")

 S BSDXI=0

 K ^BSDXTMP($J)

 S BSDXY="^BSDXTMP("_$J_")"

 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)

 ;check for valid clinic ID

 I '+SDCL D ERR^BSDXERR("Invalid Clinic ID.") Q

 I '$D(^SC(SDCL,0)) D ERR^BSDXERR("Invalid Clinic ID.") Q

 ; data header

 ; VAR_APPT_FLAG = flag  0=Clinic does not Allow Variable Appointment; 1=Clinic Allows Variable Appointment

 S ^BSDXTMP($J,0)="I00020VAR_APPT_FLAG"_$C(30)

 ;get VARIABLE APPOINTMENT FLAG for clinic

 S VAL=$$GET1^DIQ(44,SDCL_",",1913) ;Variable Appointment Length

 S VAL=$S(VAL["YES":1,1:0)

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=VAL

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=$C(30)

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=$C(31)

BSDX38    ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 +1       ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 +2       ;

 +3       ;  DAP = return appointment data for given patient - RPC

 +4       ;

 +5       ;return appointment data for given patient - RPC

DAP(BSDXY,DFN) ;return appointment data for given patient - RPC

 +1       ; RPC Name is BSDX APPT EVENT LOG

 +2       ;  .BSDXY   = returned pointer to appointment data

 +3       ;   DFN = patient code - pointer to ^DPT(DFN)

 +4        NEW AMN,AMT,AMU,APN,APT,BSDXI,BSDXTMP,CIN,CIT,CIU,COE,COF,CON,COT,COU,CRM,CRS

 +5        NEW DPTS,DPTSR,NSN,NST,NSU,PAT,PN,RBD,RSD,S,SC,SDCL,SDCLS,SDCLSC,SDW

 +6        DO ^XBKVAR

           SET X="ERROR^BSDXERR"

           SET @^%ZOSF("TRAP")

 +7        SET BSDXI=0

 +8        KILL ^BSDXTMP($JOB)

 +9        SET BSDXY="^BSDXTMP("_$JOB_")"

 +10       SET ^BSDXTMP($JOB,0)="T00020ERRORID"_$CHAR(30)

 +11      ;check for valid Patient

 +12       IF '+DFN

               DO ERR^BSDXERR("Invalid Patient ID.")

               QUIT

 +13       IF '$DATA(^DPT(DFN,0))

               DO ERR^BSDXERR("Invalid Patient ID.")

               QUIT

 +14      ; data header

 +15       SET BSDXTMP="T00020PATIENT_IEN^T00020PATIENT_NAME^T00020CLINIC_IEN^T00020WARD_IEN^T00020APPT_TIME^T00020APPT_NUMBER"

 +16       SET BSDXTMP=BSDXTMP_"^T00020APPT_MADE_TIME^T00020APPT_MADE_USER^T00020APPT_MADE_USER_NAME^T00020ROUT_SLIP_DATE"

 +17       SET BSDXTMP=BSDXTMP_"^T00020CHECKIN_TIME^T00020CHECKIN_USER^T00020CHECKIN_USER_NAME"

 +18       SET BSDXTMP=BSDXTMP_"^T00020CHECKOUT_TIME^T00020CHECKOUT_USER^T00020CHECKOUT_USER_NAME^T00020CHECKOUT_FILED_TIME"

 +19       SET BSDXTMP=BSDXTMP_"^T00020NO_SHO_CANCEL_TIME^T00020NO_SHO_CANCEL_USER^T00020NO_SHO_CANCEL_USER_NAME^T00020CHECKED_OUT"

 +20       SET BSDXTMP=BSDXTMP_"^T00020REBOOK_DATE^T00100CANCEL_REASON^T00100CANCEL_REMARK"_$CHAR(30)

 +21       SET ^BSDXTMP($JOB,0)=BSDXTMP

 +22       SET PN=$$GET1^DIQ(2,DFN_",",.01)

 +23       SET APN=0

 +24       SET SDCLS=""

 +25       SET SDCLSC=""

 +26      ;loop thru patient appointments

 +27       SET S=0

FOR

               SET S=$ORDER(^DPT(DFN,"S",S))

               IF S'>0

                   QUIT

               Begin DoDot:1

 +28               SET DPTS=$GET(^DPT(DFN,"S",S,0))

 +29               SET DPTSR=$GET(^DPT(DFN,"S",S,"R"))

 +30      ;get clinic

                   SET SDCL=$PIECE(DPTS,U)

 +31      ;get appt record from clinic

                   SET PAT=""

                   SET SC=0

FOR

                       SET SC=$ORDER(^SC(SDCL,"S",S,1,SC))

                       IF SC'>0

                           QUIT

                       Begin DoDot:2

 +32                       SET SDCLS=$GET(^SC(SDCL,"S",S,1,SC,0))

 +33                       SET SDCLSC=$GET(^SC(SDCL,"S",S,1,SC,"C"))

 +34                       SET PAT=$PIECE(SDCLS,U)

 +35                       IF PAT=DFN

                               QUIT

                       End DoDot:2

                       IF PAT=DFN

                           QUIT

 +36      ;01 PATIENT_IEN

                   SET BSDXTMP=DFN_U

 +37      ;02 PATIENT_NAME

                   SET BSDXTMP=BSDXTMP_PN_U

 +38      ;03 CLINIC_IEN

                   SET BSDXTMP=BSDXTMP_SDCL_U

 +39      ;04 WARD_IEN

                   SET SDW=$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"Outpatient")

 +40               SET BSDXTMP=BSDXTMP_SDW_U

 +41      ;05 APPT_TIME

                   SET APT=$TRANSLATE($$FMTE^XLFDT(S),"@"," ")

 +42               SET BSDXTMP=BSDXTMP_APT_U

 +43      ;06 APPT_NUMBER

                   SET APN=APN+1

 +44               SET BSDXTMP=BSDXTMP_APN_U

 +45      ;07 APPT_MADE_TIME

                   SET AMT=$PIECE(DPTS,U,19)

 +46               IF AMT'=""

                       SET AMT=$TRANSLATE($$FMTE^XLFDT(AMT),"@"," ")

 +47               SET BSDXTMP=BSDXTMP_AMT_U

 +48      ;08 APPT_MADE_USER

                   SET AMU=$PIECE(DPTS,U,18)

 +49               SET BSDXTMP=BSDXTMP_AMU_U

 +50      ;09 APPT_MADE_USER_NAME

                   SET AMN=$$GET1^DIQ(200,AMU_",",.01)

 +51               SET BSDXTMP=BSDXTMP_AMN_U

 +52      ;10 ROUT_SLIP_DATE

                   SET RSD=$PIECE(DPTS,U,13)

 +53               IF RSD'=""

                       SET RSD=$TRANSLATE($$FMTE^XLFDT(RSD),"@"," ")

 +54               SET BSDXTMP=BSDXTMP_RSD_U

 +55      ;11 CHECKIN_TIME

                   SET CIT=$PIECE(SDCLSC,U)

 +56               IF CIT'=""

                       SET CIT=$TRANSLATE($$FMTE^XLFDT(CIT),"@"," ")

 +57               SET BSDXTMP=BSDXTMP_CIT_U

 +58      ;12 CHECKIN_USER

                   SET CIU=$PIECE(SDCLSC,U,2)

 +59               SET BSDXTMP=BSDXTMP_CIU_U

 +60      ;13 CHECKIN_USER_NAME

                   SET CIN=$$GET1^DIQ(200,CIU_",",.01)

 +61               SET BSDXTMP=BSDXTMP_CIN_U

 +62      ;14 CHECKOUT_TIME

                   SET COT=$PIECE(SDCLSC,U,3)

 +63               IF COT'=""

                       SET COT=$TRANSLATE($$FMTE^XLFDT(COT),"@"," ")

 +64               SET BSDXTMP=BSDXTMP_COT_U

 +65      ;15 CHECKOUT_USER

                   SET COU=$PIECE(SDCLSC,U,4)

 +66               SET BSDXTMP=BSDXTMP_COU_U

 +67      ;16 CHECKOUT_USER_NAME

                   SET CON=$$GET1^DIQ(200,COU_",",.01)

 +68               SET BSDXTMP=BSDXTMP_CON_U

 +69      ;17 CHECKOUT_FILED_TIME

                   SET COE=$PIECE(SDCLSC,U,6)

 +70               IF COE'=""

                       SET COE=$TRANSLATE($$FMTE^XLFDT(COE),"@"," ")

 +71               SET BSDXTMP=BSDXTMP_COE_U

 +72      ;18 NO_SHO_CANCEL_TIME

                   SET NST=$PIECE(DPTS,U,14)

 +73               IF NST'=""

                       SET NST=$TRANSLATE($$FMTE^XLFDT(NST),"@"," ")

 +74               SET BSDXTMP=BSDXTMP_NST_U

 +75      ;19 NO_SHO_CANCEL_USER

                   SET NSU=$PIECE(DPTS,U,12)

 +76               SET BSDXTMP=BSDXTMP_NSU_U

 +77      ;20 NO_SHO_CANCEL_USER_NAME

                   SET NSN=$$GET1^DIQ(200,NSU_",",.01)

 +78               SET BSDXTMP=BSDXTMP_NSN_U

 +79      ;21 CHECKED_OUT

                   SET COF=$SELECT($PIECE(SDCLSC,U,3)'="":"YES",SDCLSC'="":"NO",1:"")

 +80               SET BSDXTMP=BSDXTMP_COF_U

 +81      ;22 REBOOK_DATE

                   SET RBD=$PIECE(DPTS,U,10)

 +82               IF RBD'=""

                       SET RBD=$TRANSLATE($$FMTE^XLFDT(RBD),"@"," ")

 +83               SET BSDXTMP=BSDXTMP_RBD_U

 +84               SET BSDXI=BSDXI+1

 +85               SET ^BSDXTMP($JOB,BSDXI)=BSDXTMP

 +86      ;23 CANCEL_REASON

                   SET CRS=$PIECE(DPTS,U,15)

 +87               SET BSDXI=BSDXI+1

 +88               SET ^BSDXTMP($JOB,BSDXI)=CRS_U

 +89      ;24 CANCEL_REMARK

                   SET CRM=$PIECE(DPTSR,U)

 +90               SET BSDXI=BSDXI+1

 +91               SET ^BSDXTMP($JOB,BSDXI)=CRM

 +92               SET BSDXI=BSDXI+1

 +93               SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)

               End DoDot:1

 +94      ;

 +95       SET BSDXI=BSDXI+1

 +96       SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +97       QUIT

 +98      ;

NOSHOW(DFN,SDT,CIFN,PAT) ;Input:  DFN=Patient IFN, SDT=Appointment D/T

 +1       ;  CIFN=Clinic IFN, PAT=Zero node of pat. appt., DA=Clinic appt. IFN

 +2       ;                        Output:  1 or 0 for noshow yes/no

 +3        NEW NSQUERY,NS

           SET NS=1

           SET NSQUERY=$$STATUS^SDAM1(DFN,SDT,CIFN,PAT)

 +4        IF $PIECE(NSQUERY,";",3)["ACTION REQ"

               SET NS=0

NOSHOWQ    QUIT NS

 +1       ;

 +2       ;return boolean to represent that a clinic allows variable appointment length - RPC

VAL(BSDXY,SDCL) ;return boolean to represent that a clinic allows variable appointment length - RPC

 +1       ; BSDX CLINIC VAR APPT

 +2        NEW BSDXI

 +3        DO ^XBKVAR

           SET X="ERROR^BSDXERR"

           SET @^%ZOSF("TRAP")

 +4        SET BSDXI=0

 +5        KILL ^BSDXTMP($JOB)

 +6        SET BSDXY="^BSDXTMP("_$JOB_")"

 +7        SET ^BSDXTMP($JOB,0)="T00020ERRORID"_$CHAR(30)

 +8       ;check for valid clinic ID

 +9        IF '+SDCL

               DO ERR^BSDXERR("Invalid Clinic ID.")

               QUIT

 +10       IF '$DATA(^SC(SDCL,0))

               DO ERR^BSDXERR("Invalid Clinic ID.")

               QUIT

 +11      ; data header

 +12      ; VAR_APPT_FLAG = flag  0=Clinic does not Allow Variable Appointment; 1=Clinic Allows Variable Appointment

 +13       SET ^BSDXTMP($JOB,0)="I00020VAR_APPT_FLAG"_$CHAR(30)

 +14      ;get VARIABLE APPOINTMENT FLAG for clinic

 +15      ;Variable Appointment Length

           SET VAL=$$GET1^DIQ(44,SDCL_",",1913)

 +16       SET VAL=$SELECT(VAL["YES":1,1:0)

 +17       SET BSDXI=BSDXI+1

 +18       SET ^BSDXTMP($JOB,BSDXI)=VAL

 +19       SET BSDXI=BSDXI+1

 +20       SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)

 +21       SET BSDXI=BSDXI+1

 +22       SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +23       QUIT

BSDX38.m