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

SCRPW61.m

Go to the documentation of this file. 
  1. 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
  1. CNT ;Count clinic statistics
  1.  S SDIV="" F  S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT  D
  1.  .S SDCLN="" F  S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN)) Q:SDCLN=""  D STOP Q:SDOUT  D
  1.  ..S SDCL=0 F  S SDCL=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL)) Q:'SDCL  D
  1.  ...S SDPTNA="" F  S SDPTNA=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA)) Q:SDPTNA=""  D
  1.  ....S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN)) Q:'DFN  D
  1.  .....I SDPL,SDPLO'="D" S ^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,$$ORD(),SDPTNA,DFN)=""
  1.  .....S $P(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL),U,3)=$P($G(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)),U,3)+1
  1.  .....S SDDAY=0 F  S SDDAY=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY)) Q:'SDDAY  D
  1.  ......S $P(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL),U,2)=$P($G(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)),U,2)+1
  1.  ......S SDAPP=0 F  S SDAPP=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY,SDAPP)) Q:'SDAPP  D
  1.  .......I SDPL,SDPLO="D" S ^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDAPP,SDPTNA,DFN)=""
  1.  .......S $P(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL),U)=$P($G(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)),U)+1 Q
  1.  ......Q
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q:SDOUT
  1.  .;Count division statistics
  1.  .S SDPTNA="" F  S SDPTNA=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA)) Q:SDPTNA=""  D
  1.  ..S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN)) Q:'DFN  D
  1.  ...S $P(^TMP("SCRPW",$J,SDIV,4),U,3)=$P($G(^TMP("SCRPW",$J,SDIV,4)),U,3)+1
  1.  ...S SDDAY=0 F  S SDDAY=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,SDDAY)) Q:'SDDAY  D
  1.  ....S $P(^TMP("SCRPW",$J,SDIV,4),U,2)=$P($G(^TMP("SCRPW",$J,SDIV,4)),U,2)+1
  1.  ....S SDAPP=0 F  S SDAPP=$O(^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,SDDAY,SDAPP)) Q:'SDAPP  D
  1.  .....S $P(^TMP("SCRPW",$J,SDIV,4),U)=$P($G(^TMP("SCRPW",$J,SDIV,4)),U)+1 Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. ORD() ;Determine collating value for patient list
  1.  Q:SDPLO="A" SDPTNA
  1.  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)_"."
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. AC ;Gather all clinics
  1.  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
  1.  Q
  1.  ;
  1. A1 S:$P(SDCL0,U,3)="C" SDAC=1 Q
  1.  ;
  1. SC ;Gather selected clinics
  1.  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
  1.  Q
  1.  ;
  1. RC ;Gather range of clinics
  1.  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
  1.  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
  1.  Q
  1.  ;
  1. SS ;Gather clinics with selected Stop Codes
  1.  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
  1.  Q
  1.  ;
  1. SS1 S SDCSC=$P(SDCL0,U,7),SDCSC=$P($G(^DIC(40.7,+SDCSC,0)),U,2) I $D(SDCL(+SDCSC)) D SET
  1.  Q
  1.  ;
  1. RS ;Gather clinics in range of Stop Codes
  1.  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
  1.  Q
  1.  ;
  1. 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
  1.  ;
  1. CG ;Gather clinics with selected clinic group
  1.  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
  1.  Q
  1.  ;
  1. DIV() ;Check division
  1.  S:'$L(SDIV) SDIV=$$PRIM^VASITE()
  1.  Q:'SDDIV 1  Q $D(SDDIV(+SDIV))
  1.  ;
  1. SET ;Set ^TMP global
  1.  N SDPAS
  1.  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
  1.  .S SDCP0=$G(^SC(SDCL,"S",SDDAY,1,SDI,0)) Q:'$L(SDCP0)  Q:$P(SDCP0,U,9)="C"
  1.  .S DFN=$P(SDCP0,U),SDPTNA=$P($G(^DPT(+DFN,0)),U) Q:'$L(SDPTNA)
  1.  .S SDPAS=$P($G(^DPT(DFN,"S",SDDAY,0)),U,2) I $L(SDPAS),"NA"[SDPAS Q
  1.  .D SET1(SDIV) D:SDMD SET1(0) Q
  1.  Q
  1.  ;
  1. SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,$P(SDCL0,U),SDCL,SDPTNA,DFN,$P(SDDAY,"."),SDDAY)=""
  1.  S ^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,$P(SDDAY,"."),SDDAY)=""
  1.  Q
  1.  ;
  1.  N SDI
  1.  F SDI=1:1:80 Q:$Y>(IOSL-8)  W !
  1.  W SDLINE,!?(SDCOL),"NOTE: This report reflects appointment workload that is not defined as cancelled"
  1.  W !?(SDCOL+6),"or no-showed, including walk-in (unscheduled) appointments.  It does not"
  1.  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
  1.  ;
  1. DPRT(SDIV) ;Print report for a division
  1.  D DHDR^SCRPW40(4,.SDT)
  1.  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
  1.  I SDPL,SDIV S SDCLN="" F  S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN)) Q:SDCLN=""!SDOUT  D
  1.  .S SDCL=0 F  S SDCL=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL)) Q:'SDCL!SDOUT  D
  1.  ..S SDT(5)="Patient list for clinic: "_SDCLN D HDR^SCRPW60,HD1 Q:SDOUT
  1.  ..S SDORD="" F  S SDORD=$O(^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDORD)) Q:SDORD=""!SDOUT  D
  1.  ...S SDPTNA="" F  S SDPTNA=$O(^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDORD,SDPTNA)) Q:SDPTNA=""!SDOUT  D
  1.  ....S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,0,SDCLN,SDCL,SDORD,SDPTNA,DFN)) Q:'DFN!SDOUT  D
  1.  .....I SDPLO="D" D PLINE(SDORD) Q
  1.  .....S SDDAY=0 F  S SDDAY=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY)) Q:'SDDAY!SDOUT  D
  1.  ......S SDAPP=0 F  S SDAPP=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL,SDPTNA,DFN,SDDAY,SDAPP)) Q:'SDAPP!SDOUT  D
  1.  .......D PLINE(SDAPP) Q
  1.  ......Q
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q:SDOUT  K SDT(5) D HDR^SCRPW60,HD2 Q:SDOUT
  1.  S SDCLN="" F  S SDCLN=$O(^TMP("SCRPW",$J,SDIV,3,SDCLN)) Q:SDCLN=""!SDOUT  D
  1.  .S SDCL=0 F  S SDCL=$O(^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL)) Q:'SDCL!SDOUT  D
  1.  ..D CLINE Q
  1.  .Q
  1.  Q:SDOUT  D DTOT,FOOT Q
  1.  ;
  1. PLINE(SDAPP) ;Print patient detail line
  1.  ;Input: SDAPP=patient appointment date/time
  1.  S SDSSN=$P(^DPT(DFN,0),U,9) D:$Y>(IOSL-4) HDR^SCRPW60,HD1 Q:SDOUT
  1.  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
  1.  ;
  1. CLINE ;Print clinic sub-total line
  1.  S SDCTOT=^TMP("SCRPW",$J,SDIV,3,SDCLN,SDCL) D:$Y>(IOSL-11) FOOT,HDR^SCRPW60,HD2 Q:SDOUT
  1.  W !?(SDCOL+5),SDCLN F SDI=1:1:3 W ?(SDCOL+27+(12*SDI)),$J($P(SDCTOT,U,SDI),12,0)
  1.  Q
  1.  ;
  1. DTOT ;Print division total
  1.  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)
  1.  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)
  1.  Q
  1.  ;
  1. HD1 ;Print patient list sub-header
  1.  Q:SDOUT  W !?(SDCOL+8),"Patient",?(SDCOL+40),"SSN",?(SDCOL+54),"Appt. date/time"
  1.  W !?(SDCOL+7),$E(SDLINE,1,31),?(SDCOL+40),$E(SDLINE,1,12),?(SDCOL+54),$E(SDLINE,1,18)
  1.  Q
  1.  ;
  1. HD2 ;Print clinic list sub-header
  1.  Q:SDOUT  W !?(SDCOL+5),"Clinic",?(SDCOL+45),"Appts.",?(SDCOL+57),"Visits",?(SDCOL+68),"Uniques"
  1.  W !?(SDCOL+4),$E(SDLINE,1,32) F SDI=1:1:3 W ?(SDCOL+30+(12*SDI)),$E(SDLINE,1,10)
  1.  Q