SCRPW61 ;BP-CIOFO/KEITH - Patient Appointment Statistics (cont.) ; 07 May 99 4:33 PM
;;5.3;Scheduling;**163,176,194,1015**;AUG 13, 1993;Build 21
CNT ;Count clinic statistics
S SDIV="" F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT D
.S SDCLN="" F S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN)) Q:SDCLN="" D STOP Q:SDOUT D
..S SDCL=0 F S SDCL=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL)) Q:'SDCL D
...S SDPTNA="" F S SDPTNA=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA)) Q:SDPTNA="" D
....S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN)) Q:'DFN D
.....I SDPL,SDPLO'="D" S ^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,$$ORD(),SDPTNA,DFN)=""
.....S $P(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL),U,3)=$P($G(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)),U,3)+1
.....S SDDAY=0 F S SDDAY=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY)) Q:'SDDAY D
......S $P(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL),U,2)=$P($G(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)),U,2)+1
......S SDAPP=0 F S SDAPP=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY,SDAPP)) Q:'SDAPP D
.......I SDPL,SDPLO="D" S ^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDAPP,SDPTNA,DFN)=""
.......S $P(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL),U)=$P($G(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)),U)+1 Q
......Q
.....Q
....Q
...Q
..Q
.Q:SDOUT
.;Count division statistics
.S SDPTNA="" F S SDPTNA=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA)) Q:SDPTNA="" D
..S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN)) Q:'DFN D
...S $P(^TMP("SCRPW",$J,SDIV,4),U,3)=$P($G(^TMP("SCRPW",$J,SDIV,4)),U,3)+1
...S SDDAY=0 F S SDDAY=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,SDDAY)) Q:'SDDAY D
....S $P(^TMP("SCRPW",$J,SDIV,4),U,2)=$P($G(^TMP("SCRPW",$J,SDIV,4)),U,2)+1
....S SDAPP=0 F S SDAPP=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,SDDAY,SDAPP)) Q:'SDAPP D
.....S $P(^TMP("SCRPW",$J,SDIV,4),U)=$P($G(^TMP("SCRPW",$J,SDIV,4)),U)+1 Q
....Q
...Q
..Q
.Q
Q
;
ORD() ;Determine collating value for patient list
Q:SDPLO="A" SDPTNA
S SDSSN=$P(^DPT(DFN,0),U,9) Q $E(SDSSN,8,9)_$E(SDSSN,6,7)_$E(SDSSN,4,5)_$E(SDSSN,1,3)_"."
;
STOP ;Check for stop task request
S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
AC ;Gather all clinics
S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:'SDCL S SDCL0=^SC(SDCL,0),SDIV=$P(SDCL0,U,15),SDAC=0 I $$DIV() D STOP Q:SDOUT D A1 D:SDAC SET
Q
;
A1 S:$P(SDCL0,U,3)="C" SDAC=1 Q
;
SC ;Gather selected clinics
S SDCL=0 F S SDCL=$O(SDCL(SDCL)) Q:'SDCL S SDCL0=^SC(SDCL,0),SDIV=$P(SDCL0,U,15),SDAC=0 I $$DIV() D STOP Q:SDOUT D A1 D:SDAC SET
Q
;
RC ;Gather range of clinics
S SDCLN=$O(SDCL("")),SDECL=$O(SDCL(SDCLN)),SDCL=SDCL(SDCLN),SDCL0=^SC(SDCL,0),SDIV=$P(SDCL0,U,15),SDAC=0 I $$DIV() D STOP Q:SDOUT D A1 D:SDAC SET
F S SDCLN=$O(^SC("B",SDCLN)) Q:(SDCLN=""!(SDCLN]SDECL)) S SDCL=0 F S SDCL=$O(^SC("B",SDCLN,SDCL)) Q:'SDCL S SDCL0=^SC(SDCL,0),SDIV=$P(SDCL0,U,15),SDAC=0 I $$DIV() D STOP Q:SDOUT D A1 D:SDAC SET
Q
;
SS ;Gather clinics with selected Stop Codes
S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:'SDCL S SDCL0=^SC(SDCL,0),SDIV=$P(SDCL0,U,15),SDAC=0 I $$DIV() D STOP Q:SDOUT D A1 D:SDAC SS1
Q
;
SS1 S SDCSC=$P(SDCL0,U,7),SDCSC=$P($G(^DIC(40.7,+SDCSC,0)),U,2) I $D(SDCL(+SDCSC)) D SET
Q
;
RS ;Gather clinics in range of Stop Codes
S SDBCS=$O(SDCL("")),SDECS=$O(SDCL(SDBCS)),SDCL=0 S:'SDECS SDECS=SDBCS F S SDCL=$O(^SC(SDCL)) Q:'SDCL S SDCL0=^SC(SDCL,0),SDIV=$P(SDCL0,U,15),SDAC=0 I $$DIV() D STOP Q:SDOUT D A1 D:SDAC RC1
Q
;
RC1 S SDCSC=$P(SDCL0,U,7),SDCSC=$P($G(^DIC(40.7,+SDCSC,0)),U,2) Q:('SDCSC!(SDCSC<SDBCS!(SDCSC>SDECS))) D SET Q
;
CG ;Gather clinics with selected clinic group
S SDCG=$O(SDCL(0)),SDCL=0 F S SDCL=$O(^SC("ASCRPW",SDCG,SDCL)) Q:'SDCL S SDCL0=^SC(SDCL,0),SDIV=$P(SDCL0,U,15),SDAC=0 I $$DIV() D STOP Q:SDOUT D A1 D:SDAC SET
Q
;
DIV() ;Check division
S:'$L(SDIV) SDIV=$$PRIM^VASITE()
Q:'SDDIV 1 Q $D(SDDIV(+SDIV))
;
SET ;Set ^TMP global
N SDPAS
S SDDAY=SDBDAY F S SDDAY=$O(^SC(SDCL,"S",SDDAY)) Q:'SDDAY!(SDDAY>SDEDAY) S SDI=0 F S SDI=$O(^SC(SDCL,"S",SDDAY,1,SDI)) Q:'SDI D
.S SDCP0=$G(^SC(SDCL,"S",SDDAY,1,SDI,0)) Q:'$L(SDCP0) Q:$P(SDCP0,U,9)="C"
.S DFN=$P(SDCP0,U),SDPTNA=$P($G(^DPT(+DFN,0)),U) Q:'$L(SDPTNA)
.S SDPAS=$P($G(^DPT(DFN,"S",SDDAY,0)),U,2) I $L(SDPAS),"NA"[SDPAS Q
.D SET1(SDIV) D:SDMD SET1(0) Q
Q
;
SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,$P(SDCL0,U),SDCL,SDPTNA,DFN,$P(SDDAY,"."),SDDAY)=""
S ^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,$P(SDDAY,"."),SDDAY)=""
Q
;
N SDI
F SDI=1:1:80 Q:$Y>(IOSL-8) W !
W SDLINE,!?(SDCOL),"NOTE: This report reflects appointment workload that is not defined as cancelled"
W !?(SDCOL+6),"or no-showed, including walk-in (unscheduled) appointments. It does not"
W !?(SDCOL+6),"represent all outpatient activity. Report totals are tabulated separately",!?(SDCOL+6),"and will not necessarily be equal to the sum of the sub-total columns.",!,SDLINE Q
;
DPRT(SDIV) ;Print report for a division
D DHDR^SCRPW40(4,.SDT)
I '$D(^TMP("SCRPW",$J,SDIV)) D HDR^SCRPW60 S SDX="No appointments found for this division within report parameters!" W !!?(132-$L(SDX)\2),SDX Q
I SDPL,SDIV S SDCLN="" F S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN)) Q:SDCLN=""!SDOUT D
.S SDCL=0 F S SDCL=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL)) Q:'SDCL!SDOUT D
..S SDT(5)="Patient list for clinic: "_SDCLN D HDR^SCRPW60,HD1 Q:SDOUT
..S SDORD="" F S SDORD=$O(^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDORD)) Q:SDORD=""!SDOUT D
...S SDPTNA="" F S SDPTNA=$O(^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDORD,SDPTNA)) Q:SDPTNA=""!SDOUT D
....S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDORD,SDPTNA,DFN)) Q:'DFN!SDOUT D
.....I SDPLO="D" D PLINE(SDORD) Q
.....S SDDAY=0 F S SDDAY=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY)) Q:'SDDAY!SDOUT D
......S SDAPP=0 F S SDAPP=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY,SDAPP)) Q:'SDAPP!SDOUT D
.......D PLINE(SDAPP) Q
......Q
.....Q
....Q
...Q
..Q
.Q
Q:SDOUT K SDT(5) D HDR^SCRPW60,HD2 Q:SDOUT
S SDCLN="" F S SDCLN=$O(^TMP("SCRPW",$J,SDIV,3,SDCLN)) Q:SDCLN=""!SDOUT D
.S SDCL=0 F S SDCL=$O(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)) Q:'SDCL!SDOUT D
..D CLINE Q
.Q
Q:SDOUT D DTOT,FOOT Q
;
PLINE(SDAPP) ;Print patient detail line
;Input: SDAPP=patient appointment date/time
S SDSSN=$P(^DPT(DFN,0),U,9) D:$Y>(IOSL-4) HDR^SCRPW60,HD1 Q:SDOUT
W !?(SDCOL+8),SDPTNA,?(SDCOL+40),$E(SDSSN,1,3),"-",$E(SDSSN,4,5),"-",$E(SDSSN,6,10) S Y=SDAPP X ^DD("DD") W ?(SDCOL+54),$P(Y,":",1,2) Q
;
CLINE ;Print clinic sub-total line
S SDCTOT=^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL) D:$Y>(IOSL-11) FOOT,HDR^SCRPW60,HD2 Q:SDOUT
W !?(SDCOL+5),SDCLN F SDI=1:1:3 W ?(SDCOL+27+(12*SDI)),$J($P(SDCTOT,U,SDI),12,0)
Q
;
DTOT ;Print division total
S SDTOT=^TMP("SCRPW",$J,SDIV,4) W !?(SDCOL+4),$E(SDTLINE,1,32) F SDI=1:1:3 W ?(SDCOL+30+(12*SDI)),$E(SDTLINE,1,10)
W !?(SDCOL+5),$S(SDIV:"DIVISION",1:"REPORT")," TOTAL:" F SDI=1:1:3 W ?(SDCOL+27+(12*SDI)),$J($P(SDTOT,U,SDI),12,0)
Q
;
HD1 ;Print patient list sub-header
Q:SDOUT W !?(SDCOL+8),"Patient",?(SDCOL+40),"SSN",?(SDCOL+54),"Appt. date/time"
W !?(SDCOL+7),$E(SDLINE,1,31),?(SDCOL+40),$E(SDLINE,1,12),?(SDCOL+54),$E(SDLINE,1,18)
Q
;
HD2 ;Print clinic list sub-header
Q:SDOUT W !?(SDCOL+5),"Clinic",?(SDCOL+45),"Appts.",?(SDCOL+57),"Visits",?(SDCOL+68),"Uniques"
W !?(SDCOL+4),$E(SDLINE,1,32) F SDI=1:1:3 W ?(SDCOL+30+(12*SDI)),$E(SDLINE,1,10)
Q
SCRPW61 ;BP-CIOFO/KEITH - Patient Appointment Statistics (cont.) ; 07 May 99 4:33 PM
+1 ;;5.3;Scheduling;**163,176,194,1015**;AUG 13, 1993;Build 21
CNT ;Count clinic statistics
+1 SET SDIV=""
FOR
SET SDIV=$ORDER(^TMP("SCRPW",$JOB,SDIV))
IF SDIV=""!SDOUT
QUIT
Begin DoDot:1
+2 SET SDCLN=""
FOR
SET SDCLN=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN))
IF SDCLN=""
QUIT
DO STOP
IF SDOUT
QUIT
Begin DoDot:2
+3 SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL))
IF 'SDCL
QUIT
Begin DoDot:3
+4 SET SDPTNA=""
FOR
SET SDPTNA=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL,SDPTNA))
IF SDPTNA=""
QUIT
Begin DoDot:4
+5 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL,SDPTNA,DFN))
IF 'DFN
QUIT
Begin DoDot:5
+6 IF SDPL
IF SDPLO'="D"
SET ^TMP("SCRPW",$JOB,SDIV,0,SDCLN,SDCL,$$ORD(),SDPTNA,DFN)=""
+7 SET $PIECE(^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL),U,3)=$PIECE($GET(^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL)),U,3)+1
+8 SET SDDAY=0
FOR
SET SDDAY=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY))
IF 'SDDAY
QUIT
Begin DoDot:6
+9 SET $PIECE(^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL),U,2)=$PIECE($GET(^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL)),U,2)+1
+10 SET SDAPP=0
FOR
SET SDAPP=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY,SDAPP))
IF 'SDAPP
QUIT
Begin DoDot:7
+11 IF SDPL
IF SDPLO="D"
SET ^TMP("SCRPW",$JOB,SDIV,0,SDCLN,SDCL,SDAPP,SDPTNA,DFN)=""
+12 SET $PIECE(^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL),U)=$PIECE($GET(^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL)),U)+1
QUIT
End DoDot:7
+13 QUIT
End DoDot:6
+14 QUIT
End DoDot:5
+15 QUIT
End DoDot:4
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 IF SDOUT
QUIT
+19 ;Count division statistics
+20 SET SDPTNA=""
FOR
SET SDPTNA=$ORDER(^TMP("SCRPW",$JOB,SDIV,2,SDPTNA))
IF SDPTNA=""
QUIT
Begin DoDot:2
+21 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPW",$JOB,SDIV,2,SDPTNA,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+22 SET $PIECE(^TMP("SCRPW",$JOB,SDIV,4),U,3)=$PIECE($GET(^TMP("SCRPW",$JOB,SDIV,4)),U,3)+1
+23 SET SDDAY=0
FOR
SET SDDAY=$ORDER(^TMP("SCRPW",$JOB,SDIV,2,SDPTNA,DFN,SDDAY))
IF 'SDDAY
QUIT
Begin DoDot:4
+24 SET $PIECE(^TMP("SCRPW",$JOB,SDIV,4),U,2)=$PIECE($GET(^TMP("SCRPW",$JOB,SDIV,4)),U,2)+1
+25 SET SDAPP=0
FOR
SET SDAPP=$ORDER(^TMP("SCRPW",$JOB,SDIV,2,SDPTNA,DFN,SDDAY,SDAPP))
IF 'SDAPP
QUIT
Begin DoDot:5
+26 SET $PIECE(^TMP("SCRPW",$JOB,SDIV,4),U)=$PIECE($GET(^TMP("SCRPW",$JOB,SDIV,4)),U)+1
QUIT
End DoDot:5
+27 QUIT
End DoDot:4
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
+32 ;
ORD() ;Determine collating value for patient list
+1 IF SDPLO="A"
QUIT SDPTNA
+2 SET SDSSN=$PIECE(^DPT(DFN,0),U,9)
QUIT $EXTRACT(SDSSN,8,9)_$EXTRACT(SDSSN,6,7)_$EXTRACT(SDSSN,4,5)_$EXTRACT(SDSSN,1,3)_"."
+3 ;
STOP ;Check for stop task request
+1 IF $GET(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
AC ;Gather all clinics
+1 SET SDCL=0
FOR
SET SDCL=$ORDER(^SC(SDCL))
IF 'SDCL
QUIT
SET SDCL0=^SC(SDCL,0)
SET SDIV=$PIECE(SDCL0,U,15)
SET SDAC=0
IF $$DIV()
DO STOP
IF SDOUT
QUIT
DO A1
IF SDAC
DO SET
+2 QUIT
+3 ;
A1 IF $PIECE(SDCL0,U,3)="C"
SET SDAC=1
QUIT
+1 ;
SC ;Gather selected clinics
+1 SET SDCL=0
FOR
SET SDCL=$ORDER(SDCL(SDCL))
IF 'SDCL
QUIT
SET SDCL0=^SC(SDCL,0)
SET SDIV=$PIECE(SDCL0,U,15)
SET SDAC=0
IF $$DIV()
DO STOP
IF SDOUT
QUIT
DO A1
IF SDAC
DO SET
+2 QUIT
+3 ;
RC ;Gather range of clinics
+1 SET SDCLN=$ORDER(SDCL(""))
SET SDECL=$ORDER(SDCL(SDCLN))
SET SDCL=SDCL(SDCLN)
SET SDCL0=^SC(SDCL,0)
SET SDIV=$PIECE(SDCL0,U,15)
SET SDAC=0
IF $$DIV()
DO STOP
IF SDOUT
QUIT
DO A1
IF SDAC
DO SET
+2 FOR
SET SDCLN=$ORDER(^SC("B",SDCLN))
IF (SDCLN=""!(SDCLN]SDECL))
QUIT
SET SDCL=0
FOR
SET SDCL=$ORDER(^SC("B",SDCLN,SDCL))
IF 'SDCL
QUIT
SET SDCL0=^SC(SDCL,0)
SET SDIV=$PIECE(SDCL0,U,15)
SET SDAC=0
IF $$DIV()
DO STOP
IF SDOUT
QUIT
DO A1
IF SDAC
DO SET
+3 QUIT
+4 ;
SS ;Gather clinics with selected Stop Codes
+1 SET SDCL=0
FOR
SET SDCL=$ORDER(^SC(SDCL))
IF 'SDCL
QUIT
SET SDCL0=^SC(SDCL,0)
SET SDIV=$PIECE(SDCL0,U,15)
SET SDAC=0
IF $$DIV()
DO STOP
IF SDOUT
QUIT
DO A1
IF SDAC
DO SS1
+2 QUIT
+3 ;
SS1 SET SDCSC=$PIECE(SDCL0,U,7)
SET SDCSC=$PIECE($GET(^DIC(40.7,+SDCSC,0)),U,2)
IF $DATA(SDCL(+SDCSC))
DO SET
+1 QUIT
+2 ;
RS ;Gather clinics in range of Stop Codes
+1 SET SDBCS=$ORDER(SDCL(""))
SET SDECS=$ORDER(SDCL(SDBCS))
SET SDCL=0
IF 'SDECS
SET SDECS=SDBCS
FOR
SET SDCL=$ORDER(^SC(SDCL))
IF 'SDCL
QUIT
SET SDCL0=^SC(SDCL,0)
SET SDIV=$PIECE(SDCL0,U,15)
SET SDAC=0
IF $$DIV()
DO STOP
IF SDOUT
QUIT
DO A1
IF SDAC
DO RC1
+2 QUIT
+3 ;
RC1 SET SDCSC=$PIECE(SDCL0,U,7)
SET SDCSC=$PIECE($GET(^DIC(40.7,+SDCSC,0)),U,2)
IF ('SDCSC!(SDCSC<SDBCS!(SDCSC>SDECS)))
QUIT
DO SET
QUIT
+1 ;
CG ;Gather clinics with selected clinic group
+1 SET SDCG=$ORDER(SDCL(0))
SET SDCL=0
FOR
SET SDCL=$ORDER(^SC("ASCRPW",SDCG,SDCL))
IF 'SDCL
QUIT
SET SDCL0=^SC(SDCL,0)
SET SDIV=$PIECE(SDCL0,U,15)
SET SDAC=0
IF $$DIV()
DO STOP
IF SDOUT
QUIT
DO A1
IF SDAC
DO SET
+2 QUIT
+3 ;
DIV() ;Check division
+1 IF '$LENGTH(SDIV)
SET SDIV=$$PRIM^VASITE()
+2 IF 'SDDIV
QUIT 1
QUIT $DATA(SDDIV(+SDIV))
+3 ;
SET ;Set ^TMP global
+1 NEW SDPAS
+2 SET SDDAY=SDBDAY
FOR
SET SDDAY=$ORDER(^SC(SDCL,"S",SDDAY))
IF 'SDDAY!(SDDAY>SDEDAY)
QUIT
SET SDI=0
FOR
SET SDI=$ORDER(^SC(SDCL,"S",SDDAY,1,SDI))
IF 'SDI
QUIT
Begin DoDot:1
+3 SET SDCP0=$GET(^SC(SDCL,"S",SDDAY,1,SDI,0))
IF '$LENGTH(SDCP0)
QUIT
IF $PIECE(SDCP0,U,9)="C"
QUIT
+4 SET DFN=$PIECE(SDCP0,U)
SET SDPTNA=$PIECE($GET(^DPT(+DFN,0)),U)
IF '$LENGTH(SDPTNA)
QUIT
+5 SET SDPAS=$PIECE($GET(^DPT(DFN,"S",SDDAY,0)),U,2)
IF $LENGTH(SDPAS)
IF "NA"[SDPAS
QUIT
+6 DO SET1(SDIV)
IF SDMD
DO SET1(0)
QUIT
End DoDot:1
+7 QUIT
+8 ;
SET1(SDIV) SET ^TMP("SCRPW",$JOB,SDIV,1,$PIECE(SDCL0,U),SDCL,SDPTNA,DFN,$PIECE(SDDAY,"."),SDDAY)=""
+1 SET ^TMP("SCRPW",$JOB,SDIV,2,SDPTNA,DFN,$PIECE(SDDAY,"."),SDDAY)=""
+2 QUIT
+3 ;
+1 NEW SDI
+2 FOR SDI=1:1:80
IF $Y>(IOSL-8)
QUIT
WRITE !
+3 WRITE SDLINE,!?(SDCOL),"NOTE: This report reflects appointment workload that is not defined as cancelled"
+4 WRITE !?(SDCOL+6),"or no-showed, including walk-in (unscheduled) appointments. It does not"
+5 WRITE !?(SDCOL+6),"represent all outpatient activity. Report totals are tabulated separately",!?(SDCOL+6),"and will not necessarily be equal to the sum of the sub-total columns.",!,SDLINE
QUIT
+6 ;
DPRT(SDIV) ;Print report for a division
+1 DO DHDR^SCRPW40(4,.SDT)
+2 IF '$DATA(^TMP("SCRPW",$JOB,SDIV))
DO HDR^SCRPW60
SET SDX="No appointments found for this division within report parameters!"
WRITE !!?(132-$LENGTH(SDX)\2),SDX
QUIT
+3 IF SDPL
IF SDIV
SET SDCLN=""
FOR
SET SDCLN=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN))
IF SDCLN=""!SDOUT
QUIT
Begin DoDot:1
+4 SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL))
IF 'SDCL!SDOUT
QUIT
Begin DoDot:2
+5 SET SDT(5)="Patient list for clinic: "_SDCLN
DO HDR^SCRPW60
DO HD1
IF SDOUT
QUIT
+6 SET SDORD=""
FOR
SET SDORD=$ORDER(^TMP("SCRPW",$JOB,SDIV,0,SDCLN,SDCL,SDORD))
IF SDORD=""!SDOUT
QUIT
Begin DoDot:3
+7 SET SDPTNA=""
FOR
SET SDPTNA=$ORDER(^TMP("SCRPW",$JOB,SDIV,0,SDCLN,SDCL,SDORD,SDPTNA))
IF SDPTNA=""!SDOUT
QUIT
Begin DoDot:4
+8 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPW",$JOB,SDIV,0,SDCLN,SDCL,SDORD,SDPTNA,DFN))
IF 'DFN!SDOUT
QUIT
Begin DoDot:5
+9 IF SDPLO="D"
DO PLINE(SDORD)
QUIT
+10 SET SDDAY=0
FOR
SET SDDAY=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY))
IF 'SDDAY!SDOUT
QUIT
Begin DoDot:6
+11 SET SDAPP=0
FOR
SET SDAPP=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY,SDAPP))
IF 'SDAPP!SDOUT
QUIT
Begin DoDot:7
+12 DO PLINE(SDAPP)
QUIT
End DoDot:7
+13 QUIT
End DoDot:6
+14 QUIT
End DoDot:5
+15 QUIT
End DoDot:4
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 IF SDOUT
QUIT
KILL SDT(5)
DO HDR^SCRPW60
DO HD2
IF SDOUT
QUIT
+20 SET SDCLN=""
FOR
SET SDCLN=$ORDER(^TMP("SCRPW",$JOB,SDIV,3,SDCLN))
IF SDCLN=""!SDOUT
QUIT
Begin DoDot:1
+21 SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL))
IF 'SDCL!SDOUT
QUIT
Begin DoDot:2
+22 DO CLINE
QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 IF SDOUT
QUIT
DO DTOT
DO FOOT
QUIT
+25 ;
PLINE(SDAPP) ;Print patient detail line
+1 ;Input: SDAPP=patient appointment date/time
+2 SET SDSSN=$PIECE(^DPT(DFN,0),U,9)
IF $Y>(IOSL-4)
DO HDR^SCRPW60
DO HD1
IF SDOUT
QUIT
+3 WRITE !?(SDCOL+8),SDPTNA,?(SDCOL+40),$EXTRACT(SDSSN,1,3),"-",$EXTRACT(SDSSN,4,5),"-",$EXTRACT(SDSSN,6,10)
SET Y=SDAPP
XECUTE ^DD("DD")
WRITE ?(SDCOL+54),$PIECE(Y,":",1,2)
QUIT
+4 ;
CLINE ;Print clinic sub-total line
+1 SET SDCTOT=^TMP("SCRPW",$JOB,SDIV,3,SDCLN,SDCL)
IF $Y>(IOSL-11)
DO FOOT
DO HDR^SCRPW60
DO HD2
IF SDOUT
QUIT
+2 WRITE !?(SDCOL+5),SDCLN
FOR SDI=1:1:3
WRITE ?(SDCOL+27+(12*SDI)),$JUSTIFY($PIECE(SDCTOT,U,SDI),12,0)
+3 QUIT
+4 ;
DTOT ;Print division total
+1 SET SDTOT=^TMP("SCRPW",$JOB,SDIV,4)
WRITE !?(SDCOL+4),$EXTRACT(SDTLINE,1,32)
FOR SDI=1:1:3
WRITE ?(SDCOL+30+(12*SDI)),$EXTRACT(SDTLINE,1,10)
+2 WRITE !?(SDCOL+5),$SELECT(SDIV:"DIVISION",1:"REPORT")," TOTAL:"
FOR SDI=1:1:3
WRITE ?(SDCOL+27+(12*SDI)),$JUSTIFY($PIECE(SDTOT,U,SDI),12,0)
+3 QUIT
+4 ;
HD1 ;Print patient list sub-header
+1 IF SDOUT
QUIT
WRITE !?(SDCOL+8),"Patient",?(SDCOL+40),"SSN",?(SDCOL+54),"Appt. date/time"
+2 WRITE !?(SDCOL+7),$EXTRACT(SDLINE,1,31),?(SDCOL+40),$EXTRACT(SDLINE,1,12),?(SDCOL+54),$EXTRACT(SDLINE,1,18)
+3 QUIT
+4 ;
HD2 ;Print clinic list sub-header
+1 IF SDOUT
QUIT
WRITE !?(SDCOL+5),"Clinic",?(SDCOL+45),"Appts.",?(SDCOL+57),"Visits",?(SDCOL+68),"Uniques"
+2 WRITE !?(SDCOL+4),$EXTRACT(SDLINE,1,32)
FOR SDI=1:1:3
WRITE ?(SDCOL+30+(12*SDI)),$EXTRACT(SDLINE,1,10)
+3 QUIT
