SCRPW3 ;RENO/KEITH - Clinic Utilization Statistical Summary (cont.) ; 14 May 99 10:45 PM
;;5.3;PIMS;**139,144,184,194,540,1015,1016**;JUN 30, 2012;Build 20
START ;Print statistics
F S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN)) Q:SDCLN=""!SDOUT S SDCL=0 F S SDCL=$O(^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL)) Q:'SDCL!SDOUT D CLINE
Q:SDOUT D:$Y>(IOSL-12) FOOT^SCRPW2,HDR^SCRPW2 Q:SDOUT W ! F SDI=1:1:8 W ?(22+(SDI*10)),"--------"
W ?112,"--------- ---------",!,"*** CLINIC TOTALS ***" S SDCT=SDTAP_U_SDTOB_U_SDTSL_U_SDTNS_U_SDTVSL_U_SDTNSVS_U_SDTOS
D F1 D FOOT^SCRPW2 Q:'$D(^TMP("SCRPW",$J,SDIV,2))
D HDR^SCRPW2 Q:SDOUT W !!,"*** PROVIDER SUMMARY (based on clinic default provider definition) ***"
S SDPRN="" F S SDPRN=$O(^TMP("SCRPW",$J,SDIV,2,SDPRN)) Q:SDPRN=""!SDOUT S SDPR=0 F S SDPR=$O(^TMP("SCRPW",$J,SDIV,2,SDPRN,SDPR)) Q:'SDPR!SDOUT D PLINE
Q:SDOUT D FOOT^SCRPW2
Q
;
STOP ;Check for stop task request
S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0)
Q
;
AC ;Evaluate 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 CNT,SET
Q
;
A1 Q:$P(SDCL0,U,3)'="C" S SDCLI=$G(^SC(SDCL,"I")) Q:(($P(SDCLI,U)>0)&($P(SDCLI,U)<SDBDAY)&($P(SDCLI,U,2)=""!($P(SDCLI,U,2)>SDEDAY))) S SDAC=1
Q
;
SC ;Evaluate 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 CNT,SET
Q
;
RC ;Evaluate a 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 CNT,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 CNT,SET
Q
;
RS ;Evaluate a 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 CNT,SET
Q
;
CG ;Evaluate by 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 CNT,SET
Q
;
DIV() ;Check division
S:'$L(SDIV) SDIV=$$PRIM^VASITE()
Q:'SDDIV 1 Q $D(SDDIV(+SDIV))
;
CNT ;Evaluate a clinic
S SDDAY=SDBDAY-1,(SDVSL,SDAP,SDF1,SDOB,SDSL,SDNS,SDNSVS,SDOS)=0,SDLAP=$P($G(^SC(SDCL,"SL")),U)
D SPAT(SDCL,SDBDAY,SDMAX),CCPAT S SDOB=SDAP-SDSL S:SDOB<0 SDOB=0
Q
;
CCPAT ;Count clinic patterns and patients
F S SDDAY=$O(^TMP(SDSUB,$J,SDCL,"ST",SDDAY)) Q:('SDDAY!(SDDAY>SDEDAY)) D CTPAT(SDDAY)
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 S SDCP0=$G(^SC(SDCL,"S",SDDAY,1,SDI,0)) D:$L(SDCP0) ACT
Q
;
CTPAT(SDDAY) ;Count slots in availability pattern and master pattern
;Input: SDDAY=date to evaluate
N SDPATT,SDPCT,SDFLAG,SDHLDPAT ;SD*562 added last 2 variables
S SDPATT=$E($G(^TMP(SDSUB,$J,SDCL,"ST",SDDAY,1)),6,999) Q:SDPATT'["["
S SDFLAG=0 I SDPATT["X" S SDFLAG=1,SDHLDPAT=SDPATT ;SD*562 check for partial canx
S SDF1=1,SDOS=SDOS+$$PCT(SDPATT)
S SDPATT=$E($G(^SC(SDCL,"OST",SDDAY,1)),6,999) I $L(SDPATT) S:SDPATT["X" SDFLAG=1,SDHLDPAT=SDPATT D:SDFLAG ADJUST S SDSL=SDSL+$$PCT(SDPATT) Q ;SD*562 check for partially cancelled day
N X,%H,%T,%Y,SDDW,SDMPDT
S X=SDDAY D H^%DTC S SDDW="T"_%Y,SDMPDT=$O(^SC(SDCL,SDDW,SDDAY))
I SDMPDT S SDPATT=$G(^SC(SDCL,SDDW,SDMPDT,1)) D:SDFLAG ADJUST S SDPCT=$$PCT(SDPATT) I SDPCT S SDSL=SDSL+SDPCT ;SD*562 added API ADJUST to calculate clinic capacity for partially cancelled day
Q
;
PCT(SDPATT) ;Pattern count
;Input: SDPATT=pattern to evaluate
N X,I S X=0
S SDPATT=$TR(SDPATT," |[]","")
F I=1:1:$L(SDPATT) S X=X+$G(SD($E(SDPATT,I)))
Q X
;
ADJUST ;SD*562 calculate clinic capacity for partially cancelled day
;SDHLDPAT equals updated pattern from "ST" node
;SDPATT equals Master Pattern for day
S SDUP="",SDUP=SDHLDPAT,CT=0
S SDUP=$TR(SDUP," |[]","")
F I=1:1:$L(SDUP) I $E(SDUP,I)'="X" S CT=CT+1
S SDPATT=$TR(SDPATT," |[]","")
S SDPATT=$E(SDPATT,1,CT)
K CT,SDUP,I
Q
;
SET ;Set stats into ^TMP global
S SDPR=0 I SDF1 S SDPR=$O(^SC("ADPR",SDCL,SDPR)),SDPR=$P($G(^SC(SDCL,"PR",+SDPR,0)),U) I SDPR S SDPRN=$P($G(^VA(200,SDPR,0)),U) S:'$L(SDPRN) SDPR=0
D SET1(SDIV) D:SDMD SET1(0)
Q
;
SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,$P(SDCL0,U),SDCL)=$S('SDF1:"",1:SDAP_U_SDOB_U_SDSL_U_SDNS_U_SDVSL_U_SDNSVS_U_SDOS)
Q:'SDPR S SDPCT=$G(^TMP("SCRPW",$J,SDIV,2,SDPRN,SDPR))
S ^TMP("SCRPW",$J,SDIV,2,SDPRN,SDPR)=($P(SDPCT,U)+SDAP)_U_($P(SDPCT,U,2)+SDOB)_U_($P(SDPCT,U,3)+SDSL)_U_($P(SDPCT,U,4)+SDNS)_U_($P(SDPCT,U,5)+SDVSL)_U_($P(SDPCT,U,6)+SDNSVS)_U_($P(SDPCT,U,7)+SDOS)
Q
;
CLINE ;Print a clinic statistics line
D:$Y>(IOSL-12) FOOT^SCRPW2,HDR^SCRPW2 Q:SDOUT S SDCT=^TMP("SCRPW",$J,SDIV,1,SDCLN,SDCL) W !!,SDCLN I '$L(SDCT) W " (No ava. found)" Q
D F1 S SDTAP=SDTAP+SDAP,SDTOB=SDTOB+SDOB,SDTSL=SDTSL+SDSL,SDTNS=SDTNS+SDNS,SDTVSL=SDTVSL+SDVSL,SDTNSVS=SDTNSVS+SDNSVS,SDTOS=SDTOS+SDOS
Q
;
F1 S SDAP=$P(SDCT,U),SDOB=$P(SDCT,U,2),SDSL=$P(SDCT,U,3),SDNS=$P(SDCT,U,4),SDVSL=$P(SDCT,U,5),SDNSVS=$P(SDCT,U,6),SDOS=$P(SDCT,U,7)
W ?32,$J(SDAP,8),?42,$J(SDVSL,8),?52,$J(SDNS,8),?62,$J(SDNSVS,8),?72,$J(SDOB,8),?82,$J(SDOS,8),?92,$J((SDSL-SDAP-SDVSL),8)
S SDCAP=SDSL W ?102,$J(SDCAP,8),?112,$J($S(SDCAP=0:0,1:(SDAP+SDVSL*100)/SDCAP),8,2),"%"
W ?123,$J($S(SDCAP=0:0,1:((SDAP+SDVSL-SDNS-SDNSVS)*100)/SDCAP),8,2),"%"
Q
;
PLINE ;Print a provider statistics line
D:$Y>(IOSL-12) FOOT^SCRPW2,HDR^SCRPW2 Q:SDOUT S SDCT=^TMP("SCRPW",$J,SDIV,2,SDPRN,SDPR) W !!,SDPRN," (",SDPR,")" D F1
Q
;
ACT ;Count appointments, addl. variable appt. slots and no-shows
Q:$P(SDCP0,U,9)="C" ;Quit if cancelled
S SDPLAP=$P(SDCP0,U,2),SDPESL=0 I SDLAP,SDPLAP>SDLAP S SDPESL=SDPLAP\SDLAP-1,SDVSL=SDVSL+SDPESL
Q:'SDCP0 ;SD*5.3*540
S SDAP=SDAP+1,SDF1=1
S SDPAS=^DPT($P(SDCP0,U),"S",SDDAY,0),SDPAS=$P(SDPAS,U,2) Q:SDPAS="" S:"NA"[SDPAS SDNS=SDNS+1,SDNSVS=SDNSVS+SDPESL
Q
;
SPAT(SC,SDSTRTDT,MAX,SDS) ;Set patterns into ^TMP (modified clone of OVR^SDAUT1)
;Input: SC=clinic ifn
;Input: SDSTRTDT=start date for gathering patterns
;Input: MAX=number of days beyond start date to gather patterns
;Input: SDS=array namespace subscript value (optional)
;Output: array of clinic current availability patterns in
; ^TMP(SDS,$J,clinic_ifn,"ST",date,1)
;
S SDS=$G(SDS) S:'$L(SDS) SDS="SDTMP" K ^TMP(SDS,$J)
N SI,SDIN,SDRE,SDSOH,ENDATE,X,X1,X2,SM,I,D,J,Y,SS,DAY
S SDIN=$G(^SC(SC,"I")),SDRE=$P(SDIN,U,2),SDIN=$P(SDIN,U)
S DAY="SU^MO^TU^WE^TH^FR^SA"
S SI=$P($G(^SC(SC,"SL")),U,6),SI=$S(SI<3:4,1:SI)
S SDSOH=$S('$D(^SC(SC,"SL")):0,$P(^SC(SC,"SL"),"^",8)']"":0,1:1)
S X1=SDSTRTDT,X2=MAX,SDIN=$G(SDIN) D C^%DTC S ENDATE=X,X=SDSTRTDT
EN1 S:$O(^SC(SC,"T",0))>X X=$O(^SC(SC,"T",0))
S Y=$$DOW^XLFDT(X,1),I=Y+32,SM=X,D=Y D WM
K J F Y=0:1:6 I $D(^SC(+SC,"T"_Y)) S J(Y)=""
I '$D(J) D Q
.S D=SDSTRTDT-1 F S D=$O(^SC(SC,"ST",D)) Q:'D!(D>ENDATE) D
..S X=$G(^SC(SC,"ST",D,1)) S:$L(X) ^TMP(SDS,$J,SC,"ST",D,1)=X Q
.Q
X1 Q:X>ENDATE S X1=X\100_28
I '$$ACTIVE(X,SDIN,SDRE) S X1=X,X2=1 D C^%DTC G X1
W S X=X\1
I $D(^SC(+SC,"ST",X,1)) S ^TMP(SDS,$J,SC,"ST",X,1)=^SC(+SC,"ST",X,1) G W1
I '$D(^SC(SC,"ST",X,1)) S Y=D#7 G L:'$D(J(Y)),H:$D(^HOLIDAY(X))&('SDSOH) S SS=$O(^SC(SC,"T"_Y,X)) G L:SS<1,L:^SC(SC,"T"_Y,SS,1)="" D
.S ^TMP(SDS,$J,SC,"ST",X\1,1)=$P(DAY,U,Y+1)_" "_$E(X,6,7)_$J("",SI+SI-6)_^SC(SC,"T"_Y,SS,1) Q
W1 D WM:X>SM
L Q:X>ENDATE S X=X+1,D=D+1 G W:X'>X1 S X2=X-X1 D C^%DTC G X1
;
H S ^TMP(SDS,$J,SC,"ST",X,1)=" "_$E(X,6,7)_" "_$P(^(X,0),U,2) G W1
;
WM S SM=$S($E(X,4,5)[12:$E(X,1,3)+1_"01",1:$E(X,1,3)_$E(X,4,5)+1)_"00" Q
;
ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
;Input: X=date to be examined
;Input: SDIN=clinic inactive date
;Input: SDRE=clinic reactivate date
;Output: '1'=active, '0'=inactive
Q:'SDIN 1 Q:X<SDIN 1 Q:'SDRE 0 Q:X<SDRE 0 Q 1
SCRPW3 ;RENO/KEITH - Clinic Utilization Statistical Summary (cont.) ; 14 May 99 10:45 PM
+1 ;;5.3;PIMS;**139,144,184,194,540,1015,1016**;JUN 30, 2012;Build 20
START ;Print statistics
+1 FOR
SET SDCLN=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN))
IF SDCLN=""!SDOUT
QUIT
SET SDCL=0
FOR
SET SDCL=$ORDER(^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL))
IF 'SDCL!SDOUT
QUIT
DO CLINE
+2 IF SDOUT
QUIT
IF $Y>(IOSL-12)
DO FOOT^SCRPW2
DO HDR^SCRPW2
IF SDOUT
QUIT
WRITE !
FOR SDI=1:1:8
WRITE ?(22+(SDI*10)),"--------"
+3 WRITE ?112,"--------- ---------",!,"*** CLINIC TOTALS ***"
SET SDCT=SDTAP_U_SDTOB_U_SDTSL_U_SDTNS_U_SDTVSL_U_SDTNSVS_U_SDTOS
+4 DO F1
DO FOOT^SCRPW2
IF '$DATA(^TMP("SCRPW",$JOB,SDIV,2))
QUIT
+5 DO HDR^SCRPW2
IF SDOUT
QUIT
WRITE !!,"*** PROVIDER SUMMARY (based on clinic default provider definition) ***"
+6 SET SDPRN=""
FOR
SET SDPRN=$ORDER(^TMP("SCRPW",$JOB,SDIV,2,SDPRN))
IF SDPRN=""!SDOUT
QUIT
SET SDPR=0
FOR
SET SDPR=$ORDER(^TMP("SCRPW",$JOB,SDIV,2,SDPRN,SDPR))
IF 'SDPR!SDOUT
QUIT
DO PLINE
+7 IF SDOUT
QUIT
DO FOOT^SCRPW2
+8 QUIT
+9 ;
STOP ;Check for stop task request
+1 IF $GET(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
+2 QUIT
+3 ;
AC ;Evaluate 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 CNT
DO SET
+2 QUIT
+3 ;
A1 IF $PIECE(SDCL0,U,3)'="C"
QUIT
SET SDCLI=$GET(^SC(SDCL,"I"))
IF (($PIECE(SDCLI,U)>0)&($PIECE(SDCLI,U)<SDBDAY)&($PIECE(SDCLI,U,2)=""!($PIECE(SDCLI,U,2)>SDEDAY)))
QUIT
SET SDAC=1
+1 QUIT
+2 ;
SC ;Evaluate 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 CNT
DO SET
+2 QUIT
+3 ;
RC ;Evaluate a 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 CNT
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 CNT
DO SET
+3 QUIT
+4 ;
RS ;Evaluate a 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 CNT
DO SET
+1 QUIT
+2 ;
CG ;Evaluate by 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 CNT
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 ;
CNT ;Evaluate a clinic
+1 SET SDDAY=SDBDAY-1
SET (SDVSL,SDAP,SDF1,SDOB,SDSL,SDNS,SDNSVS,SDOS)=0
SET SDLAP=$PIECE($GET(^SC(SDCL,"SL")),U)
+2 DO SPAT(SDCL,SDBDAY,SDMAX)
DO CCPAT
SET SDOB=SDAP-SDSL
IF SDOB<0
SET SDOB=0
+3 QUIT
+4 ;
CCPAT ;Count clinic patterns and patients
+1 FOR
SET SDDAY=$ORDER(^TMP(SDSUB,$JOB,SDCL,"ST",SDDAY))
IF ('SDDAY!(SDDAY>SDEDAY))
QUIT
DO CTPAT(SDDAY)
+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
SET SDCP0=$GET(^SC(SDCL,"S",SDDAY,1,SDI,0))
IF $LENGTH(SDCP0)
DO ACT
+3 QUIT
+4 ;
CTPAT(SDDAY) ;Count slots in availability pattern and master pattern
+1 ;Input: SDDAY=date to evaluate
+2 ;SD*562 added last 2 variables
NEW SDPATT,SDPCT,SDFLAG,SDHLDPAT
+3 SET SDPATT=$EXTRACT($GET(^TMP(SDSUB,$JOB,SDCL,"ST",SDDAY,1)),6,999)
IF SDPATT'["["
QUIT
+4 ;SD*562 check for partial canx
SET SDFLAG=0
IF SDPATT["X"
SET SDFLAG=1
SET SDHLDPAT=SDPATT
+5 SET SDF1=1
SET SDOS=SDOS+$$PCT(SDPATT)
+6 ;SD*562 check for partially cancelled day
SET SDPATT=$EXTRACT($GET(^SC(SDCL,"OST",SDDAY,1)),6,999)
IF $LENGTH(SDPATT)
IF SDPATT["X"
SET SDFLAG=1
SET SDHLDPAT=SDPATT
IF SDFLAG
DO ADJUST
SET SDSL=SDSL+$$PCT(SDPATT)
QUIT
+7 NEW X,%H,%T,%Y,SDDW,SDMPDT
+8 SET X=SDDAY
DO H^%DTC
SET SDDW="T"_%Y
SET SDMPDT=$ORDER(^SC(SDCL,SDDW,SDDAY))
+9 ;SD*562 added API ADJUST to calculate clinic capacity for partially cancelled day
IF SDMPDT
SET SDPATT=$GET(^SC(SDCL,SDDW,SDMPDT,1))
IF SDFLAG
DO ADJUST
SET SDPCT=$$PCT(SDPATT)
IF SDPCT
SET SDSL=SDSL+SDPCT
+10 QUIT
+11 ;
PCT(SDPATT) ;Pattern count
+1 ;Input: SDPATT=pattern to evaluate
+2 NEW X,I
SET X=0
+3 SET SDPATT=$TRANSLATE(SDPATT," |[]","")
+4 FOR I=1:1:$LENGTH(SDPATT)
SET X=X+$GET(SD($EXTRACT(SDPATT,I)))
+5 QUIT X
+6 ;
ADJUST ;SD*562 calculate clinic capacity for partially cancelled day
+1 ;SDHLDPAT equals updated pattern from "ST" node
+2 ;SDPATT equals Master Pattern for day
+3 SET SDUP=""
SET SDUP=SDHLDPAT
SET CT=0
+4 SET SDUP=$TRANSLATE(SDUP," |[]","")
+5 FOR I=1:1:$LENGTH(SDUP)
IF $EXTRACT(SDUP,I)'="X"
SET CT=CT+1
+6 SET SDPATT=$TRANSLATE(SDPATT," |[]","")
+7 SET SDPATT=$EXTRACT(SDPATT,1,CT)
+8 KILL CT,SDUP,I
+9 QUIT
+10 ;
SET ;Set stats into ^TMP global
+1 SET SDPR=0
IF SDF1
SET SDPR=$ORDER(^SC("ADPR",SDCL,SDPR))
SET SDPR=$PIECE($GET(^SC(SDCL,"PR",+SDPR,0)),U)
IF SDPR
SET SDPRN=$PIECE($GET(^VA(200,SDPR,0)),U)
IF '$LENGTH(SDPRN)
SET SDPR=0
+2 DO SET1(SDIV)
IF SDMD
DO SET1(0)
+3 QUIT
+4 ;
SET1(SDIV) SET ^TMP("SCRPW",$JOB,SDIV,1,$PIECE(SDCL0,U),SDCL)=$SELECT('SDF1:"",1:SDAP_U_SDOB_U_SDSL_U_SDNS_U_SDVSL_U_SDNSVS_U_SDOS)
+1 IF 'SDPR
QUIT
SET SDPCT=$GET(^TMP("SCRPW",$JOB,SDIV,2,SDPRN,SDPR))
+2 SET ^TMP("SCRPW",$JOB,SDIV,2,SDPRN,SDPR)=($PIECE(SDPCT,U)+SDAP)_U_($PIECE(SDPCT,U,2)+SDOB)_U_($PIECE(SDPCT,U,3)+SDSL)_U_($PIECE(SDPCT,U,4)+SDNS)_U_($PIECE(SDPCT,U,5)+SDVSL)_U_($PIECE(SDPCT,U,6)+SDNSVS)_U_($PIECE(SDPCT,U,7)+SDOS)
+3 QUIT
+4 ;
CLINE ;Print a clinic statistics line
+1 IF $Y>(IOSL-12)
DO FOOT^SCRPW2
DO HDR^SCRPW2
IF SDOUT
QUIT
SET SDCT=^TMP("SCRPW",$JOB,SDIV,1,SDCLN,SDCL)
WRITE !!,SDCLN
IF '$LENGTH(SDCT)
WRITE " (No ava. found)"
QUIT
+2 DO F1
SET SDTAP=SDTAP+SDAP
SET SDTOB=SDTOB+SDOB
SET SDTSL=SDTSL+SDSL
SET SDTNS=SDTNS+SDNS
SET SDTVSL=SDTVSL+SDVSL
SET SDTNSVS=SDTNSVS+SDNSVS
SET SDTOS=SDTOS+SDOS
+3 QUIT
+4 ;
F1 SET SDAP=$PIECE(SDCT,U)
SET SDOB=$PIECE(SDCT,U,2)
SET SDSL=$PIECE(SDCT,U,3)
SET SDNS=$PIECE(SDCT,U,4)
SET SDVSL=$PIECE(SDCT,U,5)
SET SDNSVS=$PIECE(SDCT,U,6)
SET SDOS=$PIECE(SDCT,U,7)
+1 WRITE ?32,$JUSTIFY(SDAP,8),?42,$JUSTIFY(SDVSL,8),?52,$JUSTIFY(SDNS,8),?62,$JUSTIFY(SDNSVS,8),?72,$JUSTIFY(SDOB,8),?82,$JUSTIFY(SDOS,8),?92,$JUSTIFY((SDSL-SDAP-SDVSL),8)
+2 SET SDCAP=SDSL
WRITE ?102,$JUSTIFY(SDCAP,8),?112,$JUSTIFY($SELECT(SDCAP=0:0,1:(SDAP+SDVSL*100)/SDCAP),8,2),"%"
+3 WRITE ?123,$JUSTIFY($SELECT(SDCAP=0:0,1:((SDAP+SDVSL-SDNS-SDNSVS)*100)/SDCAP),8,2),"%"
+4 QUIT
+5 ;
PLINE ;Print a provider statistics line
+1 IF $Y>(IOSL-12)
DO FOOT^SCRPW2
DO HDR^SCRPW2
IF SDOUT
QUIT
SET SDCT=^TMP("SCRPW",$JOB,SDIV,2,SDPRN,SDPR)
WRITE !!,SDPRN," (",SDPR,")"
DO F1
+2 QUIT
+3 ;
ACT ;Count appointments, addl. variable appt. slots and no-shows
+1 ;Quit if cancelled
IF $PIECE(SDCP0,U,9)="C"
QUIT
+2 SET SDPLAP=$PIECE(SDCP0,U,2)
SET SDPESL=0
IF SDLAP
IF SDPLAP>SDLAP
SET SDPESL=SDPLAP\SDLAP-1
SET SDVSL=SDVSL+SDPESL
+3 ;SD*5.3*540
IF 'SDCP0
QUIT
+4 SET SDAP=SDAP+1
SET SDF1=1
+5 SET SDPAS=^DPT($PIECE(SDCP0,U),"S",SDDAY,0)
SET SDPAS=$PIECE(SDPAS,U,2)
IF SDPAS=""
QUIT
IF "NA"[SDPAS
SET SDNS=SDNS+1
SET SDNSVS=SDNSVS+SDPESL
+6 QUIT
+7 ;
SPAT(SC,SDSTRTDT,MAX,SDS) ;Set patterns into ^TMP (modified clone of OVR^SDAUT1)
+1 ;Input: SC=clinic ifn
+2 ;Input: SDSTRTDT=start date for gathering patterns
+3 ;Input: MAX=number of days beyond start date to gather patterns
+4 ;Input: SDS=array namespace subscript value (optional)
+5 ;Output: array of clinic current availability patterns in
+6 ; ^TMP(SDS,$J,clinic_ifn,"ST",date,1)
+7 ;
+8 SET SDS=$GET(SDS)
IF '$LENGTH(SDS)
SET SDS="SDTMP"
KILL ^TMP(SDS,$JOB)
+9 NEW SI,SDIN,SDRE,SDSOH,ENDATE,X,X1,X2,SM,I,D,J,Y,SS,DAY
+10 SET SDIN=$GET(^SC(SC,"I"))
SET SDRE=$PIECE(SDIN,U,2)
SET SDIN=$PIECE(SDIN,U)
+11 SET DAY="SU^MO^TU^WE^TH^FR^SA"
+12 SET SI=$PIECE($GET(^SC(SC,"SL")),U,6)
SET SI=$SELECT(SI<3:4,1:SI)
+13 SET SDSOH=$SELECT('$DATA(^SC(SC,"SL")):0,$PIECE(^SC(SC,"SL"),"^",8)']"":0,1:1)
+14 SET X1=SDSTRTDT
SET X2=MAX
SET SDIN=$GET(SDIN)
DO C^%DTC
SET ENDATE=X
SET X=SDSTRTDT
EN1 IF $ORDER(^SC(SC,"T",0))>X
SET X=$ORDER(^SC(SC,"T",0))
+1 SET Y=$$DOW^XLFDT(X,1)
SET I=Y+32
SET SM=X
SET D=Y
DO WM
+2 KILL J
FOR Y=0:1:6
IF $DATA(^SC(+SC,"T"_Y))
SET J(Y)=""
+3 IF '$DATA(J)
Begin DoDot:1
+4 SET D=SDSTRTDT-1
FOR
SET D=$ORDER(^SC(SC,"ST",D))
IF 'D!(D>ENDATE)
QUIT
Begin DoDot:2
+5 SET X=$GET(^SC(SC,"ST",D,1))
IF $LENGTH(X)
SET ^TMP(SDS,$JOB,SC,"ST",D,1)=X
QUIT
End DoDot:2
+6 QUIT
End DoDot:1
QUIT
X1 IF X>ENDATE
QUIT
SET X1=X\100_28
+1 IF '$$ACTIVE(X,SDIN,SDRE)
SET X1=X
SET X2=1
DO C^%DTC
GOTO X1
W SET X=X\1
+1 IF $DATA(^SC(+SC,"ST",X,1))
SET ^TMP(SDS,$JOB,SC,"ST",X,1)=^SC(+SC,"ST",X,1)
GOTO W1
+2 IF '$DATA(^SC(SC,"ST",X,1))
SET Y=D#7
IF '$DATA(J(Y))
GOTO L
IF $DATA(^HOLIDAY(X))&('SDSOH)
GOTO H
SET SS=$ORDER(^SC(SC,"T"_Y,X))
IF SS<1
GOTO L
IF ^SC(SC,"T"_Y,SS,1)=""
GOTO L
Begin DoDot:1
+3 SET ^TMP(SDS,$JOB,SC,"ST",X\1,1)=$PIECE(DAY,U,Y+1)_" "_$EXTRACT(X,6,7)_$JUSTIFY("",SI+SI-6)_^SC(SC,"T"_Y,SS,1)
QUIT
End DoDot:1
W1 IF X>SM
DO WM
L IF X>ENDATE
QUIT
SET X=X+1
SET D=D+1
IF X'>X1
GOTO W
SET X2=X-X1
DO C^%DTC
GOTO X1
+1 ;
H SET ^TMP(SDS,$JOB,SC,"ST",X,1)=" "_$EXTRACT(X,6,7)_" "_$PIECE(^(X,0),U,2)
GOTO W1
+1 ;
WM SET SM=$SELECT($EXTRACT(X,4,5)[12:$EXTRACT(X,1,3)+1_"01",1:$EXTRACT(X,1,3)_$EXTRACT(X,4,5)+1)_"00"
QUIT
+1 ;
ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
+1 ;Input: X=date to be examined
+2 ;Input: SDIN=clinic inactive date
+3 ;Input: SDRE=clinic reactivate date
+4 ;Output: '1'=active, '0'=inactive
+5 IF 'SDIN
QUIT 1
IF X<SDIN
QUIT 1
IF 'SDRE
QUIT 0
IF X<SDRE
QUIT 0
QUIT 1
