184 lines
6.8 KiB
Mathematica
184 lines
6.8 KiB
Mathematica
SCRPO7 ;BP-CIOFO/KEITH - Historical Team Assignment Summary (cont.) ; 06 Jul 99 7:41 AM
|
|
;;5.3;Scheduling;**177**;AUG 13, 1993
|
|
;
|
|
CKTEAM(SCTM) ;Build from team
|
|
;Input: SCTM=team ifn
|
|
N SCTM0,SCDIV,SCTPC,SCTMAX,SCTEAM,SCDT,SCRATCH,ERR,SCI
|
|
N SCACT,SCII,SCIII,SCINAC,SCPC,SCPNAM,SCTP
|
|
N DFN,SCTMASS,SCTMUNI,SCX,SCPTA,SCY
|
|
F SCI=1:1:12 S SCY(SCI)=""
|
|
S SCTM0=$G(^SCTM(404.51,SCTM,0)) Q:'$L(SCTM0)
|
|
S SCTEAM=$P(SCTM0,U)_U_SCTM ;team name
|
|
S SCDIV=$P(SCTM0,U,7) Q:'SCDIV ;division
|
|
I $O(^TMP("SC",$J,"DIV",0)),'$D(^TMP("SC",$J,"DIV",SCDIV)) Q
|
|
S SCDIV=$P($G(^DIC(4,SCDIV,0)),U)_U_SCDIV
|
|
S SCY(1)=$S($P(SCTM0,U,5)=1:"YES",1:"NO") ;pc team?
|
|
S SCY(2)=$P(SCTM0,U,8) ;max. patients
|
|
M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
|
|
S SCRATCH="^TMP(""SCRATCH"",$J,1)" K @SCRATCH,^TMP("SCRPT",$J,2)
|
|
S SCI=$$PTTM^SCAPMC(SCTM,.SCDT,SCRATCH,"ERR")
|
|
S SCI=0 F S SCI=$O(^TMP("SCRATCH",$J,1,SCI)) Q:'SCI D
|
|
.S SCX=^TMP("SCRATCH",$J,1,SCI)
|
|
.S DFN=$P(SCX,U) Q:'DFN
|
|
.S DATA=$P(SCX,U,2)_U_$P(SCX,U,6)_U_$P(SCX,U,4,5)
|
|
.S SCPTA=$P(SCX,U,3) Q:'SCPTA
|
|
.F SCII=0,1,2 S ^TMP("SCRPT",$J,SCII,$$RPT(SCII),"TPTS",DFN,SCPTA)=DATA
|
|
;Count team assignments and uniques
|
|
S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN)) Q:'DFN D
|
|
.S SCY(7)=SCY(7)+1,SCPTA=0
|
|
.F S SCPTA=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN,SCPTA)) Q:'SCPTA D
|
|
..S SCY(3)=SCY(3)+1
|
|
..Q
|
|
.Q
|
|
;Get team positions
|
|
K @SCRATCH
|
|
S SCI=$$TPTM^SCAPMC(SCTM,.SCDT,,,SCRATCH,"ERR")
|
|
S SCI=0 F S SCI=$O(^TMP("SCRATCH",$J,1,SCI)) Q:'SCI D
|
|
.N SCDT2 M SCDT2=SCDT S SCDT2="SCDT2"
|
|
.S SCX=^TMP("SCRATCH",$J,1,SCI)
|
|
.S SCTP=$P(SCX,U) Q:'SCTP
|
|
.S SCPOSN=$P(SCX,U,2)
|
|
.S SCACT=$P(SCX,U,5),SCINAC=$P(SCX,U,6)
|
|
.S:SCACT>SCDT2("BEGIN") SCDT2("BEGIN")=SCACT
|
|
.I SCINAC,SCINAC<SCDT2("END") S SCDT2("END")=SCINAC
|
|
.S SCRATCH="^TMP(""SCRATCH"",$J,2)" K @SCRATCH
|
|
.;Get list of position patients
|
|
.S SCII=$$PTTP^SCAPMC(SCTP,.SCDT2,SCRATCH,"ERR")
|
|
.S SCII=0 F S SCII=$O(^TMP("SCRATCH",$J,2,SCII)) Q:'SCII D
|
|
..S SCX=^TMP("SCRATCH",$J,2,SCII)
|
|
..S DFN=$P(SCX,U) Q:'DFN
|
|
..S DATA=$P(SCX,U,2)_U_$P(SCX,U,6)_U_$P(SCX,U,4,5)_U_SCPOSN
|
|
..S SCPTPA=$P(SCX,U,3) Q:'SCPTPA
|
|
..S SCPTPA0=$G(^SCPT(404.43,SCPTPA,0)) Q:'$L(SCPTPA0)
|
|
..S SCPC=$P(SCPTPA0,U,5)>0 ;pc position?
|
|
..F SCIII=0,1,2 S ^TMP("SCRPT",$J,SCIII,$$RPT(SCIII),"PPTS",SCPC,DFN,SCPTPA)=DATA
|
|
..Q
|
|
.Q
|
|
;Count team position assignment assignments and uniques
|
|
F SCI=0,1 S DFN=0 D
|
|
.F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",SCI,DFN)) Q:'DFN D
|
|
..S SCY(8+SCI)=SCY(8+SCI)+1,SCPTPA=0
|
|
..F S SCPTPA=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",SCI,DFN,SCPTPA)) Q:'SCPTPA D
|
|
...S SCY(4+SCI)=SCY(4+SCI)+1
|
|
...Q
|
|
..Q
|
|
.Q
|
|
;check for broken team assignments
|
|
M ^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1)=^TMP("SCRPT",$J,2,SCTEAM,"PPTS",0)
|
|
S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN)) Q:'DFN D
|
|
.Q:$D(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN))
|
|
.S SCPTA=0,SCY(11)=SCY(11)+1
|
|
.F S SCPTA=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN,SCPTA)) Q:'SCPTA D
|
|
..S DATA=^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN,SCPTA)
|
|
..S SCPNAM=$P(DATA,U) Q:'$L(SCPNAM)
|
|
..S ^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM,SCPTA)=DATA
|
|
..S ^TMP("SCRPT",$J,0,0,"BTA",SCDIV,DFN)=""
|
|
..S ^TMP("SCRPT",$J,0,0,"BTA",0,DFN)=""
|
|
..Q
|
|
.Q
|
|
;check for broken team position assignments
|
|
S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN)) Q:'DFN D
|
|
.Q:$D(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN))
|
|
.S SCPTPA=0,SCY(12)=SCY(12)+1
|
|
.F S SCPTPA=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN,SCPTPA)) Q:'SCPTPA D
|
|
..S DATA=^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN,SCPTPA)
|
|
..S SCPNAM=$P(DATA,U) Q:'$L(SCPNAM)
|
|
..S ^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM,SCPTPA)=DATA
|
|
..S ^TMP("SCRPT",$J,0,0,"BTPA",SCDIV,DFN)=""
|
|
..S ^TMP("SCRPT",$J,0,0,"BTPA",0,DFN)=""
|
|
..Q
|
|
.Q
|
|
;count total uniques and open slots
|
|
M ^TMP("SCRPT",$J,2,SCTEAM,"TPTS")=^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1)
|
|
K ^TMP("SCRPT",$J,2,SCTEAM,"PPTS")
|
|
S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN)) Q:'DFN D
|
|
.S SCY(10)=SCY(10)+1
|
|
.Q
|
|
S SCY(6)=SCY(2)-SCY(10) S:SCY(6)<0 SCY(6)=0
|
|
K ^TMP("SCRPT",$J,2)
|
|
;Move team data to report and division totals
|
|
I SCY(1)="YES" D
|
|
.S $P(^TMP("SCRPT",$J,0,0),U)="YES"
|
|
.S $P(^TMP("SCRPT",$J,1,SCDIV),U)="YES"
|
|
.S $P(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM),U)="YES"
|
|
.Q
|
|
F SCI=2:1:6 D
|
|
.S $P(^TMP("SCRPT",$J,0,0),U,SCI)=$P($G(^TMP("SCRPT",$J,0,0)),U,SCI)+SCY(SCI)
|
|
.S $P(^TMP("SCRPT",$J,1,SCDIV),U,SCI)=$P($G(^TMP("SCRPT",$J,1,SCDIV)),U,SCI)+SCY(SCI)
|
|
.S $P(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM),U,SCI)=$P($G(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM)),U,SCI)+SCY(SCI)
|
|
.Q
|
|
F SCI=7:1:12 D
|
|
.S $P(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM),U,SCI)=SCY(SCI)
|
|
.Q
|
|
Q
|
|
;
|
|
RPT(X) ;Return report section value
|
|
Q $S(X=1:SCDIV,X=2:SCTEAM,1:0)
|
|
;
|
|
COUNT ;Count division and report uniques
|
|
S SCDIV="" F S SCDIV=$O(^TMP("SCRPT",$J,1,SCDIV)) Q:SCDIV="" D
|
|
.K SCY F SCI=7:1:12 S SCY(SCI)=""
|
|
.S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,1,SCDIV,"TPTS",DFN)) Q:'DFN D
|
|
..S SCY(7)=SCY(7)+1
|
|
..Q
|
|
.F SCI=0,1 S DFN=0 D
|
|
..F S DFN=$O(^TMP("SCRPT",$J,1,SCDIV,"PPTS",SCI,DFN)) Q:'DFN D
|
|
...S SCY(8+SCI)=SCY(8+SCI)+1
|
|
...Q
|
|
..Q
|
|
.M ^TMP("SCRPT",$J,1,SCDIV,"PPTS",1)=^TMP("SCRPT",$J,1,SCDIV,"PPTS",0)
|
|
.M ^TMP("SCRPT",$J,1,SCDIV,"TPTS")=^TMP("SCRPT",$J,1,SCDIV,"PPTS",1)
|
|
.K ^TMP("SCRPT",$J,1,SCDIV,"PPTS")
|
|
.S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,1,SCDIV,"TPTS",DFN)) Q:'DFN D
|
|
..S SCY(10)=SCY(10)+1
|
|
..Q
|
|
.K ^TMP("SCRPT",$J,1,SCDIV,"TPTS")
|
|
.F SCI="BTA","BTPA" S DFN=0 D
|
|
..F S DFN=$O(^TMP("SCRPT",$J,0,0,SCI,SCDIV,DFN)) Q:'DFN D
|
|
...S SCY($S(SCI="BTA":11,1:12))=SCY($S(SCI="BTA":11,1:12))+1
|
|
...Q
|
|
..K ^TMP("SCRPT",$J,0,0,SCI,SCDIV)
|
|
..Q
|
|
.F SCI=7:1:12 D
|
|
..S $P(^TMP("SCRPT",$J,1,SCDIV),U,SCI)=SCY(SCI)
|
|
..Q
|
|
.Q
|
|
;count report uniques
|
|
K SCY F SCI=7:1:12 S SCY(SCI)=""
|
|
S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,0,0,"TPTS",DFN)) Q:'DFN D
|
|
.S SCY(7)=SCY(7)+1
|
|
.Q
|
|
F SCI=0,1 S DFN=0 D
|
|
.F S DFN=$O(^TMP("SCRPT",$J,0,0,"PPTS",SCI,DFN)) Q:'DFN D
|
|
..S SCY(8+SCI)=SCY(8+SCI)+1
|
|
..Q
|
|
.Q
|
|
M ^TMP("SCRPT",$J,0,0,"PPTS",1)=^TMP("SCRPT",$J,0,0,"PPTS",0)
|
|
M ^TMP("SCRPT",$J,0,0,"TPTS")=^TMP("SCRPT",$J,0,0,"PPTS",1)
|
|
K ^TMP("SCRPT",$J,0,0,"PPTS")
|
|
S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,0,0,"TPTS",DFN)) Q:'DFN D
|
|
.S SCY(10)=SCY(10)+1
|
|
.Q
|
|
K ^TMP("SCRPT",$J,0,0,"TPTS")
|
|
F SCI="BTA","BTPA" S DFN=0 D
|
|
.F S DFN=$O(^TMP("SCRPT",$J,0,0,SCI,0,DFN)) Q:'DFN D
|
|
..S SCY($S(SCI="BTA":11,1:12))=SCY($S(SCI="BTA":11,1:12))+1
|
|
..Q
|
|
.K ^TMP("SCRPT",$J,0,0,SCI,0)
|
|
.Q
|
|
F SCI=7:1:12 D
|
|
.S $P(^TMP("SCRPT",$J,0,0),U,SCI)=SCY(SCI)
|
|
.Q
|
|
Q
|
|
;
|
|
FOOT ;Summary report footer
|
|
N SCI
|
|
F SCI=1:1:80 W ! Q:$Y>(IOSL-9)
|
|
W !,SCLINE
|
|
W !,"NOTE: This report represents a count of team and team position assignments within the date range selected. If a date range"
|
|
W !?6,"larger than one day has been selected, the total unique patients and assignments may be greater than the maximum defined"
|
|
W !?6,"for the team, reducing the open slots reflected by this report accordingly. However, this does not imply that the team"
|
|
W !?6,"had more than its maximum number of patients on any single date."
|
|
W !,SCLINE
|
|
Q
|