source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPO7.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1SCRPO7 ;BP-CIOFO/KEITH - Historical Team Assignment Summary (cont.) ; 06 Jul 99 7:41 AM
2 ;;5.3;Scheduling;**177**;AUG 13, 1993
3 ;
4CKTEAM(SCTM) ;Build from team
5 ;Input: SCTM=team ifn
6 N SCTM0,SCDIV,SCTPC,SCTMAX,SCTEAM,SCDT,SCRATCH,ERR,SCI
7 N SCACT,SCII,SCIII,SCINAC,SCPC,SCPNAM,SCTP
8 N DFN,SCTMASS,SCTMUNI,SCX,SCPTA,SCY
9 F SCI=1:1:12 S SCY(SCI)=""
10 S SCTM0=$G(^SCTM(404.51,SCTM,0)) Q:'$L(SCTM0)
11 S SCTEAM=$P(SCTM0,U)_U_SCTM ;team name
12 S SCDIV=$P(SCTM0,U,7) Q:'SCDIV ;division
13 I $O(^TMP("SC",$J,"DIV",0)),'$D(^TMP("SC",$J,"DIV",SCDIV)) Q
14 S SCDIV=$P($G(^DIC(4,SCDIV,0)),U)_U_SCDIV
15 S SCY(1)=$S($P(SCTM0,U,5)=1:"YES",1:"NO") ;pc team?
16 S SCY(2)=$P(SCTM0,U,8) ;max. patients
17 M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
18 S SCRATCH="^TMP(""SCRATCH"",$J,1)" K @SCRATCH,^TMP("SCRPT",$J,2)
19 S SCI=$$PTTM^SCAPMC(SCTM,.SCDT,SCRATCH,"ERR")
20 S SCI=0 F S SCI=$O(^TMP("SCRATCH",$J,1,SCI)) Q:'SCI D
21 .S SCX=^TMP("SCRATCH",$J,1,SCI)
22 .S DFN=$P(SCX,U) Q:'DFN
23 .S DATA=$P(SCX,U,2)_U_$P(SCX,U,6)_U_$P(SCX,U,4,5)
24 .S SCPTA=$P(SCX,U,3) Q:'SCPTA
25 .F SCII=0,1,2 S ^TMP("SCRPT",$J,SCII,$$RPT(SCII),"TPTS",DFN,SCPTA)=DATA
26 ;Count team assignments and uniques
27 S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN)) Q:'DFN D
28 .S SCY(7)=SCY(7)+1,SCPTA=0
29 .F S SCPTA=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN,SCPTA)) Q:'SCPTA D
30 ..S SCY(3)=SCY(3)+1
31 ..Q
32 .Q
33 ;Get team positions
34 K @SCRATCH
35 S SCI=$$TPTM^SCAPMC(SCTM,.SCDT,,,SCRATCH,"ERR")
36 S SCI=0 F S SCI=$O(^TMP("SCRATCH",$J,1,SCI)) Q:'SCI D
37 .N SCDT2 M SCDT2=SCDT S SCDT2="SCDT2"
38 .S SCX=^TMP("SCRATCH",$J,1,SCI)
39 .S SCTP=$P(SCX,U) Q:'SCTP
40 .S SCPOSN=$P(SCX,U,2)
41 .S SCACT=$P(SCX,U,5),SCINAC=$P(SCX,U,6)
42 .S:SCACT>SCDT2("BEGIN") SCDT2("BEGIN")=SCACT
43 .I SCINAC,SCINAC<SCDT2("END") S SCDT2("END")=SCINAC
44 .S SCRATCH="^TMP(""SCRATCH"",$J,2)" K @SCRATCH
45 .;Get list of position patients
46 .S SCII=$$PTTP^SCAPMC(SCTP,.SCDT2,SCRATCH,"ERR")
47 .S SCII=0 F S SCII=$O(^TMP("SCRATCH",$J,2,SCII)) Q:'SCII D
48 ..S SCX=^TMP("SCRATCH",$J,2,SCII)
49 ..S DFN=$P(SCX,U) Q:'DFN
50 ..S DATA=$P(SCX,U,2)_U_$P(SCX,U,6)_U_$P(SCX,U,4,5)_U_SCPOSN
51 ..S SCPTPA=$P(SCX,U,3) Q:'SCPTPA
52 ..S SCPTPA0=$G(^SCPT(404.43,SCPTPA,0)) Q:'$L(SCPTPA0)
53 ..S SCPC=$P(SCPTPA0,U,5)>0 ;pc position?
54 ..F SCIII=0,1,2 S ^TMP("SCRPT",$J,SCIII,$$RPT(SCIII),"PPTS",SCPC,DFN,SCPTPA)=DATA
55 ..Q
56 .Q
57 ;Count team position assignment assignments and uniques
58 F SCI=0,1 S DFN=0 D
59 .F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",SCI,DFN)) Q:'DFN D
60 ..S SCY(8+SCI)=SCY(8+SCI)+1,SCPTPA=0
61 ..F S SCPTPA=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",SCI,DFN,SCPTPA)) Q:'SCPTPA D
62 ...S SCY(4+SCI)=SCY(4+SCI)+1
63 ...Q
64 ..Q
65 .Q
66 ;check for broken team assignments
67 M ^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1)=^TMP("SCRPT",$J,2,SCTEAM,"PPTS",0)
68 S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN)) Q:'DFN D
69 .Q:$D(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN))
70 .S SCPTA=0,SCY(11)=SCY(11)+1
71 .F S SCPTA=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN,SCPTA)) Q:'SCPTA D
72 ..S DATA=^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN,SCPTA)
73 ..S SCPNAM=$P(DATA,U) Q:'$L(SCPNAM)
74 ..S ^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM,SCPTA)=DATA
75 ..S ^TMP("SCRPT",$J,0,0,"BTA",SCDIV,DFN)=""
76 ..S ^TMP("SCRPT",$J,0,0,"BTA",0,DFN)=""
77 ..Q
78 .Q
79 ;check for broken team position assignments
80 S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN)) Q:'DFN D
81 .Q:$D(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN))
82 .S SCPTPA=0,SCY(12)=SCY(12)+1
83 .F S SCPTPA=$O(^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN,SCPTPA)) Q:'SCPTPA D
84 ..S DATA=^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1,DFN,SCPTPA)
85 ..S SCPNAM=$P(DATA,U) Q:'$L(SCPNAM)
86 ..S ^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM,SCPTPA)=DATA
87 ..S ^TMP("SCRPT",$J,0,0,"BTPA",SCDIV,DFN)=""
88 ..S ^TMP("SCRPT",$J,0,0,"BTPA",0,DFN)=""
89 ..Q
90 .Q
91 ;count total uniques and open slots
92 M ^TMP("SCRPT",$J,2,SCTEAM,"TPTS")=^TMP("SCRPT",$J,2,SCTEAM,"PPTS",1)
93 K ^TMP("SCRPT",$J,2,SCTEAM,"PPTS")
94 S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,2,SCTEAM,"TPTS",DFN)) Q:'DFN D
95 .S SCY(10)=SCY(10)+1
96 .Q
97 S SCY(6)=SCY(2)-SCY(10) S:SCY(6)<0 SCY(6)=0
98 K ^TMP("SCRPT",$J,2)
99 ;Move team data to report and division totals
100 I SCY(1)="YES" D
101 .S $P(^TMP("SCRPT",$J,0,0),U)="YES"
102 .S $P(^TMP("SCRPT",$J,1,SCDIV),U)="YES"
103 .S $P(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM),U)="YES"
104 .Q
105 F SCI=2:1:6 D
106 .S $P(^TMP("SCRPT",$J,0,0),U,SCI)=$P($G(^TMP("SCRPT",$J,0,0)),U,SCI)+SCY(SCI)
107 .S $P(^TMP("SCRPT",$J,1,SCDIV),U,SCI)=$P($G(^TMP("SCRPT",$J,1,SCDIV)),U,SCI)+SCY(SCI)
108 .S $P(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM),U,SCI)=$P($G(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM)),U,SCI)+SCY(SCI)
109 .Q
110 F SCI=7:1:12 D
111 .S $P(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM),U,SCI)=SCY(SCI)
112 .Q
113 Q
114 ;
115RPT(X) ;Return report section value
116 Q $S(X=1:SCDIV,X=2:SCTEAM,1:0)
117 ;
118COUNT ;Count division and report uniques
119 S SCDIV="" F S SCDIV=$O(^TMP("SCRPT",$J,1,SCDIV)) Q:SCDIV="" D
120 .K SCY F SCI=7:1:12 S SCY(SCI)=""
121 .S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,1,SCDIV,"TPTS",DFN)) Q:'DFN D
122 ..S SCY(7)=SCY(7)+1
123 ..Q
124 .F SCI=0,1 S DFN=0 D
125 ..F S DFN=$O(^TMP("SCRPT",$J,1,SCDIV,"PPTS",SCI,DFN)) Q:'DFN D
126 ...S SCY(8+SCI)=SCY(8+SCI)+1
127 ...Q
128 ..Q
129 .M ^TMP("SCRPT",$J,1,SCDIV,"PPTS",1)=^TMP("SCRPT",$J,1,SCDIV,"PPTS",0)
130 .M ^TMP("SCRPT",$J,1,SCDIV,"TPTS")=^TMP("SCRPT",$J,1,SCDIV,"PPTS",1)
131 .K ^TMP("SCRPT",$J,1,SCDIV,"PPTS")
132 .S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,1,SCDIV,"TPTS",DFN)) Q:'DFN D
133 ..S SCY(10)=SCY(10)+1
134 ..Q
135 .K ^TMP("SCRPT",$J,1,SCDIV,"TPTS")
136 .F SCI="BTA","BTPA" S DFN=0 D
137 ..F S DFN=$O(^TMP("SCRPT",$J,0,0,SCI,SCDIV,DFN)) Q:'DFN D
138 ...S SCY($S(SCI="BTA":11,1:12))=SCY($S(SCI="BTA":11,1:12))+1
139 ...Q
140 ..K ^TMP("SCRPT",$J,0,0,SCI,SCDIV)
141 ..Q
142 .F SCI=7:1:12 D
143 ..S $P(^TMP("SCRPT",$J,1,SCDIV),U,SCI)=SCY(SCI)
144 ..Q
145 .Q
146 ;count report uniques
147 K SCY F SCI=7:1:12 S SCY(SCI)=""
148 S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,0,0,"TPTS",DFN)) Q:'DFN D
149 .S SCY(7)=SCY(7)+1
150 .Q
151 F SCI=0,1 S DFN=0 D
152 .F S DFN=$O(^TMP("SCRPT",$J,0,0,"PPTS",SCI,DFN)) Q:'DFN D
153 ..S SCY(8+SCI)=SCY(8+SCI)+1
154 ..Q
155 .Q
156 M ^TMP("SCRPT",$J,0,0,"PPTS",1)=^TMP("SCRPT",$J,0,0,"PPTS",0)
157 M ^TMP("SCRPT",$J,0,0,"TPTS")=^TMP("SCRPT",$J,0,0,"PPTS",1)
158 K ^TMP("SCRPT",$J,0,0,"PPTS")
159 S DFN=0 F S DFN=$O(^TMP("SCRPT",$J,0,0,"TPTS",DFN)) Q:'DFN D
160 .S SCY(10)=SCY(10)+1
161 .Q
162 K ^TMP("SCRPT",$J,0,0,"TPTS")
163 F SCI="BTA","BTPA" S DFN=0 D
164 .F S DFN=$O(^TMP("SCRPT",$J,0,0,SCI,0,DFN)) Q:'DFN D
165 ..S SCY($S(SCI="BTA":11,1:12))=SCY($S(SCI="BTA":11,1:12))+1
166 ..Q
167 .K ^TMP("SCRPT",$J,0,0,SCI,0)
168 .Q
169 F SCI=7:1:12 D
170 .S $P(^TMP("SCRPT",$J,0,0),U,SCI)=SCY(SCI)
171 .Q
172 Q
173 ;
174FOOT ;Summary report footer
175 N SCI
176 F SCI=1:1:80 W ! Q:$Y>(IOSL-9)
177 W !,SCLINE
178 W !,"NOTE: This report represents a count of team and team position assignments within the date range selected. If a date range"
179 W !?6,"larger than one day has been selected, the total unique patients and assignments may be greater than the maximum defined"
180 W !?6,"for the team, reducing the open slots reflected by this report accordingly. However, this does not imply that the team"
181 W !?6,"had more than its maximum number of patients on any single date."
182 W !,SCLINE
183 Q
Note: See TracBrowser for help on using the repository browser.