- BSDWKR1 ; IHS/ANMC/LJF - WORKLOAD STATS; [ 01/04/2005 4:42 PM ]
- ;;5.3;PIMS;**1001**;APR 26, 2002
- ;
- ASK ; -- ask user questions
- NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDTT,BSDDET,BSDSUB,BSDSRT,BSDSEEN,Y
- ;
- 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^::EX","Select Last Date to Search") Q:'BSDED
- ;
- S BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BSDWKR1") Q:BSDDET=U
- ;
- S BSDSRT=$$READ^BDGF("SO^1:Morning vs. Afternoon;2:Pediatric vs. Adult Patients;3:Male vs. Female Patients","Select addition sort (optional)")
- Q:BSDSRT=U S BSDSRT=+BSDSRT ;optional=0
- ;
- S BSDSEEN=$$READ^BDGF("YO","Assume Patient Seen if Appt NOT Checked In","NO","^D HELP2^BSDWKR1") Q:BSDSEEN="" Q:BSDSEEN=U
- ;
- S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
- D ZIS^BDGF("PQ","START^BSDWKR1","WORKLOAD STATS","BSDDET;BSDSUB;BSDSRT;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
- Q
- ;
- START ;EP; -- re-entry for printing to paper
- D INIT,PRINT Q
- ;
- EN ; -- main entry point for BSDRM WORK STATS
- NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
- D EN^VALM("BSDRM WORK STATS")
- D CLEAR^VALM1
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)=$$SP(25)_"Completed Appointments by Type"
- S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
- Q
- ;
- INIT ; -- init variables and list array
- S VALMCNT=0 K ^TMP("BSDWKR1",$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,SUB2,END
- S CLN=0 F S CLN=$O(@BSDAR@(CLN)) Q:'CLN D
- . ;IHS/ITSC/WAR 3/25/04 2 lines added to handle ALL/2 or more DIVs
- . Q:'$$GET1^DIQ(44,CLN,3.5,"I") ;No Div entered for this clinic
- . ;IHS/ITSC/WAR 12/29/04 PATCH 1001 fixed 'undefined' when selecting Prov or Team
- . ;Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I"))))) ;this Div notd
- . I $D(VAUTD) Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I"))))) ;this Div notd
- . Q:$D(^SC("AIHSPC",CLN)) ;quit if principal clinic
- . S NAME=$$GET1^DIQ(44,CLN,.01) ;set clinic's name
- . S SUB=$$SUB1(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["CANCEL" Q:STATUS="FUTURE"
- ... Q:STATUS="NON-COUNT" Q:STATUS="DELETED"
- ... I BSDSEEN=0 Q:STATUS="NO ACTION TAKEN"
- ... ;
- ... S TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS) ;type of appt
- ... S SUB2=$$SUB2(APPT,PAT) ;2nd sort
- ... ;
- ... ; increment totals
- ... D INCR(SUB,TYPE,NAME,SUB2,APPT)
- ;
- ;
- ; put totals into display array
- NEW S1,S2,S3,S4,X,LINE,I,J,BSDI,BSDJ
- S S1=0 F S S1=$O(^TMP("BSD",$J,S1)) Q:S1="" D
- . ;
- . S LINE=$$PAD(S1,25) ;subtotal category name
- . ; line up 5 type of appt columns
- . F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I)),6)
- . S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1)),6) ;add in total
- . D SET(LINE,.VALMCNT)
- . ;
- . I BSDSRT D ;total of 2nd sort for subtotal category
- .. S BSDI=$$SUB21(BSDSRT),BSDJ=$$SUB22(BSDSRT)
- .. F J=BSDI,BSDJ D
- ... S LINE=$$PAD(" TOTAL "_J,25)
- ... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,0,J)),6)
- ... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,0,J)),6)
- ... D SET(LINE,.VALMCNT)
- . D SET("",.VALMCNT)
- . ;
- . ; totals by clinic
- . S S2=0 F S S2=$O(^TMP("BSD",$J,S1,0,S2)) Q:S2="" D
- .. I S2'=S1 D ;if sort by clinic, don't repeat data
- ... S LINE=$$PAD($$SP(3)_S2,25) ;clinic name
- ... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,S2)),6)
- ... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,S2)),6)
- ... D SET(LINE,.VALMCNT)
- ... ;
- ... ; subtotal clinics by 2nd subcategory
- ... I BSDSRT D
- .... S BSDI=$$SUB21(BSDSRT),BSDJ=$$SUB22(BSDSRT)
- .... F J=BSDI,BSDJ D
- ..... S LINE=$$PAD($$SP(4)_"TOTAL "_J,25)
- ..... F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,S2,J)),6)
- ..... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,S2,J)),6)
- ..... D SET(LINE,.VALMCNT)
- .. ;
- .. ; subtotal clinics by date
- .. S S3="" F S S3=$O(^TMP("BSD",$J,S1,0,S2,S3)) Q:S3="" D
- ... S S4=0 F S S4=$O(^TMP("BSD",$J,S1,0,S2,S3,S4)) Q:S4="" D
- .... S X=$S(S3=0:"",1:" - "_S3) ;2nd category if used
- .... S LINE=$$PAD($$SP(4)_$$FMTE^XLFDT(S4)_X,25)
- .... F I=1:1:6 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,S1,I,S2,S3,S4)),6)
- .... S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,S1,0,S2,S3,S4)),6)
- .... D SET(LINE,.VALMCNT)
- .. D SET("",.VALMCNT)
- ;
- S LINE=$$PAD("REPORT TOTALS",25)
- F I=1:1:5 S LINE=LINE_$$SP(2)_$J(+$G(^TMP("BSD",$J,0,I)),6)
- S LINE=$$PAD(LINE,73)_$J(+$G(^TMP("BSD",$J,0)),6)
- D SET("",.VALMCNT),SET(LINE,.VALMCNT)
- ;
- K ^TMP("BSD",$J)
- Q
- ;
- SUB1(C,N) ; -- return name of subcategory for clinic C
- I BSDSUB="P" Q $$PRIN^BSDU(CLN)
- I BSDSUB="V" Q $P($$PRV^BSDU(CLN),U,2)
- I BSDSUB="T" Q $P($$TEAM^BSDU(CLN),U,2)
- Q N
- ;
- SUB2(D,P) ; -- returns value of 2nd sort if asked for
- I BSDSRT=0 Q 0
- I BSDSRT=1 NEW X S X=$E($P(D,".",2),1,2) Q $S(X<12:"AM",1:"PM")
- 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")
- I BSDSRT=3 Q $$GET1^DIQ(2,P,.02)
- Q "??" ;error in case one slips thru
- ;
- SUB21(X) ; returns external category
- Q $S(X=1:"AM",X=2:"PEDS",1:"MALE")
- ;
- SUB22(X) ; returns 2nd value of 2nd subcategory
- Q $S(X=1:"PM",X=2:"ADULT",1:"FEMALE")
- ;
- TYPE(C,D,N,P,S) ; -- return type of appt.
- ; returns column #
- ; 1=sched, 2=same day, 3=walk-in, 4=overbook, 5=inpt, 6=no-show
- I S["NO-SHOW" Q 6 ;no-show
- I S["INPAT" Q 5 ;inpatient
- NEW X S X=$P($G(^DPT(P,"S",D,0)),U,7) I X=4 Q 3 ;walkin
- I X=9,(D\1)=($P($G(^SC(C,"S",D,1,N,0)),U,7)\1) Q 3 ;same day CR
- I X=9,(D\1)'=($P($G(^SC(C,"S",D,1,N,0)),U,7)\1) Q 1 ;future CR
- I X=3,(D\1)=($P($G(^SC(C,"S",D,1,N,0)),U,7)\1) Q 2 ;same day appt
- I $G(^SC(C,"S",D,1,N,"OB"))="O" Q 4 ;sched overbook
- I X=3 Q 1 ;scheduled
- Q "??" ;error in case one slips thru
- ;
- INCR(SUB,TYPE,NAME,SUB2,APPT) ; increment totals
- NEW DATE S DATE=APPT\1
- I TYPE'=6 S ^TMP("BSD",$J,0)=$G(^TMP("BSD",$J,0))+1
- I TYPE'=6 S ^TMP("BSD",$J,SUB)=$G(^TMP("BSD",$J,SUB))+1
- S ^TMP("BSD",$J,0,TYPE)=$G(^TMP("BSD",$J,0,TYPE))+1
- S ^TMP("BSD",$J,SUB,TYPE)=$G(^TMP("BSD",$J,SUB,TYPE))+1
- I TYPE'=6 S ^TMP("BSD",$J,SUB,0,NAME)=$G(^TMP("BSD",$J,SUB,0,NAME))+1
- S ^TMP("BSD",$J,SUB,TYPE,NAME)=$G(^TMP("BSD",$J,SUB,TYPE,NAME))+1
- S ^TMP("BSD",$J,SUB,0,0,SUB2)=$G(^TMP("BSD",$J,SUB,0,0,SUB2))+1
- S ^TMP("BSD",$J,SUB,TYPE,0,SUB2)=$G(^TMP("BSD",$J,SUB,TYPE,0,SUB2))+1
- S ^TMP("BSD",$J,SUB,0,NAME,SUB2)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2))+1
- S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2))+1
- I BSDDET S ^TMP("BSD",$J,SUB,0,NAME,SUB2,DATE)=$G(^TMP("BSD",$J,SUB,0,NAME,SUB2,DATE))+1
- I BSDDET S ^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,DATE)=$G(^TMP("BSD",$J,SUB,TYPE,NAME,SUB2,DATE))+1
- Q
- ;
- SET(LINE,NUM) ; -- sets display line into array
- S NUM=NUM+1
- S ^TMP("BSDWKR1",$J,NUM,0)=LINE
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- HELP1 ;EP; help for subtotal question
- D MSG^BDGF("This report will subtotal results any of 4 ways:",2,0)
- D MSG^BDGF(" Choose C to subtotal by individual clinic;",1,0)
- D MSG^BDGF(" Choose P to subtotal by principal clinic;",1,0)
- D MSG^BDGF(" Choose V to subtotal by a clinic's provider;",1,0)
- D MSG^BDGF(" Choose T to subtotal by a clinic's team.",1,0)
- D MSG^BDGF("Clinics not affiliated with a principal clinic,",2,0)
- D MSG^BDGF("provider or team, will be subtotaled under the",1,0)
- D MSG^BDGF("""Unaffiliated"" designation.",1,1)
- Q
- ;
- HELP2 ;EP; help for assume patient seen question
- D MSG^BDGF("Answer YES if you want the report to assume patients",2,0)
- D MSG^BDGF("were seen even when their appointments were NOT",1,0)
- D MSG^BDGF("checked-in or flagged as no-shows.",1,0)
- D MSG^BDGF("Answer NO if only appointments with a check-in date/time",2,0)
- D MSG^BDGF("are to be counted. No-shows are counted separately.",1,0)
- D MSG^BDGF("The Appt. Management Report can list all appointments",1,0)
- D MSG^BDGF("without an action status so the data can be cleaned up.",1,1)
- Q
- ;
- HELP3 ;EP; help for print individual dates question
- D MSG^BDGF("Answer YES to have the report totals for each date",2,0)
- D MSG^BDGF("within the date range you have selected.",1,0)
- D MSG^BDGF("Answer NO to just have one set of totals for each",1,0)
- D MSG^BDGF("clinic for the entire date range.",1,1)
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("BSDWKR1",$J)
- Q
- ;
- EXPND ; -- expand code
- Q
- ;
- PRINT ; print report to paper
- U IO D HDG
- NEW X S X=0 F S X=$O(^TMP("BSDWKR1",$J,X)) Q:'X D
- . I $Y>(IOSL-4) D HDG
- . W !,^TMP("BSDWKR1",$J,X,0)
- D ^%ZISC,EXIT
- Q
- ;
- HDG ; heading for paper report
- D HDR W @IOF,?30,"Workload Statistics"
- F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
- W !,$$REPEAT^XLFSTR("-",80)
- W !,"Category Names",?28,"SCHED",?34,"SAMEDAY",?43,"WALKIN"
- W ?51,"OVERBK",?61,"INPT",?70,"TOTAL SEEN"
- 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)
- BSDWKR1 ; IHS/ANMC/LJF - WORKLOAD STATS; [ 01/04/2005 4:42 PM ]
- +1 ;;5.3;PIMS;**1001**;APR 26, 2002
- +2 ;
- ASK ; -- ask user questions
- +1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDTT,BSDDET,BSDSUB,BSDSRT,BSDSEEN,Y
- +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 SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")
- IF 'BSDED
- QUIT
- +12 ;
- +13 SET BSDDET=$$READ^BDGF("Y","List Individual Dates","NO","^D HELP3^BSDWKR1")
- IF BSDDET=U
- QUIT
- +14 ;
- +15 SET BSDSRT=$$READ^BDGF("SO^1:Morning vs. Afternoon;2:Pediatric vs. Adult Patients;3:Male vs. Female Patients","Select addition sort (optional)")
- +16 ;optional=0
- IF BSDSRT=U
- QUIT
- SET BSDSRT=+BSDSRT
- +17 ;
- +18 SET BSDSEEN=$$READ^BDGF("YO","Assume Patient Seen if Appt NOT Checked In","NO","^D HELP2^BSDWKR1")
- IF BSDSEEN=""
- QUIT
- IF BSDSEEN=U
- QUIT
- +19 ;
- +20 ;browse in list mgr mode
- SET Y=$$BROWSE^BDGF
- IF "PB"'[Y
- QUIT
- IF Y="B"
- DO EN
- QUIT
- +21 DO ZIS^BDGF("PQ","START^BSDWKR1","WORKLOAD STATS","BSDDET;BSDSUB;BSDSRT;BSDSEEN;BSDBD;BSDED;VAUTC*;VAUTD*")
- +22 QUIT
- +23 ;
- START ;EP; -- re-entry for printing to paper
- +1 DO INIT
- DO PRINT
- QUIT
- +2 ;
- EN ; -- main entry point for BSDRM WORK STATS
- +1 NEW VALMCNT
- DO TERM^VALM0
- DO CLEAR^VALM1
- +2 DO EN^VALM("BSDRM WORK STATS")
- +3 DO CLEAR^VALM1
- +4 QUIT
- +5 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)=$$SP(25)_"Completed Appointments by Type"
- +2 SET VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)
- +3 QUIT
- +4 ;
- INIT ; -- init variables and list array
- +1 SET VALMCNT=0
- KILL ^TMP("BSDWKR1",$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,SUB2,END
- +6 SET CLN=0
- FOR
- SET CLN=$ORDER(@BSDAR@(CLN))
- IF 'CLN
- QUIT
- Begin DoDot:1
- +7 ;IHS/ITSC/WAR 3/25/04 2 lines added to handle ALL/2 or more DIVs
- +8 ;No Div entered for this clinic
- IF '$$GET1^DIQ(44,CLN,3.5,"I")
- QUIT
- +9 ;IHS/ITSC/WAR 12/29/04 PATCH 1001 fixed 'undefined' when selecting Prov or Team
- +10 ;Q:(VAUTD'=1&('$D(VAUTD($$GET1^DIQ(44,CLN,3.5,"I"))))) ;this Div notd
- +11 ;this Div notd
- IF $DATA(VAUTD)
- IF (VAUTD'=1&('$DATA(VAUTD($$GET1^DIQ(44,CLN,3.5,"I")))))
- QUIT
- +12 ;quit if principal clinic
- IF $DATA(^SC("AIHSPC",CLN))
- QUIT
- +13 ;set clinic's name
- SET NAME=$$GET1^DIQ(44,CLN,.01)
- +14 ;get subcategory for clinic
- SET SUB=$$SUB1(CLN,NAME)
- +15 ;
- +16 ; -- then by appt date (within range)
- +17 SET APPT=BSDBD
- SET END=BSDED+.2400
- +18 FOR
- SET APPT=$ORDER(^SC(CLN,"S",APPT))
- IF 'APPT!(APPT>END)
- QUIT
- Begin DoDot:2
- +19 ;
- +20 ; -- then find appts to count
- +21 SET APPN=0
- +22 FOR
- SET APPN=$ORDER(^SC(CLN,"S",APPT,1,APPN))
- IF 'APPN
- QUIT
- Begin DoDot:3
- +23 ;patient ien
- SET PAT=+^SC(CLN,"S",APPT,1,APPN,0)
- +24 ;current status
- SET STATUS=$$VAL^XBDIQ1(2.98,PAT_","_APPT,100)
- +25 IF STATUS["CANCEL"
- QUIT
- IF STATUS="FUTURE"
- QUIT
- +26 IF STATUS="NON-COUNT"
- QUIT
- IF STATUS="DELETED"
- QUIT
- +27 IF BSDSEEN=0
- IF STATUS="NO ACTION TAKEN"
- QUIT
- +28 ;
- +29 ;type of appt
- SET TYPE=$$TYPE(CLN,APPT,APPN,PAT,STATUS)
- +30 ;2nd sort
- SET SUB2=$$SUB2(APPT,PAT)
- +31 ;
- +32 ; increment totals
- +33 DO INCR(SUB,TYPE,NAME,SUB2,APPT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +34 ;
- +35 ;
- +36 ; put totals into display array
- +37 NEW S1,S2,S3,S4,X,LINE,I,J,BSDI,BSDJ
- +38 SET S1=0
- FOR
- SET S1=$ORDER(^TMP("BSD",$JOB,S1))
- IF S1=""
- QUIT
- Begin DoDot:1
- +39 ;
- +40 ;subtotal category name
- SET LINE=$$PAD(S1,25)
- +41 ; line up 5 type of appt columns
- +42 FOR I=1:1:5
- SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I)),6)
- +43 ;add in total
- SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1)),6)
- +44 DO SET(LINE,.VALMCNT)
- +45 ;
- +46 ;total of 2nd sort for subtotal category
- IF BSDSRT
- Begin DoDot:2
- +47 SET BSDI=$$SUB21(BSDSRT)
- SET BSDJ=$$SUB22(BSDSRT)
- +48 FOR J=BSDI,BSDJ
- Begin DoDot:3
- +49 SET LINE=$$PAD(" TOTAL "_J,25)
- +50 FOR I=1:1:5
- SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,0,J)),6)
- +51 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,0,J)),6)
- +52 DO SET(LINE,.VALMCNT)
- End DoDot:3
- End DoDot:2
- +53 DO SET("",.VALMCNT)
- +54 ;
- +55 ; totals by clinic
- +56 SET S2=0
- FOR
- SET S2=$ORDER(^TMP("BSD",$JOB,S1,0,S2))
- IF S2=""
- QUIT
- Begin DoDot:2
- +57 ;if sort by clinic, don't repeat data
- IF S2'=S1
- Begin DoDot:3
- +58 ;clinic name
- SET LINE=$$PAD($$SP(3)_S2,25)
- +59 FOR I=1:1:5
- SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,S2)),6)
- +60 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,S2)),6)
- +61 DO SET(LINE,.VALMCNT)
- +62 ;
- +63 ; subtotal clinics by 2nd subcategory
- +64 IF BSDSRT
- Begin DoDot:4
- +65 SET BSDI=$$SUB21(BSDSRT)
- SET BSDJ=$$SUB22(BSDSRT)
- +66 FOR J=BSDI,BSDJ
- Begin DoDot:5
- +67 SET LINE=$$PAD($$SP(4)_"TOTAL "_J,25)
- +68 FOR I=1:1:5
- SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,S2,J)),6)
- +69 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,S2,J)),6)
- +70 DO SET(LINE,.VALMCNT)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +71 ;
- +72 ; subtotal clinics by date
- +73 SET S3=""
- FOR
- SET S3=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3))
- IF S3=""
- QUIT
- Begin DoDot:3
- +74 SET S4=0
- FOR
- SET S4=$ORDER(^TMP("BSD",$JOB,S1,0,S2,S3,S4))
- IF S4=""
- QUIT
- Begin DoDot:4
- +75 ;2nd category if used
- SET X=$SELECT(S3=0:"",1:" - "_S3)
- +76 SET LINE=$$PAD($$SP(4)_$$FMTE^XLFDT(S4)_X,25)
- +77 FOR I=1:1:6
- SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,I,S2,S3,S4)),6)
- +78 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,S1,0,S2,S3,S4)),6)
- +79 DO SET(LINE,.VALMCNT)
- End DoDot:4
- End DoDot:3
- +80 DO SET("",.VALMCNT)
- End DoDot:2
- End DoDot:1
- +81 ;
- +82 SET LINE=$$PAD("REPORT TOTALS",25)
- +83 FOR I=1:1:5
- SET LINE=LINE_$$SP(2)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,0,I)),6)
- +84 SET LINE=$$PAD(LINE,73)_$JUSTIFY(+$GET(^TMP("BSD",$JOB,0)),6)
- +85 DO SET("",.VALMCNT)
- DO SET(LINE,.VALMCNT)
- +86 ;
- +87 KILL ^TMP("BSD",$JOB)
- +88 QUIT
- +89 ;
- SUB1(C,N) ; -- return name of subcategory for clinic C
- +1 IF BSDSUB="P"
- QUIT $$PRIN^BSDU(CLN)
- +2 IF BSDSUB="V"
- QUIT $PIECE($$PRV^BSDU(CLN),U,2)
- +3 IF BSDSUB="T"
- QUIT $PIECE($$TEAM^BSDU(CLN),U,2)
- +4 QUIT N
- +5 ;
- SUB2(D,P) ; -- returns value of 2nd sort if asked for
- +1 IF BSDSRT=0
- QUIT 0
- +2 IF BSDSRT=1
- NEW X
- SET X=$EXTRACT($PIECE(D,".",2),1,2)
- QUIT $SELECT(X<12:"AM",1:"PM")
- +3 IF BSDSRT=2
- NEW X,Y
- SET X=$$GET1^DIQ(2,P,.03,"I")
- SET Y=$$FMDIFF^XLFDT(D,X)/365.25
- QUIT $SELECT(Y<15:"PEDS",1:"ADULT")
- +4 IF BSDSRT=3
- QUIT $$GET1^DIQ(2,P,.02)
- +5 ;error in case one slips thru
- QUIT "??"
- +6 ;
- SUB21(X) ; returns external category
- +1 QUIT $SELECT(X=1:"AM",X=2:"PEDS",1:"MALE")
- +2 ;
- SUB22(X) ; returns 2nd value of 2nd subcategory
- +1 QUIT $SELECT(X=1:"PM",X=2:"ADULT",1:"FEMALE")
- +2 ;
- TYPE(C,D,N,P,S) ; -- return type of appt.
- +1 ; returns column #
- +2 ; 1=sched, 2=same day, 3=walk-in, 4=overbook, 5=inpt, 6=no-show
- +3 ;no-show
- IF S["NO-SHOW"
- QUIT 6
- +4 ;inpatient
- IF S["INPAT"
- QUIT 5
- +5 ;walkin
- NEW X
- SET X=$PIECE($GET(^DPT(P,"S",D,0)),U,7)
- IF X=4
- QUIT 3
- +6 ;same day CR
- IF X=9
- IF (D\1)=($PIECE($GET(^SC(C,"S",D,1,N,0)),U,7)\1)
- QUIT 3
- +7 ;future CR
- IF X=9
- IF (D\1)'=($PIECE($GET(^SC(C,"S",D,1,N,0)),U,7)\1)
- QUIT 1
- +8 ;same day appt
- IF X=3
- IF (D\1)=($PIECE($GET(^SC(C,"S",D,1,N,0)),U,7)\1)
- QUIT 2
- +9 ;sched overbook
- IF $GET(^SC(C,"S",D,1,N,"OB"))="O"
- QUIT 4
- +10 ;scheduled
- IF X=3
- QUIT 1
- +11 ;error in case one slips thru
- QUIT "??"
- +12 ;
- INCR(SUB,TYPE,NAME,SUB2,APPT) ; increment totals
- +1 NEW DATE
- SET DATE=APPT\1
- +2 IF TYPE'=6
- SET ^TMP("BSD",$JOB,0)=$GET(^TMP("BSD",$JOB,0))+1
- +3 IF TYPE'=6
- SET ^TMP("BSD",$JOB,SUB)=$GET(^TMP("BSD",$JOB,SUB))+1
- +4 SET ^TMP("BSD",$JOB,0,TYPE)=$GET(^TMP("BSD",$JOB,0,TYPE))+1
- +5 SET ^TMP("BSD",$JOB,SUB,TYPE)=$GET(^TMP("BSD",$JOB,SUB,TYPE))+1
- +6 IF TYPE'=6
- SET ^TMP("BSD",$JOB,SUB,0,NAME)=$GET(^TMP("BSD",$JOB,SUB,0,NAME))+1
- +7 SET ^TMP("BSD",$JOB,SUB,TYPE,NAME)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME))+1
- +8 SET ^TMP("BSD",$JOB,SUB,0,0,SUB2)=$GET(^TMP("BSD",$JOB,SUB,0,0,SUB2))+1
- +9 SET ^TMP("BSD",$JOB,SUB,TYPE,0,SUB2)=$GET(^TMP("BSD",$JOB,SUB,TYPE,0,SUB2))+1
- +10 SET ^TMP("BSD",$JOB,SUB,0,NAME,SUB2)=$GET(^TMP("BSD",$JOB,SUB,0,NAME,SUB2))+1
- +11 SET ^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2))+1
- +12 IF BSDDET
- SET ^TMP("BSD",$JOB,SUB,0,NAME,SUB2,DATE)=$GET(^TMP("BSD",$JOB,SUB,0,NAME,SUB2,DATE))+1
- +13 IF BSDDET
- SET ^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,DATE)=$GET(^TMP("BSD",$JOB,SUB,TYPE,NAME,SUB2,DATE))+1
- +14 QUIT
- +15 ;
- SET(LINE,NUM) ; -- sets display line into array
- +1 SET NUM=NUM+1
- +2 SET ^TMP("BSDWKR1",$JOB,NUM,0)=LINE
- +3 QUIT
- +4 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- HELP1 ;EP; help for subtotal question
- +1 DO MSG^BDGF("This report will subtotal results any of 4 ways:",2,0)
- +2 DO MSG^BDGF(" Choose C to subtotal by individual clinic;",1,0)
- +3 DO MSG^BDGF(" Choose P to subtotal by principal clinic;",1,0)
- +4 DO MSG^BDGF(" Choose V to subtotal by a clinic's provider;",1,0)
- +5 DO MSG^BDGF(" Choose T to subtotal by a clinic's team.",1,0)
- +6 DO MSG^BDGF("Clinics not affiliated with a principal clinic,",2,0)
- +7 DO MSG^BDGF("provider or team, will be subtotaled under the",1,0)
- +8 DO MSG^BDGF("""Unaffiliated"" designation.",1,1)
- +9 QUIT
- +10 ;
- HELP2 ;EP; help for assume patient seen question
- +1 DO MSG^BDGF("Answer YES if you want the report to assume patients",2,0)
- +2 DO MSG^BDGF("were seen even when their appointments were NOT",1,0)
- +3 DO MSG^BDGF("checked-in or flagged as no-shows.",1,0)
- +4 DO MSG^BDGF("Answer NO if only appointments with a check-in date/time",2,0)
- +5 DO MSG^BDGF("are to be counted. No-shows are counted separately.",1,0)
- +6 DO MSG^BDGF("The Appt. Management Report can list all appointments",1,0)
- +7 DO MSG^BDGF("without an action status so the data can be cleaned up.",1,1)
- +8 QUIT
- +9 ;
- HELP3 ;EP; help for print individual dates question
- +1 DO MSG^BDGF("Answer YES to have the report totals for each date",2,0)
- +2 DO MSG^BDGF("within the date range you have selected.",1,0)
- +3 DO MSG^BDGF("Answer NO to just have one set of totals for each",1,0)
- +4 DO MSG^BDGF("clinic for the entire date range.",1,1)
- +5 QUIT
- +6 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("BSDWKR1",$JOB)
- +2 QUIT
- +3 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- PRINT ; print report to paper
- +1 USE IO
- DO HDG
- +2 NEW X
- SET X=0
- FOR
- SET X=$ORDER(^TMP("BSDWKR1",$JOB,X))
- IF 'X
- QUIT
- Begin DoDot:1
- +3 IF $Y>(IOSL-4)
- DO HDG
- +4 WRITE !,^TMP("BSDWKR1",$JOB,X,0)
- End DoDot:1
- +5 DO ^%ZISC
- DO EXIT
- +6 QUIT
- +7 ;
- HDG ; heading for paper report
- +1 DO HDR
- WRITE @IOF,?30,"Workload Statistics"
- +2 FOR I=1:1
- IF '$DATA(VALMHDR(I))
- QUIT
- WRITE !,VALMHDR(I)
- +3 WRITE !,$$REPEAT^XLFSTR("-",80)
- +4 WRITE !,"Category Names",?28,"SCHED",?34,"SAMEDAY",?43,"WALKIN"
- +5 WRITE ?51,"OVERBK",?61,"INPT",?70,"TOTAL SEEN"
- +6 WRITE !,$$REPEAT^XLFSTR("=",80)
- +7 QUIT
- +8 ;
- 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)
