source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPO6.m@ 1147

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

initial load of WorldVistAEHR

File size: 7.3 KB
Line 
1SCRPO6 ;BP-CIOFO/KEITH - Historical Team Assignment Summary ; 9/14/99 10:07am
2 ;;5.3;Scheduling;**177,297**;AUG 13, 1993
3 ;
4EN ;Queue report
5 N LIST,RTN,DESC
6 S SUMON=0
7 W !,"Print Final Summary Only" S %=2 D YN^DICN I %=1 S SUMON=1
8 S LIST="DIV,TEAM"
9 S RTN="RUN^SCRPO6"
10 S DESC="Historical Team Assignment Summary"
11 D PROMPT(LIST,RTN,DESC) Q
12 ;
13PROMPT(LIST,SCRTN,SCDESC) ;Prompt for report parameters, queue report
14 ;Input: LIST=comma delimited string of list subscripts to prompt for
15 ;Input: SCRTN=report routine entry point
16 ;Input: SCDESC=tasked job description
17 ;
18 N SCDIV,SCBDT,SCEDT,SC,SCI,SCX,SCOUT,SCT
19 S SC="^TMP(""SC"",$J)" K @SC S SCOUT=0
20 D TITL^SCRPW50(SCDESC)
21 D SUBT^SCRPW50("**** Date Range Selection ****")
22 S (SCBDT("B"),SCEDT("B"))="TODAY"
23 G:'$$DTR^SCRPO(.SC,.SCBDT,.SCEDT) END
24 D SUBT^SCRPW50("**** Report Parameter Selection ****")
25 F SCI=1:1:$L(LIST,",") S SCX=$P(LIST,",",SCI) D Q:SCOUT
26 .S SCOUT='$$LIST^SCRPO(.SC,SCX,1)
27 .Q
28 G:SCOUT END
29 S SCT(1)="**** Report Parameters Selected ****" D SUBT^SCRPW50(SCT(1))
30 G:'$$PPAR^SCRPO(.SC,1,.SCT) END
31 W !!,"This report requires 132 column output!"
32 W ! N ZTSAVE S ZTSAVE("^TMP(""SC"",$J,")="",ZTSAVE("SC")="",ZTSAVE("SUMON")=""
33 D EN^XUTMDEVQ(SCRTN,SCDESC,.ZTSAVE)
34END K ^TMP("SC",$J) D DISP0^SCRPW23,END^SCRPW50 Q
35 ;
36STOP ;Check for stop task request
37 S:$D(ZTQUEUED) (SCOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
38 ;
39RUN ;Print report
40 N SCI,SCOUT
41 K ^TMP("SCRPT",$J)
42 S SCOUT=0
43 D BUILD Q:SCOUT D COUNT^SCRPO7 D STOP Q:SCOUT
44 D PRINT
45 K ^TMP("SCRPT",$J),^TMP("SCRATCH",$J) Q
46 ;
47BUILD ;gather report information
48 N SCTM
49 ;build from list of teams
50 I $O(^TMP("SC",$J,"TEAM",0)) S SCTM=0 D Q
51 .F S SCTM=$O(^TMP("SC",$J,"TEAM",SCTM)) Q:'SCTM!SCOUT D
52 ..D CKTEAM^SCRPO7(SCTM),STOP
53 ..Q
54 .Q
55 ;build from all teams
56 S SCTM=0 F S SCTM=$O(^SCTM(404.51,SCTM)) Q:'SCTM!SCOUT D
57 .D CKTEAM^SCRPO7(SCTM),STOP
58 .Q
59 Q
60 ;
61PRINT ;Print report
62 N SCLF,SCFF,SCLINE,SCPAGE,SCPNOW,SCTITL
63 S (SCLF,SCFF)=0
64 D HINI D:$E(IOST)="C" DISP0^SCRPW23
65 S SCTITL(2)=$$HDRX("P") D HDR^SCRPO(.SCTITL,132) Q:SCOUT S SCOUT=$$PPAR^SCRPO(.SC,,.SCTITL)=0
66 Q:SCOUT
67 I '$D(^TMP("SCRPT",$J,0)) D Q
68 .K SCTITL(2) D HDR^SCRPO(.SCTITL,132) Q:SCOUT
69 .S SCX="No team or team position assignments found within selected report parameters!"
70 .W !!?(132-$L(SCX)\2),SCX
71 .Q
72 S SCPAGE=1
73 S SCTITL(2)=$$HDRX("S") D HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
74 S SCDIV="" F S SCDIV=$O(^TMP("SCRPT",$J,1,SCDIV)) Q:SCDIV=""!SCOUT D
75 .S SCX=^TMP("SCRPT",$J,1,SCDIV) D SLINE(SCDIV,SCX,12,.SCLF) S SCTEAM=""
76 .F S SCTEAM=$O(^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM)) Q:SCTEAM=""!SCOUT D
77 ..S SCX=^TMP("SCRPT",$J,1,SCDIV,"TEAM",SCTEAM)
78 ..D SLINE(" "_SCTEAM,SCX,10,.SCLF)
79 ..Q
80 .Q
81 Q:SCOUT
82 S SCX=^TMP("SCRPT",$J,0,0) D SLINE("REPORT TOTAL:",SCX,12,.SCLF)
83 Q:SCOUT D FOOT^SCRPO7
84 Q:$G(SUMON)
85 I $D(^TMP("SCRPT",$J,0,0,"TLIST")) D
86 .S SCTITL(2)=$$HDRX("T") D HDR^SCRPO(.SCTITL,132),SHDR("T") Q:SCOUT
87 .S SCDIV=""
88 .F S SCDIV=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV)) Q:SCDIV=""!SCOUT D
89 ..S SCTEAM=""
90 ..F S SCTEAM=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM)) Q:SCTEAM=""!SCOUT D
91 ...S SCPNAM=""
92 ...F S SCPNAM=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM)) Q:SCPNAM=""!SCOUT D
93 ....S SCI=0
94 ....F S SCI=$O(^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM,SCI)) Q:'SCI!SCOUT D
95 .....S SCX=^TMP("SCRPT",$J,0,0,"TLIST",SCDIV,SCTEAM,SCPNAM,SCI)
96 .....D TLINE(SCDIV,SCTEAM,SCPNAM,SCX)
97 .....Q
98 ....Q
99 ...Q
100 ..Q
101 .Q
102 Q:SCOUT I $D(^TMP("SCRPT",$J,0,0,"PLIST")) D
103 .S SCTITL(2)=$$HDRX("TP") D HDR^SCRPO(.SCTITL,132),SHDR("P") Q:SCOUT
104 .S SCDIV=""
105 .F S SCDIV=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV)) Q:SCDIV=""!SCOUT D
106 ..S SCTEAM=""
107 ..F S SCTEAM=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM)) Q:SCTEAM=""!SCOUT D
108 ...S SCPNAM=""
109 ...F S SCPNAM=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM)) Q:SCPNAM=""!SCOUT D
110 ....S SCI=0
111 ....F S SCI=$O(^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM,SCI)) Q:'SCI!SCOUT D
112 .....S SCX=^TMP("SCRPT",$J,0,0,"PLIST",SCDIV,SCTEAM,SCPNAM,SCI)
113 .....D PLINE(SCDIV,SCTEAM,SCPNAM,SCX)
114 .....Q
115 ....Q
116 ...Q
117 ..Q
118 .Q
119 I 'SCOUT,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
120 Q
121 ;
122SLINE(SCN,SCX,SCPF,SCLF) ;Print summary line
123 ;Input: SCN=name of item to print
124 ;Input: SCX=string of item values
125 ;Input: SCPF=minimum lines without page feed
126 ;Input: SCLF=extra line feed flag
127 ;
128 N SCI,SCY
129 S SCY="2^3^7^5^4^9^8^10^6^11^12"
130 I $Y>(IOSL-SCPF) D FOOT^SCRPO7,HDR^SCRPO(.SCTITL,132),SHDR("S") S SCLF=0
131 Q:SCOUT W:SCPF>10&SCLF !
132 ;bp/djb Omit PC? column from REPORT TOTAL line.
133 ;Old code start
134 ;W !,$E($P(SCN,U),1,28),?30,$S($P(SCX,U)="":"NO",1:$P(SCX,U))
135 ;Old code end
136 ;New code start
137 I SCN["REPORT TOTAL" W !,$E($P(SCN,U),1,28)
138 E W !,$E($P(SCN,U),1,28),?30,$S($P(SCX,U)="":"NO",1:$P(SCX,U))
139 ;New code end
140 F SCI=1:1:11 W ?(27+(9*SCI)),$J(+$P(SCX,U,$P(SCY,U,SCI)),6,0)
141 S SCLF=1
142 Q
143 ;
144TLINE(SCDIV,SCTEAM,SCPNAM,SCX) ;Print broken team assignment line
145 ;Input: SCDIV=division
146 ;Input: SCTEAM=team
147 ;Input: SCPNAM=patient name
148 ;Input: SCX=string of patient assignment data
149 ;
150 N SCI,Y
151 F SCI=3,4 S Y=$P($P(SCX,U,SCI),".") X ^DD("DD") S $P(SCX,U,SCI)=Y
152 I $Y>(IOSL-4) D HDR^SCRPO(.SCTITL,132),SHDR("T") Q:SCOUT
153 W !,$P(SCDIV,U),?32,$P(SCTEAM,U),?64,SCPNAM
154 W ?96,$TR($P(SCX,U,2),"-",""),?108,$P(SCX,U,3),?121,$P(SCX,U,4)
155 Q
156 ;
157PLINE(SCDIV,SCTEAM,SCPNAM,SCX) ;Print broken team assignment line
158 ;Input: SCDIV=division
159 ;Input: SCTEAM=team
160 ;Input: SCPNAM=patient name
161 ;Input: SCX=string of patient assignment data
162 ;
163 N SCI,Y
164 F SCI=3,4 S Y=$P($P(SCX,U,SCI),".") X ^DD("DD") S $P(SCX,U,SCI)=Y
165 I $Y>(IOSL-4) D HDR^SCRPO(.SCTITL,132),SHDR("P") Q:SCOUT
166 W !,$P(SCDIV,U),?24,$P(SCTEAM,U),?48,SCPNAM,?72,$TR($P(SCX,U,2),"-","")
167 W ?84,$P(SCX,U,5),?108,$P(SCX,U,3),?121,$P(SCX,U,4)
168 Q
169 ;
170HDRX(SCX) ;extra header line
171 ;Input: SCX='P' for parameters, 'S' for summary, 'T' for broken team
172 ; assignments, 'TP' for broken team position assignments
173 ;
174 Q:SCX="P" "Selected Report Parameters"
175 Q:SCX="S" "Summary of Team and Team Position Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
176 Q:SCX="T" "Team Assignments Without Active Position Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
177 Q:SCX="TP" "Position Assignments Without Active Team Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
178 Q:""
179 ;
180HINI ;Initialize header variables
181 N Y
182 S SCTITL(1)="<*> HISTORICAL TEAM ASSIGNMENT SUMMARY <*>"
183 S SCLINE="",$P(SCLINE,"-",133)="",SCPAGE=1
184 S Y=$$NOW^XLFDT() X ^DD("DD") S SCPNOW=$P(Y,":",1,2)
185 Q
186 ;
187SHDR(X) ;Print subheader
188 Q:SCOUT
189 N SCI
190 I X="S" D Q
191 .W !?56,"Team --Team Position- --Team Position- Total",?116,"Pts w/o Pts w/o"
192 .W !,"Division",?38,"Max. Team Assign. ---Assignments-- ---Unique Pts.-- Unique Open Pos. Team"
193 .W !?2,"Team",?30,"PC? Pts. Assign. Uniques PC",?72,"Non-PC PC",?90,"Non-PC Pts. Slots Assign. Assign."
194 .W !,$E(SCLINE,1,28)," ---" F SCI=0:1:10 W ?(35+(9*SCI)),"-------"
195 .Q
196 I X="T" D Q
197 .W !,"Division",?32,"Team",?64,"Patient Name",?96,"SSN",?108,"Active Date",?121,"Inact. Date"
198 .W ! F SCI=1:1:3 W $E(SCLINE,1,30)," "
199 .W "---------- ----------- -----------"
200 .Q
201 I X="P" D Q
202 .W !,"Division",?24,"Team",?48,"Patient Name",?72,"SSN",?84,"Team Position",?108,"Active Date",?121,"Inact. Date"
203 .W ! F SCI=1:1:3 W $E(SCLINE,1,22)," "
204 .W "---------- ",$E(SCLINE,1,22)," ----------- -----------"
205 .Q
206 Q
Note: See TracBrowser for help on using the repository browser.