Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGSD1

BDGSD1.m

Go to the documentation of this file. 
  1. BDGSD1 ; IHS/ANMC/LJF - APPTS FOR CURRENT INPTS ; 
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1. ASK ;EP; ask user questions
  1.  ; Called by ^BDGSD when choice 2 is selected
  1.  NEW VAUTD,VAUTNI,VAUTC,VAUTW,BDGBD,BDGED
  1.  D ASK2^SDDIV Q:Y<0  S VAUTNI=1 D WARD^VAUTOMA
  1.  S VAUTNI=2 D CLINIC^VAUTOMA
  1.  S BDGBD=$$READ^BDGF("DO^::EX","Select Beginning Date") Q:BDGBD<1
  1.  S BDGED=$$READ^BDGF("DOA^"_BDGBD_"::EX","Select Ending Date:  ")
  1.  Q:BDGED<1
  1.  ;
  1.  I $$BROWSE^BDGF="B" D EN Q
  1.  D ZIS^BDGF("PQ","EN^BDGSD1","APPTS FOR CURRENT INPTS","VAU*;BDG*")
  1.  Q
  1.  ;
  1. EN ; -- main entry point for BDG INPT APPTS
  1.  I $E(IOST,1,2)="P-" D INIT,PRINT Q    ;if printing to paper
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG INPT APPTS")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(10)_"*** "_$$CONF^BDGF_" ***"
  1.  S X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
  1.  S VALMHDR(2)=$$SP(75-$L(X)\2)_X
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0
  1.  K ^TMP("BDGSD1",$J),^TMP("BDGSD1A",$J)
  1.  ;
  1.  ; find all patients in selected wards with appts
  1.  NEW WARD,DFN,DATE,CLINIC,END
  1.  S WARD=0 F  S WARD=$O(^DPT("CN",WARD)) Q:WARD=""  D
  1.  . I ('VAUTW),'$D(VAUTW(WARD)) Q    ;not in selected list
  1.  . S DFN=0 F  S DFN=$O(^DPT("CN",WARD,DFN)) Q:'DFN  D
  1.  .. ;
  1.  .. ; see if patient has appts within date range
  1.  .. S DATE=BDGBD-.0001,END=BDGED+.24
  1.  .. F  S DATE=$O(^DPT(DFN,"S",DATE)) Q:'DATE  Q:(DATE>END)  D
  1.  ... ;
  1.  ... S CLINIC=+$G(^DPT(DFN,"S",DATE,0)) Q:'CLINIC
  1.  ... I 'VAUTC,'$D(VAUTC(CLINIC)) Q    ;clinic not selected
  1.  ... ;
  1.  ... ; sort by ward then date/time
  1.  ... S ^TMP("BDGSD1A",$J,WARD,DATE,DFN)=""
  1.  ;
  1.  ;
  1.  ; put sorted list into display array
  1.  NEW WARD,DATE,DFN,LAST,LINE,NODE,X
  1.  S WARD=0 F  S WARD=$O(^TMP("BDGSD1A",$J,WARD)) Q:WARD=""  D
  1.  . ;
  1.  . ; display ward heading
  1.  . S X="*** "_WARD_" Ward ***" D SET($$SP(79-$L(X)\2)_X,.VALMCNT)
  1.  . ;
  1.  . S (DATE,LAST)=0
  1.  . F  S DATE=$O(^TMP("BDGSD1A",$J,WARD,DATE)) Q:'DATE  D
  1.  .. ;
  1.  .. ; display date when it changed
  1.  .. I $P(DATE,".")'=LAST D SET($$FMTE^XLFDT(DATE,"D"),.VALMCNT)
  1.  .. S LAST=DATE\1
  1.  .. ;         
  1.  .. S DFN=0 F  S DFN=$O(^TMP("BDGSD1A",$J,WARD,DATE,DFN)) Q:'DFN  D
  1.  ... ;
  1.  ... ; main data line
  1.  ... S NODE=$G(^DPT(DFN,"S",DATE,0))                       ;appt data
  1.  ... S LINE=$$PAD($$SP(3)_$$TIME^BDGF(DATE),13)            ;appt time
  1.  ... S LINE=LINE_$E($$GET1^DIQ(2,DFN,.01),1,20)            ;patient name
  1.  ... S LINE=$$PAD(LINE,35)_$J($$HRCN^BDGF2(DFN,DUZ(2)),7)  ;chart #
  1.  ... S LINE=$$PAD(LINE,48)_$$GET1^DIQ(44,+NODE,.01)        ;clinic
  1.  ... D SET(LINE,.VALMCNT)
  1.  ... ;
  1.  ... ; other info line
  1.  ... S LINE=$$SP(14)_$$OI^BSDU2(DFN,+NODE,DATE)             ;other info
  1.  ... S LINE=$$PAD(LINE,52)_"Appt Made "_$$FMTE^XLFDT($P(NODE,U,19),2)
  1.  ... D SET(LINE,.VALMCNT)
  1.  ... ;
  1.  ... ; ancillary tests, if any
  1.  ... I ($P(NODE,U,3)]"")!($P(NODE,U,4)]"")!($P(NODE,U,5)]"") D
  1.  .... S LINE=$$SP(10)
  1.  .... S X=$P(NODE,U,3) I X]"" S LINE=LINE_"Lab@"_$$FMTE^XLFDT(X)_" "
  1.  .... S X=$P(NODE,U,4) I X]"" S LINE=LINE_"Xray@"_$$FMTE^XLFDT(X)_" "
  1.  .... S X=$P(NODE,U,5) I X]"" S LINE=LINE_"EKG@"_$$FMTE^XLFDT(X)
  1.  .... D SET(LINE,.VALMCNT)
  1.  ... ;
  1.  ... D SET("",.VALMCNT)    ;blank line between patients
  1.  ;
  1.  I '$D(^TMP("BDGSD1",$J)) D SET("No data found",.VALMCNT)
  1.  ;
  1.  K ^TMP("BDGSD1A",$J)
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; put display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGSD1",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGSD1",$J) K BDGBD,BDGED,VAUTD,VAUTC,VAUTW
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. PRINT ; print to paper
  1.  NEW LINE,BDGPG
  1.  U IO D INIT^BDGF,HDG
  1.  S LINE=0 F  S LINE=$O(^TMP("BDGSD1",$J,LINE)) Q:'LINE  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BDGSD1",$J,LINE,0)
  1.  D ^%ZISC,PRTKL^BDGF,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading when printing to paper
  1.  S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
  1.  W !,BDGUSR,?16,$$CONF^BDGF
  1.  W !,BDGTIME,?23,"Appointments for Current Inpatients",?71,"Page: ",BDGPG
  1.  NEW X S X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
  1.  W !,BDGDATE,?(80-$L(X)\2),X
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !,"Appt",?13,"Patient Name",?35,"Chart #",?49,"Clinic"
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)