Routine: BSDPVD

BSDPVD ; IHS/ANMC/LJF - PROVIDER'S DAILY SCHEDULE ;

 ;;5.3;PIMS;**1005**;MAY 28, 2004

 ;IHS/OIT/LJF 03/09/2006 PATCH 1005 screen out cancelled appointments

 NEW BSDVW,BSDPRV,BSDDT

PROV ; -- select provider to display

 S BSDPRV=+$$READ^BDGF("PO^200:EMQZ","Select PROVIDER","","","I $$SCREEN^DGPMDD(+Y)")

 Q:BSDPRV<1

 D CLINICS      ;find all clinics linked to provider

 Q:'$D(^TMP("BSDPVD2",$J))

DAYWEEK ; -- select view by day or week

 S BSDVW=$$READ^BDGF("SO^D:DAILY;W:WEEKLY","Select DISPLAY TIMEFRAME")

 I "DW"'[BSDVW Q

 I BSDVW="W" D ^BSDPVW Q  ;weekly display

DATE ; -- select day to view

 S BSDDT=$$READ^BDGF("DO^::EX","Select DATE","TODAY") I BSDDT<1 D PROV Q

EN ;EP; -- main entry point for BSDAM PROVIDER DAY

 NEW VALMCNT

 D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDAM PROVIDER DAY")

 D CLEAR^VALM1

HDR ; -- header code

 S VALMHDR(1)=$$SP(15)_$$CONF^BDGF

 S VALMHDR(2)=$$SP(15)_"Appointments for "_$$GET1^DIQ(200,BSDPRV,.01)

 S VALMHDR(2)=VALMHDR(2)_" for "_$$FMTE^XLFDT(BSDDT,"D")

INIT ; -- init variables and list array

 S BSDLN=0

 K ^TMP("BSDPVD",$J),^TMP("BSDPVD1",$J)

 ; loop thru provider's clinics and then appts for date

 NEW CLN,CLNM,IEN,DATE,END,NODE

 S CLN=0 F  S CLN=$O(^TMP("BSDPVD2",$J,CLN)) Q:'CLN  D

 . S CLNM=^TMP("BSDPVD2",$J,CLN)

. ;

 . S DATE=BSDDT-.0001,END=BSDDT_".2400"

 . F  S DATE=$O(^SC(CLN,"S",DATE))  Q:'DATE  Q:(DATE>END)  D

 .. S IEN=0 F  S IEN=$O(^SC(CLN,"S",DATE,1,IEN)) Q:'IEN  D

 ... ;

 ... ; sort by date,clinic; save clinic ien, patient, length, info

 ... S NODE=$G(^SC(CLN,"S",DATE,1,IEN,0)) Q:'NODE

 ... Q:$P(NODE,U,9)="C"                 ;skip if appt cancelled;IHS/OIT/LJF 03/09/2006 PATCH 1005

 ... S ^TMP("BSDPVD1",$J,DATE,CLNM,IEN)=$P(NODE,U,1,4)_U_CLN_U_$G(^SC(CLN,"S",DATE,1,IEN,"OB"))

 I '$D(^TMP("BSDPVD1",$J)) D SET("NO APPTS FOR PROVIDER","",0,.BSDLN) S VALMCNT=1 Q

 ; put sorted list into display array

 NEW DATE,CLN,IEN,DATA,BSDCNT,LINE,X,I,LAST,ENDTM

 S DATE=0 F  S DATE=$O(^TMP("BSDPVD1",$J,DATE)) Q:'DATE  D

 . S CLN=0 F  S CLN=$O(^TMP("BSDPVD1",$J,DATE,CLN)) Q:CLN=""  D

 .. S IEN=0 F  S IEN=$O(^TMP("BSDPVD1",$J,DATE,CLN,IEN)) Q:'IEN  D

 ... S DATA=^TMP("BSDPVD1",$J,DATE,CLN,IEN)

 ... S BSDCNT=$G(BSDCNT)+1                                      ;number on display page

 ... S LINE=$J(BSDCNT,2)_". "_$P($$FMTE^XLFDT(DATE,2),"@",2)    ;appt time

 ... S ENDTM=$P($$FMTE^XLFDT($$FMADD^XLFDT(DATE,0,0,$P(DATA,U,2))),"@",2)

 ... S LINE=LINE_"-"_ENDTM_$TR($P(DATA,U,6),"O","*")            ;end time/overbk

 ... S LINE=$$PAD(LINE,17)_$E(CLN,1,11)                         ;end time & clinic

 ... S LINE=$$PAD(LINE,30)_$E($$NAMEPRT^BDGF2(+DATA,0),1,18)    ;patient

 ... S LINE=$$PAD(LINE,50)_$E($P(DATA,U,4),1,29)                ;appt info

 ... ;

 ... ; add extra lines if end time diff hour from last appt

 ... I $D(LAST) D

 .... S X=$E($P(DATE,".",2),1,2)-$E(LAST,1,2)   ;difference in hours

 .... F I=1:1:X D SET("","",.BSDCNT,.BSDLN)     ;determines # of lines

 ... S LAST=ENDTM   ;save end time to compare with next appt

 ... ;

 ... ; now print this appt

 ... D SET(LINE,(+DATA)_U_$P(DATA,U,5)_U_DATE,.BSDCNT,.BSDLN)

 S VALMCNT=BSDLN

 K ^TMP("BSDPVD1",$J)

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ; -- exit code

 K ^TMP("BSDPVD",$J),^TMP("BSDPVD2",$J),VALMCNT

EXPND ; -- expand code

SET(DATA,IENS,COUNT,LINE) ; -- put data into display array

 S LINE=LINE+1                      ;line number

 S ^TMP("BSDPVD",$J,LINE,0)=DATA

 S ^TMP("BSDPVD",$J,"IDX",LINE,COUNT)=IENS

CLINICS ;EP; -- sets ^tmp for provider's clinics

 ; called by ^BDGPV to display provider's appts

 ; If BSDQUIET is set & >0 no messages display on screen

 NEW CLN,IEN,NAME

 K ^TMP("BSDPVD2",$J)

 S CLN=0 F  S CLN=$O(^SC("AIHSDPR",BSDPRV,CLN)) Q:'CLN  D

 . S IEN=0 F  S IEN=$O(^SC("AIHSDPR",BSDPRV,CLN,IEN)) Q:'IEN  D

 .. I ^SC("AIHSDPR",BSDPRV,CLN,IEN)'=1 Q   ;not default provider

 .. S NAME=$$GET1^DIQ(44,CLN,.01)

 .. S ^TMP("BSDPVD2",$J,CLN)=NAME

 .. Q:$G(BSDQUIET)   ;no writing to screen

 .. I '$D(^TMP("BSDPVD2",$J)) D MSG^BDGF($$SP(15)_"Provider's Clinics:",2,0)

 .. D MSG^BDGF($$SP(18)_NAME,1,0)

 Q:$G(BSDQUIET)

 I '$D(^TMP("BSDPVD2",$J)) D MSG^BDGF("NO clinics found for provider!",2,1)

 E  D MSG^BDGF("",1,0)

PAD(D,L) ;EP -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

BSDPVD    ; IHS/ANMC/LJF - PROVIDER'S DAILY SCHEDULE ;

 +1       ;;5.3;PIMS;**1005**;MAY 28, 2004

 +2       ;IHS/OIT/LJF 03/09/2006 PATCH 1005 screen out cancelled appointments

 +3       ;

 +4        NEW BSDVW,BSDPRV,BSDDT

PROV      ; -- select provider to display

 +1        SET BSDPRV=+$$READ^BDGF("PO^200:EMQZ","Select PROVIDER","","","I $$SCREEN^DGPMDD(+Y)")

 +2        IF BSDPRV<1

               QUIT

 +3       ;find all clinics linked to provider

           DO CLINICS

 +4        IF '$DATA(^TMP("BSDPVD2",$JOB))

               QUIT

 +5       ;

DAYWEEK   ; -- select view by day or week

 +1        SET BSDVW=$$READ^BDGF("SO^D:DAILY;W:WEEKLY","Select DISPLAY TIMEFRAME")

 +2        IF "DW"'[BSDVW

               QUIT

 +3       ;weekly display

           IF BSDVW="W"

               DO ^BSDPVW

               QUIT

 +4       ;

DATE      ; -- select day to view

 +1        SET BSDDT=$$READ^BDGF("DO^::EX","Select DATE","TODAY")

           IF BSDDT<1

               DO PROV

               QUIT

 +2       ;

 +3       ;

EN        ;EP; -- main entry point for BSDAM PROVIDER DAY

 +1        NEW VALMCNT

 +2        DO TERM^VALM0

           DO CLEAR^VALM1

 +3        DO EN^VALM("BSDAM PROVIDER DAY")

 +4        DO CLEAR^VALM1

 +5        QUIT

 +6       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF

 +2        SET VALMHDR(2)=$$SP(15)_"Appointments for "_$$GET1^DIQ(200,BSDPRV,.01)

 +3        SET VALMHDR(2)=VALMHDR(2)_" for "_$$FMTE^XLFDT(BSDDT,"D")

 +4        QUIT

 +5       ;

INIT      ; -- init variables and list array

 +1        SET BSDLN=0

 +2        KILL ^TMP("BSDPVD",$JOB),^TMP("BSDPVD1",$JOB)

 +3       ;

 +4       ; loop thru provider's clinics and then appts for date

 +5        NEW CLN,CLNM,IEN,DATE,END,NODE

 +6        SET CLN=0

FOR

               SET CLN=$ORDER(^TMP("BSDPVD2",$JOB,CLN))

               IF 'CLN

                   QUIT

               Begin DoDot:1

 +7                SET CLNM=^TMP("BSDPVD2",$JOB,CLN)

 +8       ;

 +9                SET DATE=BSDDT-.0001

                   SET END=BSDDT_".2400"

 +10               FOR

                       SET DATE=$ORDER(^SC(CLN,"S",DATE))

                       IF 'DATE

                           QUIT

                       IF (DATE>END)

                           QUIT

                       Begin DoDot:2

 +11                       SET IEN=0

FOR

                               SET IEN=$ORDER(^SC(CLN,"S",DATE,1,IEN))

                               IF 'IEN

                                   QUIT

                               Begin DoDot:3

 +12      ;

 +13      ; sort by date,clinic; save clinic ien, patient, length, info

 +14                               SET NODE=$GET(^SC(CLN,"S",DATE,1,IEN,0))

                                   IF 'NODE

                                       QUIT

 +15      ;skip if appt cancelled;IHS/OIT/LJF 03/09/2006 PATCH 1005

                                   IF $PIECE(NODE,U,9)="C"

                                       QUIT

 +16                               SET ^TMP("BSDPVD1",$JOB,DATE,CLNM,IEN)=$PIECE(NODE,U,1,4)_U_CLN_U_$GET(^SC(CLN,"S",DATE,1,IEN,"OB"))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +17      ;

 +18       IF '$DATA(^TMP("BSDPVD1",$JOB))

               DO SET("NO APPTS FOR PROVIDER","",0,.BSDLN)

               SET VALMCNT=1

               QUIT

 +19      ;

 +20      ; put sorted list into display array

 +21       NEW DATE,CLN,IEN,DATA,BSDCNT,LINE,X,I,LAST,ENDTM

 +22       SET DATE=0

FOR

               SET DATE=$ORDER(^TMP("BSDPVD1",$JOB,DATE))

               IF 'DATE

                   QUIT

               Begin DoDot:1

 +23               SET CLN=0

FOR

                       SET CLN=$ORDER(^TMP("BSDPVD1",$JOB,DATE,CLN))

                       IF CLN=""

                           QUIT

                       Begin DoDot:2

 +24                       SET IEN=0

FOR

                               SET IEN=$ORDER(^TMP("BSDPVD1",$JOB,DATE,CLN,IEN))

                               IF 'IEN

                                   QUIT

                               Begin DoDot:3

 +25                               SET DATA=^TMP("BSDPVD1",$JOB,DATE,CLN,IEN)

 +26      ;number on display page

                                   SET BSDCNT=$GET(BSDCNT)+1

 +27      ;appt time

                                   SET LINE=$JUSTIFY(BSDCNT,2)_". "_$PIECE($$FMTE^XLFDT(DATE,2),"@",2)

 +28                               SET ENDTM=$PIECE($$FMTE^XLFDT($$FMADD^XLFDT(DATE,0,0,$PIECE(DATA,U,2))),"@",2)

 +29      ;end time/overbk

                                   SET LINE=LINE_"-"_ENDTM_$TRANSLATE($PIECE(DATA,U,6),"O","*")

 +30      ;end time & clinic

                                   SET LINE=$$PAD(LINE,17)_$EXTRACT(CLN,1,11)

 +31      ;patient

                                   SET LINE=$$PAD(LINE,30)_$EXTRACT($$NAMEPRT^BDGF2(+DATA,0),1,18)

 +32      ;appt info

                                   SET LINE=$$PAD(LINE,50)_$EXTRACT($PIECE(DATA,U,4),1,29)

 +33      ;

 +34      ; add extra lines if end time diff hour from last appt

 +35                               IF $DATA(LAST)

                                       Begin DoDot:4

 +36      ;difference in hours

                                           SET X=$EXTRACT($PIECE(DATE,".",2),1,2)-$EXTRACT(LAST,1,2)

 +37      ;determines # of lines

                                           FOR I=1:1:X

                                               DO SET("","",.BSDCNT,.BSDLN)

                                       End DoDot:4

 +38      ;save end time to compare with next appt

                                   SET LAST=ENDTM

 +39      ;

 +40      ; now print this appt

 +41                               DO SET(LINE,(+DATA)_U_$PIECE(DATA,U,5)_U_DATE,.BSDCNT,.BSDLN)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +42      ;

 +43       SET VALMCNT=BSDLN

 +44       KILL ^TMP("BSDPVD1",$JOB)

 +45       QUIT

 +46      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BSDPVD",$JOB),^TMP("BSDPVD2",$JOB),VALMCNT

 +2        QUIT

 +3       ;

EXPND     ; -- expand code

 +1        QUIT

 +2       ;

SET(DATA,IENS,COUNT,LINE) ; -- put data into display array

 +1       ;line number

           SET LINE=LINE+1

 +2        SET ^TMP("BSDPVD",$JOB,LINE,0)=DATA

 +3        SET ^TMP("BSDPVD",$JOB,"IDX",LINE,COUNT)=IENS

 +4        QUIT

 +5       ;

CLINICS   ;EP; -- sets ^tmp for provider's clinics

 +1       ; called by ^BDGPV to display provider's appts

 +2       ; If BSDQUIET is set & >0 no messages display on screen

 +3       ;

 +4        NEW CLN,IEN,NAME

 +5        KILL ^TMP("BSDPVD2",$JOB)

 +6        SET CLN=0

FOR

               SET CLN=$ORDER(^SC("AIHSDPR",BSDPRV,CLN))

               IF 'CLN

                   QUIT

               Begin DoDot:1

 +7                SET IEN=0

FOR

                       SET IEN=$ORDER(^SC("AIHSDPR",BSDPRV,CLN,IEN))

                       IF 'IEN

                           QUIT

                       Begin DoDot:2

 +8       ;not default provider

                           IF ^SC("AIHSDPR",BSDPRV,CLN,IEN)'=1

                               QUIT

 +9                        SET NAME=$$GET1^DIQ(44,CLN,.01)

 +10                       SET ^TMP("BSDPVD2",$JOB,CLN)=NAME

 +11      ;no writing to screen

                           IF $GET(BSDQUIET)

                               QUIT

 +12                       IF '$DATA(^TMP("BSDPVD2",$JOB))

                               DO MSG^BDGF($$SP(15)_"Provider's Clinics:",2,0)

 +13                       DO MSG^BDGF($$SP(18)_NAME,1,0)

                       End DoDot:2

               End DoDot:1

 +14       IF $GET(BSDQUIET)

               QUIT

 +15       IF '$DATA(^TMP("BSDPVD2",$JOB))

               DO MSG^BDGF("NO clinics found for provider!",2,1)

 +16      IF '$TEST

               DO MSG^BDGF("",1,0)

 +17       QUIT

 +18      ;

PAD(D,L)  ;EP -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)

BSDPVD.m