source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPO3.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1SCRPO3 ;BP-CIOFO/KEITH - Historical Provider Position Assignment Listing ; 9/14/99 10:06am
2 ;;5.3;Scheduling;**177**;AUG 13, 1993
3 ;
4EN ;Queue report
5 N LIST,SORT,RTN,DESC,SCSP
6 S LIST="DIV,TEAM,POS,ASPR,CLINIC",SORT="DV,TM,TP,PR,EC",SCSP="PR"
7 S RTN="RUN^SCRPO3"
8 S DESC="Historical Provider Position Assignment Listing"
9 D PROMPT^SCRPO1(LIST,SORT,SCSP,RTN,DESC) Q
10 ;
11RUN ;Print report
12 N SCFMT,SCTITL,SCTITL2,SCLINE,SCPAGE,SCOUT,SCFF,SCX,SCPNOW,SCFD
13 N SC1,SC2,SC3,SC4,SC5,SC6,SCN,SCI,SCPNOW,SCY,SCFF,SCLINE,SCPAGE
14 S SCFMT=$E(^TMP("SC",$J,"FMT")),(SCFF,SCOUT)=0
15 D BUILD(SCFMT) Q:SCOUT S SCI=0
16 D HINI D:$E(IOST)="C" DISP0^SCRPW23
17 ;print report parameters
18 S SCTITL(2)=$$HDRX("P") D HDR^SCRPO(.SCTITL,132) Q:SCOUT S SCOUT=$$PPAR^SCRPO(.SC,,.SCTITL)=0
19 Q:SCOUT
20 ;print negative report
21 I '$D(^TMP("SCRPT",$J,0)) D G EXIT
22 .K SCTITL(2) D HDR^SCRPO(.SCTITL,132) Q:SCOUT
23 .S SCX="No provider position assignments found within selected report parameters!"
24 .W !!?(132-$L(SCX)\2),SCX
25 .Q
26 S SCPAGE=1
27 ;print detailed report
28 I SCFMT="D" S SCTITL(2)=$$HDRX("D") D HDR^SCRPO(.SCTITL,132),SHDR("D") Q:SCOUT D
29 .S SC1=""
30 .F S SC1=$O(^TMP("SCRPT",$J,1,SC1)) Q:SC1=""!SCOUT D
31 ..S SC2=""
32 ..F S SC2=$O(^TMP("SCRPT",$J,1,SC1,SC2)) Q:SC2=""!SCOUT D
33 ...S SC3=""
34 ...F S SC3=$O(^TMP("SCRPT",$J,1,SC1,SC2,SC3)) Q:SC3=""!SCOUT D
35 ....S SCN=^TMP("SCRPT",$J,1,SC1,SC2,SC3),SC4=""
36 ....F S SC4=$O(^TMP("SCRPT",$J,2,SCN,SC4)) Q:SC4=""!SCOUT D
37 .....S SC5=""
38 .....F S SC5=$O(^TMP("SCRPT",$J,2,SCN,SC4,SC5)) Q:SC5=""!SCOUT D
39 ......S SC6=""
40 ......F S SC6=$O(^TMP("SCRPT",$J,2,SCN,SC4,SC5,SC6)) Q:SC6=""!SCOUT D
41 .......S SCX=^TMP("SCRPT",$J,2,SCN,SC4,SC5,SC6)
42 .......I $Y>(IOSL-11) D FOOT1,HDR^SCRPO(.SCTITL,132),SHDR("D") Q:SCOUT
43 .......S SCY="0^21^41^46^67^86^94^102^110^118^126" W !
44 .......F SCI=1:1:5 W ?($P(SCY,U,SCI)),$P(SCX,U,SCI)
45 .......F SCI=6:1:11 W ?($P(SCY,U,SCI)),$J($P(SCX,U,SCI),6,0)
46 ......Q
47 .....Q
48 ....Q
49 ...Q
50 ..Q
51 .D:'SCOUT FOOT1
52 .Q
53 G:SCOUT EXIT
54 ;print summary report
55 S SCTITL(2)=$$HDRX("S") D HDR^SCRPO(.SCTITL,132),SHDR("S") G:SCOUT EXIT
56 S (SCFD,SCDIV)=0
57 F S SCDIV=$O(^TMP("SCRPT",$J,0,SCDIV)) Q:SCDIV=""!SCOUT D
58 .S SCPC=$S($D(^TMP("SCRPT",$J,0,SCDIV,"PC")):"YES",1:"NO")
59 .S SCX=^TMP("SCRPT",$J,0,SCDIV)
60 .D:$Y>(IOSL-11) FOOT2,HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
61 .W:SCFD ! D SLINE(SCDIV,SCPC,SCX) S SCTEAM="",SCFD=1
62 .F S SCTEAM=$O(^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM)) Q:SCTEAM=""!SCOUT D
63 ..S SCPC=$S($D(^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM,"PC")):"YES",1:"NO")
64 ..S SCX=^TMP("SCRPT",$J,0,SCDIV,1,SCTEAM)
65 ..D:$Y>(IOSL-10) FOOT2,HDR^SCRPO(.SCTITL,132),SHDR("S") Q:SCOUT
66 ..D SLINE(" "_SCTEAM,SCPC,SCX)
67 ..Q
68 .Q
69 G:SCOUT EXIT
70 ;bp/djb Stop displaying PC? on Total line
71 ;Old code begin
72 ;S SCPC=$S($D(^TMP("SCRPT",$J,0,0,"PC")):"YES",1:"NO")
73 ;Old code end
74 ;New code begin
75 S SCPC=""
76 ;New code end
77 S SCX=^TMP("SCRPT",$J,0,0)
78 W ! D SLINE("REPORT TOTAL:",SCPC,SCX)
79 D FOOT2
80 ;
81EXIT I $E(IOST)="C",'$G(SCOUT) W ! N DIR S DIR(0)="E" D ^DIR
82 F SCI="SC","SCARR","SCRPT" K ^TMP(SCI,$J)
83 K SC D END^SCRPW50 Q
84 ;
85SLINE(SCNAME,SCPC,SCX) ;Print report summary line
86 ;Input: SCNAME=division or team name to print
87 ;Input: SCPC=primary care y/n
88 ;Input: SCX=slot/assignment data
89 ;
90 W !?22,$P(SCNAME,U),?56,SCPC
91 F SCI=1:1:6 W ?(53+(8*SCI)),$J($P(SCX,U,SCI),6,0)
92 Q
93 ;
94HINI ;Initialize header variables
95 N Y
96 S SCTITL(1)="<*> HISTORICAL PROVIDER POSITION ASSIGNMENT LISTING <*>"
97 S SCLINE="",$P(SCLINE,"-",133)="",SCPAGE=1
98 S Y=$$NOW^XLFDT() X ^DD("DD") S SCPNOW=$P(Y,":",1,2)
99 Q
100 ;
101SHDR(SCX) ;Print report subheader
102 ;Input: SCX='D' for detail, 'S' for summary
103 Q:SCOUT
104 I SCX="S" D Q
105 .W !?63,"Max.",?69,"---Assigned---",?93,"---Precepted--"
106 .W !?22,"Division",?63,"Pts.",?69,"---Patients---",?87,"Open"
107 .W ?93,"---Patients---",!?24,"Team",?56,"PC? Allow. PC"
108 .W ?77,"Non-PC Slots PC Non-PC"
109 .W !?22,"-------------------------------- --- ------ ------ ------ ------ ------ ------"
110 .Q
111 W !?88,"Max. ---Assigned---",?118,"---Precepted--",!
112 W ?88,"Pts. ---Patients--- Open ---Patients---",!,"Provider Name"
113 W ?21,"Position",?41,"PC? Team",?67,"Associated Clinic"
114 W ?86,"Allow. PC Non-PC Slots PC Non-PC"
115 W !,"------------------- ------------------ --- ------------------- ----------------- ------ ------ ------ ------ ------ ------"
116 Q
117 ;
118HDRX(SCX) ;extra header line
119 ;Input: SCX='P' for parameters, 'D' for detail, 'S' for summary
120 Q:SCX="P" "Selected Report Parameters"
121 Q $S(SCX="D":"Detail",1:"Summary")_" for Provider Position Assignments Effective: "_^TMP("SC",$J,"DTR","PBDT")_" to "_^TMP("SC",$J,"DTR","PEDT")
122 ;
123STOP ;Check for stop task request
124 S:$D(ZTQUEUED) (SCOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
125 ;
126BUILD(SCFMT) ;Build report data
127 ;Input: SCFMT=report format (detail or summary)
128 N SCTM,SCTP,SCPR,SCARR,ERR,SCI
129 ;Build from provider list
130 I $O(^TMP("SC",$J,"ASPR",0)) S SCPR=0 D Q
131 .F S SCTP=$O(^TMP("SC",$J,"ASPR",SCPR)) Q:'SCPR!SCOUT D
132 ..D STOP Q:SCOUT
133 ..M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
134 ..S SCARR="^TMP(""SCARR"",$J,1)" K @SCARR
135 ..S SCI=$$TPPR^SCAPMC(SCPR,.SCDT,,,SCARR,"ERR")
136 ..S SCTM=0 F S SCTM=$O(^TMP("SCARR",$J,1,"SCTP",SCTM)) Q:'SCTM D
137 ...S SCTP=0 F S SCTP=$O(^TMP("SCARR",$J,1,"SCTP",SCTM,SCTP)) Q:'SCTP D
138 ....S ^TMP("SCARR",$J,0,SCTP)=""
139 ....Q
140 ...Q
141 ..Q
142 .S SCTP=0 F S SCTP=$O(^TMP("SCARR",$J,0,SCTP)) Q:'SCTP!SCOUT D
143 ..D CKPOS(SCTP,SCFMT),STOP
144 ..Q
145 .Q
146 ;Build from position list
147 I $O(^TMP("SC",$J,"POS",0)) S SCTP=0 D Q
148 .F S SCTP=$O(^TMP("SC",$J,"POS",SCTP)) Q:'SCTP!SCOUT D
149 ..D CKPOS(SCTP,SCFMT),STOP
150 ..Q
151 .Q
152 ;Build from all positions
153 S SCTP=0 F S SCTP=$O(^SCTM(404.57,SCTP)) Q:'SCTP!SCOUT D
154 .D CKPOS(SCTP,SCFMT),STOP
155 .Q
156 Q
157 ;
158CKPOS(SCTP,SCFMT) ;Check team position
159 ;Input: SCTP=TEAM POSITION ifn
160 ;Input: SCFMT=report format (detail or summary)
161 ;
162 N SCDIV,SCTEAM,SCPOS,SCLINIC,SCTP0,SCX
163 S SCTP0=$G(^SCTM(404.57,+SCTP,0)) Q:'$L(SCTP0)
164 S SCX=$P(SCTP0,U) Q:'$L(SCX)
165 S SCPOS=SCX_U_SCTP
166 S SCTEAM=$P(SCTP0,U,2) Q:'$$TMDV^SCRPO1(.SCTEAM,.SCDIV)
167 S SCLINIC=$P(SCTP0,U,9) Q:'$$TPCL^SCRPO1(.SCLINIC)
168 D BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
169 Q
170 ;
171BTPOS(SCTP,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT) ;Build from team position
172 ;Input: SCTP=team position ifn
173 ;Input: SCDIV=division^ifn
174 ;Input: SCTEAM=team^ifn
175 ;Input: SCPOS=team position^ifn
176 ;Input: SCLINIC=associated clinic^ifn (if one exists)
177 ;Input: SCFMT=report format (detail or summary)
178 ;
179 N SCARR,SCDT,SCI,SCPASS,ERR
180 S SCARR="^TMP(""SCARR"",$J,1)" K @SCARR
181 M SCDT=^TMP("SC",$J,"DTR") S SCDT="SCDT"
182 S SCI=$$PRTP^SCAPMC(SCTP,.SCDT,SCARR,"ERR",0,0),SCI=0
183 F S SCI=$O(^TMP("SCARR",$J,1,SCI)) Q:'SCI D
184 .S SCPASS=^TMP("SCARR",$J,1,SCI)
185 .D BPRPA^SCRPO4(SCPASS,SCDIV,SCTEAM,SCPOS,SCLINIC,SCFMT)
186 .Q
187 Q
188 ;
189FOOT1 ;Detail report footer
190 N SCI
191 F SCI=1:1:80 W ! Q:$Y>(IOSL-9)
192 W !,SCLINE
193 W !,"NOTE: This report reflects a count of all unique patients assigned to Primary Care and non-Primary Care within the date range"
194 W !?6,"selected. If a date range larger than one day has been selected, the total patients assigned to a provider may be greater"
195 W !?6,"than the maximum defined for the position. However, this does not imply that the provider had more than their maximum"
196 W !?6,"number of patients on any single date."
197 W !,SCLINE
198 Q
199 ;
200FOOT2 ;Summary report footer
201 N SCI
202 F SCI=1:1:80 W ! Q:$Y>(IOSL-8)
203 W !,SCLINE
204 W !,"NOTE: Although presented by division and team, the maximum patients allowed, assigned patients, open slots and precepted patients"
205 W !?6,"reflected in this summary represent a sum of those categories for the provider position assignments identified within the"
206 W !?6,"user specified parameters of this report and may not match the maximum patients, etc. defined for the team as a whole."
207 W !,SCLINE
208 Q
Note: See TracBrowser for help on using the repository browser.