- 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 ;
