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

BSDWKR3.m

Go to the documentation of this file. 
  1. BSDWKR3 ; IHS/ANMC/LJF - WORKLOAD COMPARISONS ;  [ 01/05/2005  8:10 AM ]
  1.  ;;5.3;PIMS;**1001,1007**;APR 26, 2002
  1.  ;
  1.  ;cmi/anch/maw 2/15/2007 added sort by clinic code PATCH 1007 item 1007.26
  1.  ;
  1. ASK ; -- ask user questions
  1.  NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,Y,BSDSEEN
  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.  ;cmi/anch/maw 2/15/2007 PATCH 1007 item 1007.26 added to ask for clinic code sort
  1.  N BSDCC
  1.  S BSDCC=$$READ^BDGF("Y","Sort by Clinic Code","NO")
  1.  ;
  1.  S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") Q:'BSDBD
  1.  S BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search") Q:'BSDED
  1.  ;
  1.  S BSDSEEN=$$READ^BDGF("YO","Assume Patient Seen if Appt NOT Checked In","NO","^D HELP2^BSDWKR1") Q:BSDSEEN=""  Q:BSDSEEN=U
  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^BSDWKR3","WORKLOAD COMPARISONS","BSDSUB;BSDSEEN;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 COMPARISONS
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM WORKLOAD COMPARISONS")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)=$$SP(15)_"Monthly Comparisons on Completed Appointments by Type"
  1.  S VALMHDR(2)=$$SP(22)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
  1.  S VALMHDR(3)=$$SP(18)_"and corresponding dates from the previous year"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDWKR3",$J),^TMP("BSD",$J)
  1.  NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
  1.  ;
  1.  ; -- loop by clinic
  1.  NEW CLN,X,Y
  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 X=$O(^SC(CLN,"S",(BSDBD-.0001)))    ;next appt in date range
  1.  . S Y=$O(^SC(CLN,"S",($$LAST(BSDBD)-.0001)))  ;appt for last year
  1.  . I 'X,'Y Q                             ;quit if no appts
  1.  . Q:X>(BSDED+.24)                       ;quit if next appt after end
  1.  . ;
  1.  . ; run thru each date range and increment totals
  1.  . D INIT2(CLN,BSDBD,BSDED,1)
  1.  . D INIT2(CLN,$$LAST(BSDBD),$$LAST(BSDED),0)
  1.  . ;
  1.  . ; initialize ^tmp subtotals by month for those with no data
  1.  . D SETTMP(CLN,BSDBD,BSDED)
  1.  . ;
  1.  ;
  1.  ; put totals into display array
  1.  NEW S1,S2,S3,S4,LINE,I,LINE2,LINE3
  1.  S S1=0 F  S S1=$O(^TMP("BSD",$J,S1)) Q:S1=""  D
  1.  . ;
  1.  . D SET(S1,.VALMCNT)                   ;subtotal category name
  1.  . ;
  1.  . ; get monthly totals for category
  1.  . S S2=0 F  S S2=$O(^TMP("BSD",$J,S1,0,0,S2)) Q:S2=""  D
  1.  .. S S3=0 F  S S3=$O(^TMP("BSD",$J,S1,0,0,S2,S3)) Q:S3=""  D
  1.  ... S LINE=$$PAD($$SP(3)_$$FMTE^XLFDT(S3),25)   ;month/yr
  1.  ... ;
  1.  ... ; line up 5 type of appt columns
  1.  ... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,0,S2,S3)),6)
  1.  ... S LINE=$$PAD(LINE,73)_$J(^TMP("BSD",$J,S1,0,0,S2,S3),6)  ;total
  1.  ... D SET(LINE,.VALMCNT)
  1.  ... ;
  1.  ... ;net change & % change; returns LINE2, LINE3
  1.  ... I S2'=S3 D NET(S1,0,S2,S3)
  1.  ... I S2=S3 D SET(LINE2,.VALMCNT),SET(LINE3,.VALMCNT),SET("",.VALMCNT)
  1.  .. ;
  1.  . ;
  1.  . ; totals by clinic
  1.  . S S2=0 F  S S2=$O(^TMP("BSD",$J,S1,0,S2)) Q:S2=""  D
  1.  .. Q:S1=S2      ;if sort by clinic, don't repeat data
  1.  .. D SET($$SP(3)_S2,.VALMCNT)            ;clinic name
  1.  .. ;
  1.  .. S S3=0 F  S S3=$O(^TMP("BSD",$J,S1,0,S2,S3)) Q:S3=""  D
  1.  ... S S4=0 F  S S4=$O(^TMP("BSD",$J,S1,0,S2,S3,S4)) Q:S4=""  D
  1.  .... S LINE=$$PAD($$SP(5)_$$FMTE^XLFDT(S4),25)   ;month/yr
  1.  .... ;
  1.  .... ; line up 5 type of appt columns
  1.  .... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,S2,S3,S4)),6)
  1.  .... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,S2,S3,S4)),6)
  1.  .... D SET(LINE,.VALMCNT)
  1.  .... ;
  1.  .... ; net change & % change; returns LINE2, LINE3
  1.  .... I S3'=S4 D NET(S1,S2,S3,S4)
  1.  .... I S3=S4 D SET(LINE2,.VALMCNT),SET(LINE3,.VALMCNT),SET("",.VALMCNT)
  1.  ;
  1.  K ^TMP("BSD",$J)
  1.  Q
  1.  ;
  1. INIT2(CLN,BEG,END,FIRST) ; loop by date and increment totals
  1.  NEW NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,SUB2,MON
  1.  S NAME=$$GET1^DIQ(44,CLN,.01)         ;set clinic's name
  1.  S SUB=$$SUB1(CLN,NAME)                ;get subcategory for clinic
  1.  ;
  1.  S APPT=BEG,END=END+.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.  .. I BSDSEEN=0 Q:STATUS="NO ACTION TAKEN"
  1.  .. ;
  1.  .. S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)      ;type of appt
  1.  .. ;
  1.  .. ; sort by comparison months in order (2991000,2981000)
  1.  .. S MON=$E(APPT,1,5)_"00"    ;month for appt
  1.  .. ; appt month for date range chosen
  1.  .. S SUB2=$S(FIRST:MON,1:($E(MON,1,3)+1)_$E(MON,4,7))
  1.  .. ; increment totals
  1.  .. D INCR(SUB,TYPE,NAME,SUB2,MON)
  1.  Q
  1.  ;
  1. LAST(DATE) ; returns month and previous year
  1.  Q ($E(DATE,1,3)-1)_$E(DATE,4,7)
  1.  ;
  1. SUB1(C,N) ; -- return name of subcategory for clinic C 
  1.  I BSDSUB="P" Q $$PRIN^BSDU(CLN)
  1.  I BSDSUB="V" Q $P($$PRV^BSDU(CLN),U,2)
  1.  I BSDSUB="T" Q $P($$TEAM^BSDU(CLN),U,2)
  1.  Q N
  1.  ;
  1. TYPE(C,D,N,P,S) ; -- return type of appt.
  1.  ; returns column #: 1=sched, 2=same day, 3=walk-in, 4=overbook, 5=inpt
  1.  I S["INPAT" Q 5                                     ;inpatient
  1.  I $G(^SC(C,"S",D,1,N,"OB"))="O" Q 4                 ;overbook
  1.  NEW X S X=$$VALI^XBDIQ1(2.98,P_","_D,9) I X=4 Q 3   ;walkin
  1.  I X=3,(D\1)=($P($G(^DPT(P,"S",D,0)),U,19)\1) Q 2    ;same day appt
  1.  I X=3 Q 1                                           ;scheduled
  1.  Q "??"    ;error in case one slips thru
  1.  ;
  1. SETTMP(CLINIC,BEG,END) ; initialize ^tmp by month
  1.  NEW MON,X,SUB,NAME
  1.  S NAME=$$GET1^DIQ(44,CLN,.01)  ;clinic name
  1.  S SUB=$$SUB1(CLN,NAME)         ;subcategory name
  1.  S MON=$E(BEG,1,5)_"00"         ;beginning month
  1.  ;cmi/anch/maw 2/15/2007, changed sub to clinic code for sort if selected PATCH 1007, item 1007.26
  1.  I $G(BSDCC) D
  1.  . S CLNC=$$GET1^DIQ(44,CLN,8)  ;clinic code
  1.  . N CLNCI,CLNCC
  1.  . S CLNCI=$$GET1^DIQ(44,CLN,8,"I")
  1.  . S CLNCC=$P($G(^DIC(40.7,CLNCI,0)),U,2)
  1.  . S SUB=CLNCC_" - "_CLNC
  1.  ;
  1.  ; for each month, fill in ^tmp for each type
  1.  F  Q:MON>($E(END,1,5)_"00")  D
  1.  . F I=0:1:5 D
  1.  .. S ^TMP("BSD",$J,SUB,I,0,MON,MON)=+$G(^TMP("BSD",$J,SUB,I,0,MON,MON))
  1.  .. S ^TMP("BSD",$J,SUB,I,0,MON,$$LAST(MON))=+$G(^TMP("BSD",$J,SUB,I,0,MON,$$LAST(MON)))
  1.  .. S ^TMP("BSD",$J,SUB,I,NAME,MON,MON)=+$G(^TMP("BSD",$J,SUB,I,NAME,MON,MON))
  1.  .. S ^TMP("BSD",$J,SUB,I,NAME,MON,$$LAST(MON))=+$G(^TMP("BSD",$J,SUB,I,NAME,MON,$$LAST(MON)))
  1.  . S X=$E(MON,4,5)+1 S:X>12 X=X-12 S:$L(X)=1 X="0"_X  ;find next month
  1.  . ;IHS/ITSC/WAR 2/12/03 P50 per Linda LJF41
  1.  . ;S MON=$E(MON,1,3)_X_"00"                                ;IHS/ITSC/LJF 1/22/2003
  1.  . S MON=$E(MON,1,3) S:X="01" MON=MON+1 S MON=MON_X_"00"    ;IHS/ITSC/LJF 1/22/2003 increment year, if needed
  1.  Q
  1.  ;
  1. INCR(SUB,TYPE,NAME,SUB2,MON) ; increment totals
  1.  S ^TMP("BSD",$J,SUB,0,0,SUB2,MON)=$G(^TMP("BSD",$J,SUB,0,0,SUB2,MON))+1
  1.  S ^TMP("BSD",$J,SUB,TYPE,0,SUB2,MON)=$G(^TMP("BSD",$J,SUB,TYPE,0,SUB2,MON))+1
  1.  S ^TMP("BSD",$J,SUB,0,NAME,SUB2,MON)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2,MON))+1
  1.  S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,MON)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,MON))+1
  1.  Q
  1.  ;
  1. NET(SUB,CLINIC,MON1,MON2) ; sets up net change & % change lines
  1.  ; CLINIC=0 if called by category
  1.  NEW I,DIFF,PCNT,DIV
  1.  K LINE2,LINE3
  1.  S LINE2=$$PAD($$SP(15)_"Net Change",25)
  1.  S LINE3=$$PAD($$SP(15)_"% Change",25)
  1.  F I=1:1:5 D
  1.  . S DIFF=$G(^TMP("BSD",$J,SUB,I,CLINIC,MON1,MON1))-$G(^TMP("BSD",$J,SUB,I,CLINIC,MON1,MON2))
  1.  . S LINE2=LINE2_$$SP(2)_$J(DIFF,6)
  1.  . S DIV=+$G(^TMP("BSD",$J,SUB,I,CLINIC,MON1,MON1))
  1.  . S PCNT=$S(DIFF=0:"0",DIV=0:DIFF*100,1:(DIFF/DIV*100))
  1.  . S LINE3=LINE3_$$SP(2)_$J(PCNT_"%",6,0)
  1.  ;
  1.  ; set differences for total column
  1.  S DIFF=$G(^TMP("BSD",$J,SUB,0,CLINIC,MON1,MON1))-$G(^TMP("BSD",$J,SUB,0,CLINIC,MON1,MON2))
  1.  S LINE2=$$PAD(LINE2,73)_$J(DIFF,6)
  1.  S DIV=+$G(^TMP("BSD",$J,SUB,0,CLINIC,MON1,MON1))
  1.  ;IHS/ITSC/WAR 9/23/04 PATCH #1001
  1.  ;S PCNT=$S(DIFF=0:"0",DIV=0:0,1:DIFF\DIV*100)
  1.  S PCNT=$S(DIFF=0:"0",DIV=0:0,1:DIFF/DIV*100)
  1.  ;IHS/ITSC/WAR 9/23/04 PATCH #1001
  1.  ;S LINE3=$$PAD(LINE3,73)_$J(PCNT_"%",6)
  1.  S LINE3=$$PAD(LINE3,73)_$J(PCNT_"%",6,0)
  1.  Q
  1.  ;
  1. SET(LINE,NUM) ; -- sets display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDWKR3",$J,NUM,0)=LINE
  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("BSDWKR3",$J,LINE)) Q:'LINE  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDWKR3",$J,LINE,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  D HDR W @IOF,?30,"Workload Comparisons"
  1.  NEW I F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !,"Category Name",?29,"SCHED",?35,"SAMEDAY",?44,"WALIKIN"
  1.  ;IHS/ITSC/WAR 9/23/04 PATCH #1001
  1.  ;W ?52,"OVERBK",?62,"INPT",70,"TOTAL SEEN"
  1.  W ?52,"OVERBK",?62,"INPT",?70,"TOTAL SEEN"
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  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)