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
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPO7 7149 printed Nov 22, 2024@17:52:43 Page 2
SCRPO7 ;BP-CIOFO/KEITH - Historical Team Assignment Summary (cont.) ; 06 Jul 99 7:41 AM
+1 ;;5.3;Scheduling;**177**;AUG 13, 1993
+2 ;
CKTEAM(SCTM) ;Build from team
+1 ;Input: SCTM=team ifn
+2 NEW SCTM0,SCDIV,SCTPC,SCTMAX,SCTEAM,SCDT,SCRATCH,ERR,SCI
+3 NEW SCACT,SCII,SCIII,SCINAC,SCPC,SCPNAM,SCTP
+4 NEW DFN,SCTMASS,SCTMUNI,SCX,SCPTA,SCY
+5 FOR SCI=1:1:12
SET SCY(SCI)=""
+6 SET SCTM0=$GET(^SCTM(404.51,SCTM,0))
if '$LENGTH(SCTM0)
QUIT
+7 ;team name
SET SCTEAM=$PIECE(SCTM0,U)_U_SCTM
+8 ;division
SET SCDIV=$PIECE(SCTM0,U,7)
if 'SCDIV
QUIT
+9 IF $ORDER(^TMP("SC",$JOB,"DIV",0))
IF '$DATA(^TMP("SC",$JOB,"DIV",SCDIV))
QUIT
+10 SET SCDIV=$PIECE($GET(^DIC(4,SCDIV,0)),U)_U_SCDIV
+11 ;pc team?
SET SCY(1)=$SELECT($PIECE(SCTM0,U,5)=1:"YES",1:"NO")
+12 ;max. patients
SET SCY(2)=$PIECE(SCTM0,U,8)
+13 MERGE SCDT=^TMP("SC",$JOB,"DTR")
SET SCDT="SCDT"
+14 SET SCRATCH="^TMP(""SCRATCH"",$J,1)"
KILL @SCRATCH,^TMP("SCRPT",$JOB,2)
+15 SET SCI=$$PTTM^SCAPMC(SCTM,.SCDT,SCRATCH,"ERR")
+16 SET SCI=0
FOR
SET SCI=$ORDER(^TMP("SCRATCH",$JOB,1,SCI))
if 'SCI
QUIT
Begin DoDot:1
+17 SET SCX=^TMP("SCRATCH",$JOB,1,SCI)
+18 SET DFN=$PIECE(SCX,U)
if 'DFN
QUIT
+19 SET DATA=$PIECE(SCX,U,2)_U_$PIECE(SCX,U,6)_U_$PIECE(SCX,U,4,5)
+20 SET SCPTA=$PIECE(SCX,U,3)
if 'SCPTA
QUIT
+21 FOR SCII=0,1,2
SET ^TMP("SCRPT",$JOB,SCII,$$RPT(SCII),"TPTS",DFN,SCPTA)=DATA
End DoDot:1
+22 ;Count team assignments and uniques
+23 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS",DFN))
if 'DFN
QUIT
Begin DoDot:1
+24 SET SCY(7)=SCY(7)+1
SET SCPTA=0
+25 FOR
SET SCPTA=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS",DFN,SCPTA))
if 'SCPTA
QUIT
Begin DoDot:2
+26 SET SCY(3)=SCY(3)+1
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 ;Get team positions
+30 KILL @SCRATCH
+31 SET SCI=$$TPTM^SCAPMC(SCTM,.SCDT,,,SCRATCH,"ERR")
+32 SET SCI=0
FOR
SET SCI=$ORDER(^TMP("SCRATCH",$JOB,1,SCI))
if 'SCI
QUIT
Begin DoDot:1
+33 NEW SCDT2
MERGE SCDT2=SCDT
SET SCDT2="SCDT2"
+34 SET SCX=^TMP("SCRATCH",$JOB,1,SCI)
+35 SET SCTP=$PIECE(SCX,U)
if 'SCTP
QUIT
+36 SET SCPOSN=$PIECE(SCX,U,2)
+37 SET SCACT=$PIECE(SCX,U,5)
SET SCINAC=$PIECE(SCX,U,6)
+38 if SCACT>SCDT2("BEGIN")
SET SCDT2("BEGIN")=SCACT
+39 IF SCINAC
IF SCINAC<SCDT2("END")
SET SCDT2("END")=SCINAC
+40 SET SCRATCH="^TMP(""SCRATCH"",$J,2)"
KILL @SCRATCH
+41 ;Get list of position patients
+42 SET SCII=$$PTTP^SCAPMC(SCTP,.SCDT2,SCRATCH,"ERR")
+43 SET SCII=0
FOR
SET SCII=$ORDER(^TMP("SCRATCH",$JOB,2,SCII))
if 'SCII
QUIT
Begin DoDot:2
+44 SET SCX=^TMP("SCRATCH",$JOB,2,SCII)
+45 SET DFN=$PIECE(SCX,U)
if 'DFN
QUIT
+46 SET DATA=$PIECE(SCX,U,2)_U_$PIECE(SCX,U,6)_U_$PIECE(SCX,U,4,5)_U_SCPOSN
+47 SET SCPTPA=$PIECE(SCX,U,3)
if 'SCPTPA
QUIT
+48 SET SCPTPA0=$GET(^SCPT(404.43,SCPTPA,0))
if '$LENGTH(SCPTPA0)
QUIT
+49 ;pc position?
SET SCPC=$PIECE(SCPTPA0,U,5)>0
+50 FOR SCIII=0,1,2
SET ^TMP("SCRPT",$JOB,SCIII,$$RPT(SCIII),"PPTS",SCPC,DFN,SCPTPA)=DATA
+51 QUIT
End DoDot:2
+52 QUIT
End DoDot:1
+53 ;Count team position assignment assignments and uniques
+54 FOR SCI=0,1
SET DFN=0
Begin DoDot:1
+55 FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",SCI,DFN))
if 'DFN
QUIT
Begin DoDot:2
+56 SET SCY(8+SCI)=SCY(8+SCI)+1
SET SCPTPA=0
+57 FOR
SET SCPTPA=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",SCI,DFN,SCPTPA))
if 'SCPTPA
QUIT
Begin DoDot:3
+58 SET SCY(4+SCI)=SCY(4+SCI)+1
+59 QUIT
End DoDot:3
+60 QUIT
End DoDot:2
+61 QUIT
End DoDot:1
+62 ;check for broken team assignments
+63 MERGE ^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",1)=^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",0)
+64 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS",DFN))
if 'DFN
QUIT
Begin DoDot:1
+65 if $DATA(^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",1,DFN))
QUIT
+66 SET SCPTA=0
SET SCY(11)=SCY(11)+1
+67 FOR
SET SCPTA=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS",DFN,SCPTA))
if 'SCPTA
QUIT
Begin DoDot:2
+68 SET DATA=^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS",DFN,SCPTA)
+69 SET SCPNAM=$PIECE(DATA,U)
if '$LENGTH(SCPNAM)
QUIT
+70 SET ^TMP("SCRPT",$JOB,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM,SCPTA)=DATA
+71 SET ^TMP("SCRPT",$JOB,0,0,"BTA",SCDIV,DFN)=""
+72 SET ^TMP("SCRPT",$JOB,0,0,"BTA",0,DFN)=""
+73 QUIT
End DoDot:2
+74 QUIT
End DoDot:1
+75 ;check for broken team position assignments
+76 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",1,DFN))
if 'DFN
QUIT
Begin DoDot:1
+77 if $DATA(^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS",DFN))
QUIT
+78 SET SCPTPA=0
SET SCY(12)=SCY(12)+1
+79 FOR
SET SCPTPA=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",1,DFN,SCPTPA))
if 'SCPTPA
QUIT
Begin DoDot:2
+80 SET DATA=^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",1,DFN,SCPTPA)
+81 SET SCPNAM=$PIECE(DATA,U)
if '$LENGTH(SCPNAM)
QUIT
+82 SET ^TMP("SCRPT",$JOB,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM,SCPTPA)=DATA
+83 SET ^TMP("SCRPT",$JOB,0,0,"BTPA",SCDIV,DFN)=""
+84 SET ^TMP("SCRPT",$JOB,0,0,"BTPA",0,DFN)=""
+85 QUIT
End DoDot:2
+86 QUIT
End DoDot:1
+87 ;count total uniques and open slots
+88 MERGE ^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS")=^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS",1)
+89 KILL ^TMP("SCRPT",$JOB,2,SCTEAM,"PPTS")
+90 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,2,SCTEAM,"TPTS",DFN))
if 'DFN
QUIT
Begin DoDot:1
+91 SET SCY(10)=SCY(10)+1
+92 QUIT
End DoDot:1
+93 SET SCY(6)=SCY(2)-SCY(10)
if SCY(6)<0
SET SCY(6)=0
+94 KILL ^TMP("SCRPT",$JOB,2)
+95 ;Move team data to report and division totals
+96 IF SCY(1)="YES"
Begin DoDot:1
+97 SET $PIECE(^TMP("SCRPT",$JOB,0,0),U)="YES"
+98 SET $PIECE(^TMP("SCRPT",$JOB,1,SCDIV),U)="YES"
+99 SET $PIECE(^TMP("SCRPT",$JOB,1,SCDIV,"TEAM",SCTEAM),U)="YES"
+100 QUIT
End DoDot:1
+101 FOR SCI=2:1:6
Begin DoDot:1
+102 SET $PIECE(^TMP("SCRPT",$JOB,0,0),U,SCI)=$PIECE($GET(^TMP("SCRPT",$JOB,0,0)),U,SCI)+SCY(SCI)
+103 SET $PIECE(^TMP("SCRPT",$JOB,1,SCDIV),U,SCI)=$PIECE($GET(^TMP("SCRPT",$JOB,1,SCDIV)),U,SCI)+SCY(SCI)
+104 SET $PIECE(^TMP("SCRPT",$JOB,1,SCDIV,"TEAM",SCTEAM),U,SCI)=$PIECE($GET(^TMP("SCRPT",$JOB,1,SCDIV,"TEAM",SCTEAM)),U,SCI)+SCY(SCI)
+105 QUIT
End DoDot:1
+106 FOR SCI=7:1:12
Begin DoDot:1
+107 SET $PIECE(^TMP("SCRPT",$JOB,1,SCDIV,"TEAM",SCTEAM),U,SCI)=SCY(SCI)
+108 QUIT
End DoDot:1
+109 QUIT
+110 ;
RPT(X) ;Return report section value
+1 QUIT $SELECT(X=1:SCDIV,X=2:SCTEAM,1:0)
+2 ;
COUNT ;Count division and report uniques
+1 SET SCDIV=""
FOR
SET SCDIV=$ORDER(^TMP("SCRPT",$JOB,1,SCDIV))
if SCDIV=""
QUIT
Begin DoDot:1
+2 KILL SCY
FOR SCI=7:1:12
SET SCY(SCI)=""
+3 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,1,SCDIV,"TPTS",DFN))
if 'DFN
QUIT
Begin DoDot:2
+4 SET SCY(7)=SCY(7)+1
+5 QUIT
End DoDot:2
+6 FOR SCI=0,1
SET DFN=0
Begin DoDot:2
+7 FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,1,SCDIV,"PPTS",SCI,DFN))
if 'DFN
QUIT
Begin DoDot:3
+8 SET SCY(8+SCI)=SCY(8+SCI)+1
+9 QUIT
End DoDot:3
+10 QUIT
End DoDot:2
+11 MERGE ^TMP("SCRPT",$JOB,1,SCDIV,"PPTS",1)=^TMP("SCRPT",$JOB,1,SCDIV,"PPTS",0)
+12 MERGE ^TMP("SCRPT",$JOB,1,SCDIV,"TPTS")=^TMP("SCRPT",$JOB,1,SCDIV,"PPTS",1)
+13 KILL ^TMP("SCRPT",$JOB,1,SCDIV,"PPTS")
+14 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,1,SCDIV,"TPTS",DFN))
if 'DFN
QUIT
Begin DoDot:2
+15 SET SCY(10)=SCY(10)+1
+16 QUIT
End DoDot:2
+17 KILL ^TMP("SCRPT",$JOB,1,SCDIV,"TPTS")
+18 FOR SCI="BTA","BTPA"
SET DFN=0
Begin DoDot:2
+19 FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,0,0,SCI,SCDIV,DFN))
if 'DFN
QUIT
Begin DoDot:3
+20 SET SCY($SELECT(SCI="BTA":11,1:12))=SCY($SELECT(SCI="BTA":11,1:12))+1
+21 QUIT
End DoDot:3
+22 KILL ^TMP("SCRPT",$JOB,0,0,SCI,SCDIV)
+23 QUIT
End DoDot:2
+24 FOR SCI=7:1:12
Begin DoDot:2
+25 SET $PIECE(^TMP("SCRPT",$JOB,1,SCDIV),U,SCI)=SCY(SCI)
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 ;count report uniques
+29 KILL SCY
FOR SCI=7:1:12
SET SCY(SCI)=""
+30 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,0,0,"TPTS",DFN))
if 'DFN
QUIT
Begin DoDot:1
+31 SET SCY(7)=SCY(7)+1
+32 QUIT
End DoDot:1
+33 FOR SCI=0,1
SET DFN=0
Begin DoDot:1
+34 FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,0,0,"PPTS",SCI,DFN))
if 'DFN
QUIT
Begin DoDot:2
+35 SET SCY(8+SCI)=SCY(8+SCI)+1
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 MERGE ^TMP("SCRPT",$JOB,0,0,"PPTS",1)=^TMP("SCRPT",$JOB,0,0,"PPTS",0)
+39 MERGE ^TMP("SCRPT",$JOB,0,0,"TPTS")=^TMP("SCRPT",$JOB,0,0,"PPTS",1)
+40 KILL ^TMP("SCRPT",$JOB,0,0,"PPTS")
+41 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,0,0,"TPTS",DFN))
if 'DFN
QUIT
Begin DoDot:1
+42 SET SCY(10)=SCY(10)+1
+43 QUIT
End DoDot:1
+44 KILL ^TMP("SCRPT",$JOB,0,0,"TPTS")
+45 FOR SCI="BTA","BTPA"
SET DFN=0
Begin DoDot:1
+46 FOR
SET DFN=$ORDER(^TMP("SCRPT",$JOB,0,0,SCI,0,DFN))
if 'DFN
QUIT
Begin DoDot:2
+47 SET SCY($SELECT(SCI="BTA":11,1:12))=SCY($SELECT(SCI="BTA":11,1:12))+1
+48 QUIT
End DoDot:2
+49 KILL ^TMP("SCRPT",$JOB,0,0,SCI,0)
+50 QUIT
End DoDot:1
+51 FOR SCI=7:1:12
Begin DoDot:1
+52 SET $PIECE(^TMP("SCRPT",$JOB,0,0),U,SCI)=SCY(SCI)
+53 QUIT
End DoDot:1
+54 QUIT
+55 ;
+1 NEW SCI
+2 FOR SCI=1:1:80
WRITE !
if $Y>(IOSL-9)
QUIT
+3 WRITE !,SCLINE
+4 WRITE !,"NOTE: This report represents a count of team and team position assignments within the date range selected. If a date range"
+5 WRITE !?6,"larger than one day has been selected, the total unique patients and assignments may be greater than the maximum defined"
+6 WRITE !?6,"for the team, reducing the open slots reflected by this report accordingly. However, this does not imply that the team"
+7 WRITE !?6,"had more than its maximum number of patients on any single date."
+8 WRITE !,SCLINE
+9 QUIT
