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

BSDWKR4.m

Go to the documentation of this file. 
  1. BSDWKR4 ; IHS/ANMC/LJF - WORKLOAD SCHED VS SEEN ;  [ 11/01/2004  3:05 PM ]
  1.  ;;5.3;PIMS;**1001,1008**;APR 26, 2002
  1.  ;
  1. ASK ; -- ask user questions
  1.  NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDTT,BSDDET,BSDSUB,BSDSRT,BSDSEEN,Y
  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^::EX","Select Last Date to Search") Q:'BSDED
  1.  ;
  1.  ;S BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BDGWKR1") Q:BSDDET=U  ;cmi/maw 10/3/2007 orig line
  1.  S BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BDGWKR1") Q:BSDDET=U  ;cmi/maw 10/3/2007 changed BDGWKR1 to BDGWKR4
  1.  ;
  1.  S BSDSRT=$$READ^BDGF("SO^1:Morning vs. Afternoon;2:Pediatric vs. Adult Patients;3:Male vs. Female Patients","Select addition sort (optional)")
  1.  Q:BSDSRT=U  S BSDSRT=+BSDSRT   ;optional=0
  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^BSDWKR4","SCHED VS. SEEN","BSDDET;BSDSUB;BSDSRT;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 WORK STATS
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM SCHED VS SEEN")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
  1.  S VALMHDR(2)=$$SP(18)_"(Assumes patients seen if not flagged as no-shows)"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDWKR4",$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,SUB2,END
  1.  S CLN=0 F  S CLN=$O(@BSDAR@(CLN)) Q:'CLN  D
  1.  . ;IHS/ITSC/WAR 3/25/04 2 lines added to handle ALL/2 or more DIVs
  1.  . ;IHS/ITSC/WAR 5/5/04 PATCH #1001 REM'd previous change,DIV ck not needed here
  1.  . ;Q:'$$GET1^DIQ(44,CLN,3.5,"I")  ;No Div entered for this clinic
  1.  . ;Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I")))))  ;this Div notd
  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(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="NON-COUNT"  Q:STATUS="DELETED"  Q:STATUS="FUTURE"
  1.  ... ;
  1.  ... S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)      ;type of appt
  1.  ... S SUB2=$$SUB2(APPT,PAT)                      ;2nd sort
  1.  ... ;
  1.  ... ; increment totals
  1.  ... D INCR(SUB,TYPE,NAME,SUB2,APPT)
  1.  ;
  1.  ;
  1.  ; put totals into display array
  1.  NEW S1,S2,S3,S4,X,LINE,I,J,BSDI,BSDJ,BSDA
  1.  S S1=0 F  S S1=$O(^TMP("BSD",$J,S1)) Q:S1=""  D
  1.  . ;
  1.  . S LINE=$$PAD(S1,22)                   ;subtotal category name
  1.  . ; line up 5 type of appt columns
  1.  . K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I)),.LINE)
  1.  . D SET(LINE,.VALMCNT)
  1.  . ;
  1.  . I BSDSRT D      ;total of 2nd sort for subtotal category
  1.  .. S BSDI=$$SUB21(BSDSRT),BSDJ=$$SUB22(BSDSRT)
  1.  .. F J=BSDI,BSDJ D
  1.  ... S LINE=$$PAD(" TOTAL "_J,22)
  1.  ... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,0,J)),.LINE)
  1.  ... D SET(LINE,.VALMCNT)
  1.  . D SET("",.VALMCNT)
  1.  . ;
  1.  . ; totals by clinic
  1.  . S S2=0 F  S S2=$O(^TMP("BSD",$J,S1,0,S2)) Q:S2=""  D
  1.  .. I S2'=S1 D   ;if sort by clinic, don't repeat data
  1.  ... S LINE=$$PAD($$SP(3)_S2,22)            ;clinic name
  1.  ... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,S2)),.LINE)
  1.  ... D SET(LINE,.VALMCNT)
  1.  ... ;
  1.  ... ; subtotal clinics by 2nd subcategory
  1.  ... I BSDSRT D
  1.  .... S BSDI=$$SUB21(BSDSRT),BSDJ=$$SUB22(BSDSRT)
  1.  .... F J=BSDI,BSDJ D
  1.  ..... S LINE=$$PAD($$SP(4)_"TOTAL "_J,22)
  1.  ..... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,S2,J)),.LINE)
  1.  ..... D SET(LINE,.VALMCNT)
  1.  .. ;
  1.  .. ; subtotal clinics by date
  1.  .. S S3="" 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 X=$S(S3=0:"",1:" - "_S3)   ;2nd category if used
  1.  .... S LINE=$$PAD($$SP(4)_$$FMTE^XLFDT(S4)_X,22)
  1.  .... K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,S1,I,S2,S3,S4)),.LINE)
  1.  .... D SET(LINE,.VALMCNT)
  1.  .. D SET("",.VALMCNT)
  1.  ;
  1.  S LINE=$$PAD("REPORT TOTALS",22)
  1.  K BSDA F I=1:1:5 D BLDLINE(I,+$G(^TMP("BSD",$J,0,I)),.LINE)
  1.  D SET("",.VALMCNT),SET(LINE,.VALMCNT)
  1.  ;
  1.  K ^TMP("BSD",$J)
  1.  Q
  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. SUB2(D,P) ; -- returns value of 2nd sort if asked for
  1.  I BSDSRT=0 Q 0
  1.  I BSDSRT=1 NEW X S X=$E($P(D,".",2),1,2) Q $S(X<12:"AM",1:"PM")
  1.  I BSDSRT=2 NEW X,Y S X=$$GET1^DIQ(2,P,.03,"I"),Y=$$FMDIFF^XLFDT(D,X)/365.25 Q $S(Y<15:"PEDS",1:"ADULT")
  1.  I BSDSRT=3 Q $$GET1^DIQ(2,P,.02)
  1.  Q "??"    ;error in case one slips thru
  1.  ;
  1. SUB21(X) ; returns external category
  1.  Q $S(X=1:"AM",X=2:"PEDS",1:"MALE")
  1.  ;
  1. SUB22(X) ; returns 2nd value of 2nd subcategory
  1.  Q $S(X=1:"PM",X=2:"ADULT",1:"FEMALE")
  1.  ;
  1. TYPE(C,D,N,P,S) ; -- return type of appt.
  1.  ; returns column #: 1=sched, 2=overbook, 3=canceld, 4=no-show, 5=walkin
  1.  I S["NO-SHOW" Q 4                                   ;no-show
  1.  I S["CANCEL" Q 3                                    ;cancelled
  1.  I $G(^SC(C,"S",D,1,N,"OB"))="O" Q 2                 ;overbook
  1.  NEW X S X=$$VALI^XBDIQ1(2.98,P_","_D,9) I X=4 Q 5   ;walkin
  1.  Q 1                                           ;rest must be scheduled
  1.  ;
  1. INCR(SUB,TYPE,NAME,SUB2,APPT) ; increment totals
  1.  NEW DATE S DATE=APPT\1
  1.  S ^TMP("BSD",$J,SUB)=$G(^TMP("BSD",$J,SUB))+1
  1.  S ^TMP("BSD",$J,0,TYPE)=$G(^TMP("BSD",$J,0,TYPE))+1
  1.  S ^TMP("BSD",$J,SUB,TYPE)=$G(^TMP("BSD",$J,SUB,TYPE))+1
  1.  S ^TMP("BSD",$J,SUB,0,NAME)=$G(^TMP("BSD",$J,SUB,0,NAME))+1
  1.  S ^TMP("BSD",$J,SUB,TYPE,NAME)=$G(^TMP("BSD",$J,SUB,TYPE,NAME))+1
  1.  S ^TMP("BSD",$J,SUB,0,0,SUB2)=$G(^TMP("BSD",$J,SUB,0,0,SUB2))+1
  1.  S ^TMP("BSD",$J,SUB,TYPE,0,SUB2)=$G(^TMP("BSD",$J,SUB,TYPE,0,SUB2))+1
  1.  S ^TMP("BSD",$J,SUB,0,NAME,SUB2)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2))+1
  1.  S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2))+1
  1.  I BSDDET S ^TMP("BSD",$J,SUB,0,NAME,SUB2,DATE)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2,DATE))+1
  1.  I BSDDET S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,DATE)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,DATE))+1
  1.  I (TYPE=3)!(TYPE=4) D INCR(SUB,1,NAME,SUB2,APPT)  ;add to scheduled
  1.  Q
  1.  ;
  1. BLDLINE(I,NUM,LINE) ; build columns in display line
  1.  ; Array BSDA killed by calling code
  1.  S BSDA(I)=NUM                                  ;# of appts for type
  1.  S LINE=LINE_$$SP(2)_$J(NUM,6)                  ;add to display
  1.  I I=3 S LINE=LINE_$$SP(2)_$J(BSDA(1)+BSDA(2)-BSDA(3),6)    ;# expected
  1.  I I=5 S LINE=$$PAD(LINE,73)_$J(BSDA(1)+BSDA(2)-BSDA(3)-BSDA(4)+BSDA(5),6)  ;# seen
  1.  Q
  1.  ;
  1. SET(LINE,NUM) ; -- sets display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDWKR4",$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("BSDWKR4",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. PRINT ; print report to paper
  1.  U IO D HDG
  1.  NEW X S X=0 F  S X=$O(^TMP("BSDWKR4",$J,X)) Q:'X  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDWKR4",$J,X,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  D HDR W @IOF,?30,"Scheduled vs. Actual Appointments"
  1.  F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !,"Category Names",?28,"SCHED  +  OVERBK  -  CANCEL  =  EXPECTED"
  1.  W ?51,"-  NOSHOW  + WALKIN  =  TOTAL SEEN"
  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)