Routine: SCRPO7

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPO7   7149     printed  Mar 13, 2025@21:47:41                                                                                                                                                                                                      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      ;

FOOT      ;Summary report footer

 +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

SCRPO7.m