BSDPVW ; IHS/ANMC/LJF - PROVIDER WEEKLY SCHEDULE ;
;;5.3;PIMS;;APR 26, 2002
;
WEEK ; -- select week by picking any date within that week
NEW BSDDT
S BSDDT=$$READ^BDGF("DO^::EX","Select DATE","TODAY","D DTHELP^BSDPVW")
Q:BSDDT<1
;
;
EN ; -- main entry point for BSDAM PROVIDER WEEK
NEW VALMCNT
D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDAM PROVIDER WEEK")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(10)_"Appointments for "_$$GET1^DIQ(200,BSDPRV,.01)
S VALMHDR(1)=VALMHDR(1)_" for week of "_$$FMTE^XLFDT(BSDDT)
Q
;
INIT ; -- init variables and list array
K ^TMP("BSDPVD",$J),^TMP("BSDPVD1",$J)
S VALMCNT=0
;
; loop thru provider's clinics and then appts for date range
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=$$FMADD^XLFDT(BSDDT,7)_".24"
. 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
... 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,.VALMCNT) Q
;
; put sorted list into display array
NEW DATE,CLN,IEN,DATA,BSDCNT,LINE,X,I,LASTTM,ENDTM,LASTDT
S (DATE,LASTDT)=0,BSDCNT=1
F S DATE=$O(^TMP("BSDPVD1",$J,DATE)) Q:'DATE D
. ;
. ; mark beginning of new date
. I (DATE\1)'=LASTDT D
.. I +$G(LASTDT)'=0 D SET("","",BSDCNT,.VALMCNT) ;extra line
.. S X="Appointments for "_$$FMTE^XLFDT(DATE,"D")
.. D SET($$SP(79-$L(X)\2)_X,"",BSDCNT,.VALMCNT)
.. S LASTDT=DATE\1
. ;
. 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 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(LASTTM) D
.... S X=$E($P(DATE,".",2),1,2)-$E(LASTTM,1,2) ;difference in hours
.... F I=1:1:X D SET("","",BSDCNT,.VALMCNT) ;determines # of lines
... S LASTTM=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,.VALMCNT)
... S BSDCNT=$G(BSDCNT)+1 ;number on display page
;
K ^TMP("BSDPVD1",$J)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BSDPVD2",$J),^TMP("BSDPVD",$J)
Q
;
EXPND ; -- expand code
Q
;
DTHELP ;EP; help for date range question
D MSG^BDGF("Enter the beginning date for the report.",2,0)
D MSG^BDGF("The display will display appointments for that date",1,0)
D MSG^BDGF("and the next 6 for a week's worth.",1,1)
Q
;
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)
;
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
Q
;
BSDPVW ; IHS/ANMC/LJF - PROVIDER WEEKLY SCHEDULE ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
WEEK ; -- select week by picking any date within that week
+1 NEW BSDDT
+2 SET BSDDT=$$READ^BDGF("DO^::EX","Select DATE","TODAY","D DTHELP^BSDPVW")
+3 IF BSDDT<1
QUIT
+4 ;
+5 ;
EN ; -- main entry point for BSDAM PROVIDER WEEK
+1 NEW VALMCNT
+2 DO TERM^VALM0
DO CLEAR^VALM1
+3 DO EN^VALM("BSDAM PROVIDER WEEK")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(10)_"Appointments for "_$$GET1^DIQ(200,BSDPRV,.01)
+2 SET VALMHDR(1)=VALMHDR(1)_" for week of "_$$FMTE^XLFDT(BSDDT)
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("BSDPVD",$JOB),^TMP("BSDPVD1",$JOB)
+2 SET VALMCNT=0
+3 ;
+4 ; loop thru provider's clinics and then appts for date range
+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=$$FMADD^XLFDT(BSDDT,7)_".24"
+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 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
+16 ;
+17 IF '$DATA(^TMP("BSDPVD1",$JOB))
DO SET("NO APPTS FOR PROVIDER","",0,.VALMCNT)
QUIT
+18 ;
+19 ; put sorted list into display array
+20 NEW DATE,CLN,IEN,DATA,BSDCNT,LINE,X,I,LASTTM,ENDTM,LASTDT
+21 SET (DATE,LASTDT)=0
SET BSDCNT=1
+22 FOR
SET DATE=$ORDER(^TMP("BSDPVD1",$JOB,DATE))
IF 'DATE
QUIT
Begin DoDot:1
+23 ;
+24 ; mark beginning of new date
+25 IF (DATE\1)'=LASTDT
Begin DoDot:2
+26 ;extra line
IF +$GET(LASTDT)'=0
DO SET("","",BSDCNT,.VALMCNT)
+27 SET X="Appointments for "_$$FMTE^XLFDT(DATE,"D")
+28 DO SET($$SP(79-$LENGTH(X)\2)_X,"",BSDCNT,.VALMCNT)
+29 SET LASTDT=DATE\1
End DoDot:2
+30 ;
+31 SET CLN=0
FOR
SET CLN=$ORDER(^TMP("BSDPVD1",$JOB,DATE,CLN))
IF CLN=""
QUIT
Begin DoDot:2
+32 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("BSDPVD1",$JOB,DATE,CLN,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+33 SET DATA=^TMP("BSDPVD1",$JOB,DATE,CLN,IEN)
+34 ;appt time
SET LINE=$JUSTIFY(BSDCNT,2)_". "_$PIECE($$FMTE^XLFDT(DATE,2),"@",2)
+35 SET ENDTM=$PIECE($$FMTE^XLFDT($$FMADD^XLFDT(DATE,0,0,$PIECE(DATA,U,2))),"@",2)
+36 ;end time/overbk
SET LINE=LINE_"-"_ENDTM_$TRANSLATE($PIECE(DATA,U,6),"O","*")
+37 ;end time & clinic
SET LINE=$$PAD(LINE,17)_$EXTRACT(CLN,1,11)
+38 ;patient
SET LINE=$$PAD(LINE,30)_$EXTRACT($$NAMEPRT^BDGF2(+DATA,0),1,18)
+39 ;appt info
SET LINE=$$PAD(LINE,50)_$EXTRACT($PIECE(DATA,U,4),1,29)
+40 ;
+41 ; add extra lines if end time diff hour from last appt
+42 IF $DATA(LASTTM)
Begin DoDot:4
+43 ;difference in hours
SET X=$EXTRACT($PIECE(DATE,".",2),1,2)-$EXTRACT(LASTTM,1,2)
+44 ;determines # of lines
FOR I=1:1:X
DO SET("","",BSDCNT,.VALMCNT)
End DoDot:4
+45 ;save end time to compare with next appt
SET LASTTM=ENDTM
+46 ;
+47 ; now print this appt
+48 DO SET(LINE,(+DATA)_U_$PIECE(DATA,U,5)_U_DATE,BSDCNT,.VALMCNT)
+49 ;number on display page
SET BSDCNT=$GET(BSDCNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+50 ;
+51 KILL ^TMP("BSDPVD1",$JOB)
+52 QUIT
+53 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BSDPVD2",$JOB),^TMP("BSDPVD",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
DTHELP ;EP; help for date range question
+1 DO MSG^BDGF("Enter the beginning date for the report.",2,0)
+2 DO MSG^BDGF("The display will display appointments for that date",1,0)
+3 DO MSG^BDGF("and the next 6 for a week's worth.",1,1)
+4 QUIT
+5 ;
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)
+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 ;
