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