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

SCRPW75.m

Go to the documentation of this file.
  1. SCRPW75 ;BP-CIOFO/KEITH,ESW - Clinic Appointment Availability Extract (cont.) ; 5/15/03 3:15pm
  1. ;;5.3;Scheduling;**206,223,241,249,291,1015**;AUG 13, 1993;Build 21
  1. ;
  1. ;Input: SDBDT=beginning date
  1. ;Input: SDEDT=ending date
  1. ;Input: SDEX='0' for user report, '1' for Austin extract
  1. ;Output: ^TMP("SDNAVA",$J) array in the format:
  1. ; ^TMP("SDNAVA",$J,division)='x'
  1. ; ^TMP("SDNAVA",$J,division,credit_pair)='x'
  1. ; ^TMP("SDNAVA",$J,division,credit_pair,clinic_ifn)='x'
  1. ; ^TMP("SDNAVA",$J,division;credit_pair,clinic_ifn,date_scheduled)='x'
  1. ; where 'x' consists of:
  1. ; piece 1 = flag '0' appts.
  1. ; 2 = ave. flag '0' wait time
  1. ; 3 = flag '1' appts.
  1. ; 4 = ave. flag '1' wait time
  1. ; 5 = flag '2' appts.
  1. ; 6 = ave. flag '2' wait time
  1. ; 7 = flag '3' appts.
  1. ; 8 = ave. flag '3' wait time
  1. ; 9 = follow-up next ava. appts.
  1. ; 10 = follow-up next ava. wait time
  1. ; 11 = follow-up non-next ava. appts. <2 days
  1. ; 12 = follow-up non-next ava. appts. <2 days wait time*
  1. ; 13 = follow-up non-next ava. appts. 2-7 days
  1. ; 14 = follow-up non-next ava. appts. 2-7 days wait time*
  1. ; 15 = follow-up non-next ava. appts. 8-30 days
  1. ; 16 = follow-up non-next ava. appts. 8-30 days wait time*
  1. ; 17 = follow-up non-next ava. appts. 31-60 days
  1. ; 18 = follow-up non-next ava. appts. 31-60 days wait time*
  1. ; 19 = follow-up non-next ava. appts. >60 days
  1. ; 20 = follow-up non-next ava. appts. >60 days wait time*
  1. ; 21 = non-follow-up next ava. appts.
  1. ; 22 = non-follow-up next ava. wait time
  1. ; 23 = non-follow-up non-next ava. appts. <2 days
  1. ; 24 = non-follow-up non-next ava. appts. <2 days wait time*
  1. ; 25 = non-follow-up non-next ava. appts. <2 days wait time**
  1. ; 26 = non-follow-up non-next ava. appts. 2-7 days
  1. ; 27 = non-follow-up non-next ava. appts. 2-7 days wait time*
  1. ; 28 = non-follow-up non-next ava. appts. 2-7 days wait time**
  1. ; 29 = non-follow-up non-next ava. appts. 8-30 days
  1. ; 30 = non-follow-up non-next ava. appts. 8-30 days wait time*
  1. ; 31 = non-follow-up non-next ava. appts. 8-30 days wait time**
  1. ; 32 = non-follow-up non-next ava. appts. 31-60 days
  1. ; 33 = non-follow-up non-next ava. appts. 31-60 days wait time*
  1. ; 34 = non-follow-up non-next ava. appts. 31-60 days wait time**
  1. ; 35 = non-follow-up non-next ava. appts. >60 days
  1. ; 36 = non-follow-up non-next ava. appts. >60 days wait time*
  1. ; 37 = non-follow-up non-next ava. appts. >60 days wait time**
  1. ; 38 = percent of non-next ava. appts. within 30 days
  1. ; 39 = percent of next ava. appts. within 30 days
  1. ;
  1. ; ^TMP("SDNAVB",$J) array in the format:
  1. ; ^TMP("SDNAVB",$J,division,credit_pair,clinic_ifn)='y'
  1. ; where 'y' consists of:
  1. ; piece 1 = % non-follow-up next ava. appts. within 30 days*
  1. ; 2 = % non-follow-up next ava. appts. within 30 days**
  1. ; 3 = % non-follow-up non-next ava. appts. within 30 days*
  1. ; 4 = % non-follow-up non-next ava. appts. within 30 days**
  1. ; 5 = sum of squared wait time next ava. appts.**
  1. ; 6 = sum of squared wait time non-follow-up appts.*
  1. ; 7 = sum of squared wait time non-follow-up appts.**
  1. ; 8 = total non-follow-up appointments
  1. ;
  1. ; * desired date to appointment date
  1. ; ** transaction date to appointment date
  1. ;
  1. N SDT,SDCT,DFN,SDADT,SDAP,SDAP0,SDWAIT,SDSFU,SDCWT3,SDAVE
  1. N SDCL,SDFLAG,SDX,SDY,SDZ,SDI,SC0,SDCP,SDSDEV,SDSDDT,SDAVE2
  1. S SDT=SDBDT-1,(SDOUT,SDCT)=0
  1. K ^TMP("SDWNAVA",$J),^TMP("SDXNAVA",$J),^TMP("SDYNAVA",$J),^TMP("SDZNAVA",$J),^TMP("SDNAVA",$J),^TMP("SDNAVB",$J)
  1. ;Iterate through 'date scheduled' xref
  1. F S SDT=$O(^DPT("ASADM",SDT)) Q:SDOUT!'SDT!(SDT>SDEDT) S DFN=0 D
  1. .F S DFN=$O(^DPT("ASADM",SDT,DFN)) Q:SDOUT!'DFN S SDADT=0 D
  1. ..I $G(SDREPORT(5))=1 I '$D(^TMP("SDIPLST",$J,DFN)) Q ;only selected patient if (5)
  1. ..Q:$E($P($G(^DPT(DFN,0)),U,9),1,5)="00000" ;exclude test patients
  1. ..F S SDADT=$O(^DPT("ASADM",SDT,DFN,SDADT)) Q:SDOUT!'SDADT D
  1. ...;Check for 'stop task' request
  1. ...S SDCT=SDCT+1 I SDCT#1000=0 D STOP Q:SDOUT
  1. ...;Get appointment node
  1. ...S SDAP0=$G(^DPT(DFN,"S",SDADT,0)) Q:$P(SDAP0,U,19)'=SDT
  1. ...I '$G(SDREPORT(5)) Q:$P(SDAP0,U,2)="C"!($P(SDAP0,U,2)="CA") ;quit if cancelled by clinic
  1. ...S SDCL=+SDAP0 Q:SDCL<1 ;get clinic
  1. ...;'next ava.' appointment indicator
  1. ...S SDFLAG=+$P(SDAP0,U,26)
  1. ...;'date desired' and 'follow up visit' indicator
  1. ...S SDX=$G(^DPT(DFN,"S",SDADT,1))
  1. ...S SDSDDT=+$P(SDX,U),SDSFU=$P(SDX,U,2),SDSDEV=""
  1. ...;Calculate wait time 1 (transaction date to appointment)
  1. ...S SDWAIT=$S(SDADT<SDT:0,1:$$FMDIFF^XLFDT(SDADT,SDT,1))
  1. ...;Calculate wait time 2 (date desired to appointment)
  1. ...S SDCWT3=$$CWT3(SDADT,SDFLAG,SDSDDT,SDSFU,.SDSDEV,.SDX,.SDY,.SDZ)
  1. ...;Gather patient appointment list information
  1. ...I $G(SDREPORT(4)),$D(^TMP("SDPLIST",$J,SDCL)) D
  1. ....N SDPNAME,SDATA,SDSSN
  1. ....S SDATA=$G(^DPT(DFN,0))
  1. ....S SDSSN=$P(SDATA,U,9),SDPNAME=$P(SDATA,U) Q:'$L(SDPNAME)
  1. ....S SDATA=SDSSN_U_$P(SDAP0,U,25)_U_SDFLAG_U_SDSDDT_U_SDSFU_U_SDWAIT_U_SDSDEV
  1. ....S ^TMP("SDPLIST",$J,SDCL,SDT,SDPNAME,DFN,SDADT)=SDATA
  1. ....Q
  1. ...I $G(SDREPORT(5)) I $D(^TMP("SDIPLST",$J,DFN,SDCL)) D GEN5A^SCRPW78(SDAP0,DFN,SDADT,SDCL,SDWAIT,SDT,SDSFU,SDSDEV,SDSDDT,SDFLAG)
  1. ...;Accrue phase II values ('next ava.' appts.)
  1. ...S $P(^TMP("SDXNAVA",$J,SDCL),U,((SDFLAG*2)+1))=$P($G(^TMP("SDXNAVA",$J,SDCL)),U,((SDFLAG*2)+1))+1
  1. ...S $P(^TMP("SDXNAVA",$J,SDCL),U,((SDFLAG*2)+2))=$P(^TMP("SDXNAVA",$J,SDCL),U,((SDFLAG*2)+2))+SDWAIT
  1. ...I SDWAIT<31 S $P(^TMP("SDXNAVA",$J,SDCL),U,9+(SDFLAG#2))=$P(^TMP("SDXNAVA",$J,SDCL),U,9+(SDFLAG#2))+1
  1. ...;Accrue sum of squared wait time for standard deviation
  1. ...I SDFLAG#2 S $P(^TMP("SDWNAVA",$J,SDCL),U,5)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,5)+(SDWAIT*SDWAIT)
  1. ...;Accrue phase III values ('date desired' deviation)
  1. ...I SDCWT3 D
  1. ....S $P(^TMP("SDYNAVA",$J,SDCL),U,SDX)=$P($G(^TMP("SDYNAVA",$J,SDCL)),U,SDX)+1
  1. ....S $P(^TMP("SDYNAVA",$J,SDCL),U,SDY)=$P(^TMP("SDYNAVA",$J,SDCL),U,SDY)+SDSDEV
  1. ....S:SDZ $P(^TMP("SDYNAVA",$J,SDCL),U,SDZ)=$P(^TMP("SDYNAVA",$J,SDCL),U,SDZ)+SDWAIT
  1. ....;Gather additional information for non-follow-up appointments
  1. ....I 'SDSFU D
  1. .....;Accrue next ava. and non-next ava. appts. less than 31 days
  1. .....N SDP S SDP=$S(SDFLAG#2:1,1:3)
  1. .....I SDSDEV<31 S $P(^TMP("SDWNAVA",$J,SDCL),U,SDP)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,SDP)+1
  1. .....I SDWAIT<31 S $P(^TMP("SDWNAVA",$J,SDCL),U,SDP+1)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,SDP+1)+1
  1. .....;Accrue sum of squared wait time for standard deviation
  1. .....S $P(^TMP("SDWNAVA",$J,SDCL),U,6)=$P($G(^TMP("SDWNAVA",$J,SDCL)),U,6)+(SDSDEV*SDSDEV)
  1. .....S $P(^TMP("SDWNAVA",$J,SDCL),U,7)=$P(^TMP("SDWNAVA",$J,SDCL),U,7)+(SDWAIT*SDWAIT)
  1. .....;Total of non-follow-up appointments
  1. .....S $P(^TMP("SDWNAVA",$J,SDCL),U,8)=$P(^TMP("SDWNAVA",$J,SDCL),U,8)+1
  1. .....Q
  1. ....Q
  1. ...;Accrue values for daily detail
  1. ...Q:SDEX=1!(SDFMT'="D")
  1. ...S $P(^TMP("SDXNAVA",$J,SDCL,SDT),U,((SDFLAG*2)+1))=$P($G(^TMP("SDXNAVA",$J,SDCL,SDT)),U,((SDFLAG*2)+1))+1
  1. ...S $P(^TMP("SDXNAVA",$J,SDCL,SDT),U,((SDFLAG*2)+2))=$P(^TMP("SDXNAVA",$J,SDCL,SDT),U,((SDFLAG*2)+2))+SDWAIT
  1. ...I SDWAIT<31 S $P(^TMP("SDXNAVA",$J,SDCL,SDT),U,9+(SDFLAG#2))=$P($G(^TMP("SDXNAVA",$J,SDCL,SDT)),U,9+(SDFLAG#2))+1
  1. ...I SDCWT3 D
  1. ....S $P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDX)=$P($G(^TMP("SDYNAVA",$J,SDCL,SDT)),U,SDX)+1
  1. ....S $P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDY)=$P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDY)+SDSDEV
  1. ....S:SDZ $P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDZ)=$P(^TMP("SDYNAVA",$J,SDCL,SDT),U,SDZ)+SDWAIT
  1. ...Q
  1. ..Q
  1. .Q
  1. Q:SDOUT S SDCL=0
  1. D ACCRUE^SCRPW77
  1. Q
  1. ;
  1. STOP ;Check for stop task request
  1. S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1. ;
  1. CWT3(SDADT,SDFLAG,SDSDDT,SDSFU,SDSDEV,SDX,SDY,SDZ) ;Get phase III data
  1. ;Input: SDADT=appointment date
  1. ;Input: SDFLAG='next ava.' appointment indicator
  1. ;Input: SDSDDT=desired date
  1. ;Input: SDSFU=follow up indicator
  1. ;Input: SDSDEV=deviation from desired date (pass by reference)
  1. ;Input: SDX, SDY, SDZ=string locations to update (pass by reference)
  1. ;Output: '1' if phase III data exists, '0' otherwise
  1. ;
  1. N SDDCAT
  1. I '$L(SDSDDT)!'$L(SDSFU) Q 0 ;no phase III data
  1. S SDSDEV=$S(SDADT<SDSDDT:0,1:$$FMDIFF^XLFDT(SDADT,SDSDDT,1)) ;wait time
  1. S SDDCAT=$$DCAT(SDSDEV) ;date range category
  1. ;follow-up next ava. appts.
  1. I SDSFU,SDFLAG#2 S SDX=1,SDY=2,SDZ=0 Q 1
  1. ;follow-up non-next ava. appts.
  1. I SDSFU,'(SDFLAG#2) S SDX=SDDCAT*2+1,SDY=SDX+1,SDZ=0 Q 1
  1. ;non-follow-up next ava. appts.
  1. I 'SDSFU,SDFLAG#2 S SDX=13,SDY=14,SDZ=0 Q 1
  1. ;non-follow-up non-next ava. appts.
  1. I 'SDSFU,'(SDFLAG#2) S SDX=SDDCAT+4*3,SDY=SDX+1,SDZ=SDX+2
  1. Q 1
  1. ;
  1. DCAT(SDSDEV) ;Determine date range category
  1. ;Input: SDSDEV=wait time
  1. ;Output: category where '1' = <2 days
  1. ; '2' = 2-7 days
  1. ; '3' = 8-30 days
  1. ; '4' = 31-60 days
  1. ; '5' = >60 days
  1. ;
  1. Q:SDSDEV<2 1
  1. Q:SDSDEV<8 2
  1. Q:SDSDEV<31 3
  1. Q:SDSDEV<61 4
  1. Q 5