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

BSDWKR2.m

Go to the documentation of this file. 
  1. BSDWKR2 ; IHS/ANMC/LJF - WORKLOAD LISTING ;  [ 04/12/2004  3:24 PM ]
  1.  ;;5.3;PIMS;**1007**;APR 26, 2002
  1.  ;
  1. ASK ; -- ask user questions
  1.  NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT
  1.  ;
  1.  S BSDSUB=$$READ^BDGF("SO^C:Clinic;P:Principal Clinic;V:Provider;T:Team","Subtotal Report by","","^D HELP1^BSDWKR1")
  1.  Q:BSDSUB=""  Q:BSDSUB=U
  1.  ;
  1.  ; get clinic arrays based on subtotal category
  1.  I (BSDSUB="C")!(BSDSUB="P") D CLINIC^BSDU(2) Q:$D(BSDQ)
  1.  I (BSDSUB="V")!(BSDSUB="T") D PCASK^BSDU(2,BSDSUB) Q:$D(BSDQ)
  1.  ;
  1.  S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") Q:'BSDBD
  1.  S BSDED=$$READ^BDGF("DO^"_BSDBD_"::EX","Select Last Date to Search") Q:'BSDED  ;cmi/anch/maw 3/16/2007 added for end date cannot be before begin date patch 1007
  1.  ;
  1.  S Y=$$BROWSE^BDGF Q:"PB"'[Y  I Y="B" D EN Q  ;browse in list mgr mode
  1.  D ZIS^BDGF("PQ","START^BSDWKR2","WORKLOAD LISTINGS","BSDSUB;BSDBD;BSDED;VAUTC*;VAUTD*")
  1.  Q
  1.  ;
  1. START ;EP; -- re-entry for printing to paper
  1.  D INIT,PRINT Q
  1.  ;
  1. EN ; -- main entry point for BSDRM WORKLOAD LIST
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM WORKLOAD LIST")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)=$$SP(18)_$$CONF^BSDU
  1.  S VALMHDR(2)=$$SP(25)_"Appointments by Clinic and Date"
  1.  S VALMHDR(3)=$$SP(20)_"(does not include no-shows or cancellations)"
  1.  S VALMHDR(4)=$$SP(22)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDWKR2",$J),^TMP("BSD",$J)
  1.  NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
  1.  ;
  1.  ; -- loop by clinic
  1.  NEW CLN,NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,END,LINE
  1.  S CLN=0 F  S CLN=$O(@BSDAR@(CLN)) Q:'CLN  D
  1.  . Q:$D(^SC("AIHSPC",CLN))               ;quit if principal clinic
  1.  . S NAME=$$GET1^DIQ(44,CLN,.01)         ;set clinic's name
  1.  . S SUB=$$SUB1^BSDWKR1(CLN,NAME)        ;get subcategory for clinic
  1.  . ;
  1.  . ; -- then by appt date (within range)
  1.  . S APPT=BSDBD,END=BSDED+.2400
  1.  . F  S APPT=$O(^SC(CLN,"S",APPT)) Q:'APPT!(APPT>END)  D
  1.  .. ;
  1.  .. ; -- then find appts to count
  1.  .. S APPN=0
  1.  .. F  S APPN=$O(^SC(CLN,"S",APPT,1,APPN)) Q:'APPN  D
  1.  ... S PAT=+^SC(CLN,"S",APPT,1,APPN,0)                ;patient ien
  1.  ... S STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100)     ;current status
  1.  ... Q:STATUS["NO-SHOW"  Q:STATUS["CANCEL"  Q:STATUS="FUTURE"
  1.  ... Q:STATUS="NON-COUNT"  Q:STATUS="DELETED"
  1.  ... S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)          ;type of appt
  1.  ... ;
  1.  ... ; put appts into display array
  1.  ... S LINE=$$PAD($$FMTE^XLFDT(APPT),22)                   ;appt date
  1.  ... S LINE=$$PAD(LINE_TYPE,33)                            ;appt type
  1.  ... S LINE=LINE_$J($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7)   ;chart#
  1.  ... S LINE=$$PAD(LINE,43)_$$GET1^DIQ(2,PAT,.02,"I")       ;sex
  1.  ... S LINE=$$PAD(LINE,48)_$$GET1^DIQ(2,PAT,.033)          ;age
  1.  ... S LINE=$$PAD(LINE,57)_STATUS                          ;appt status
  1.  ... S ^TMP("BSD",$J,SUB,NAME,APPT)=LINE  ;sort by category,clinic,date
  1.  ;
  1.  ; put sorted list into display array
  1.  NEW S1,S2,S3
  1.  S S1=0 F  S S1=$O(^TMP("BSD",$J,S1)) Q:S1=""  D
  1.  . D SET(S1,.VALMCNT)
  1.  . S S2=0 F  S S2=$O(^TMP("BSD",$J,S1,S2)) Q:S2=""  D
  1.  .. I S1'=S2 D SET($$SP(2)_S2,.VALMCNT)
  1.  .. S S3=0 F  S S3=$O(^TMP("BSD",$J,S1,S2,S3)) Q:S3=""  D
  1.  ... D SET(^TMP("BSD",$J,S1,S2,S3),.VALMCNT)
  1.  .. I S1'=S2 D SET("",.VALMCNT)
  1.  . D SET("",.VALMCNT)
  1.  ;
  1.  K ^TMP("BSD",$J)
  1.  Q
  1.  ;
  1. TYPE(C,D,N,P,S) ; return type of appt
  1.  ; returns sched, same day, walk-in, overbook, inpt
  1.  I S["INPAT" Q "Inpatient"
  1.  I $G(^SC(C,"S",D,1,N,"OB"))="O" Q "Overbook"
  1.  NEW X S X=$$VALI^XBDIQ1(2.98,P_","_D,9) I X=4 Q "Walkin"
  1.  I X=3,(D\1)=($P($G(^DPT(P,"S",D,0)),U,19)\1) Q "Same Day"
  1.  I X=3 Q "Scheduled"
  1.  Q "??"    ;error in case one slips thru
  1.  ;
  1. SET(LINE,NUM) ; set line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDWKR2",$J,NUM,0)=LINE
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDWKR2",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. PRINT ; print report to paper
  1.  U IO D HDG
  1.  NEW LINE
  1.  S LINE=0 F  S LINE=$O(^TMP("BSDWKR2",$J,LINE)) Q:'LINE  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDWKR2",$J,LINE,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  D HDR W @IOF,?30,"Workload Listings"
  1.  NEW I F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !,"Appt Date",?22,"Type",?33,"Chart #",?43,"Sex",?48,"Age",?57,"Status"
  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)