source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPSLT.m@ 1270

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

revised back to 6/30/08 version
File size: 4.3 KB
RevLine 
[623]1SCRPSLT ;ALB/CMM - Summary Listing of Teams ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,52,177,231**;AUG 13, 1993
3 ;
4 ;Summary Listing of Teams Report
5 ;
6PROMPTS ;
7 ;Prompt for Institution, Team, Role and Print device
8 ;
9 N VAUTD,VAUTT,VAUTR,QTIME,PRNT,NUMBER
10 K VAUTD,VAUTT,VAUTR,SCUP
11 S QTIME=""
12 W ! D INST^SCRPU1 I Y=-1 G ERR
13 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR
14 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR
15 W !!,"This report requires 132 column output!"
16 D QUE(.VAUTD,.VAUTT,.VAUTR) Q
17 ;
18QUE(INST,TEAM,ROLE) ;queue report
19 ;Input Parameters:
20 ;INST - institutions selected (variable and array)
21 ;TEAM - teams selected (variable and array)
22 ;ROLE - roles selected (variable and array)
23 N ZTSAVE,II
24 F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(" S ZTSAVE(II)=""
25 W ! D EN^XUTMDEVQ("QENTRY^SCRPSLT","Summary Listing of Teams",.ZTSAVE)
26 Q
27 ;
28ENTRY2(INST,TEAM,ROLE,IOP,ZTDTH) ;
29 ;Second entry point for GUI to use
30 ;Input Parameters:
31 ;INST - institutions selected (variable and array)
32 ;TEAM - teams selected (variable and array)
33 ;ROLE - roles selected (variable and array)
34 ;IOP - print device
35 ;ZTDTH - queue time (optional)
36 ;
37 ;validate parameters
38 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(IOP)!(IOP="") Q
39 ;
40 N NUMBER
41 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
42 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
43 I IOST?1"C-".E D QENTRY G RET
44 I ZTDTH="" S ZTDTH=$H
45 S ZTRTN="QENTRY^SCRPSLT"
46 S ZTDESC="Summary Listing Of Teams",ZTIO=IOP
47 N II
48 F II="INST","TEAM","ROLE","INST(","TEAM(","ROLE(","IOP" S ZTSAVE(II)=""
49 D ^%ZTLOAD
50RET S NUMBER=0
51 I $D(ZTSK) S NUMBER=ZTSK
52 D EXIT1
53 Q NUMBER
54 ;
55QENTRY ;
56 ;driver entry point
57 S TITL="Summary Listing of Teams"
58 S STORE="^TMP("_$J_",""SCRPSLT"")"
59 K @STORE
60 S @STORE=0
61 I TEAM=1 D TALL^SCRPPAT3 S TEAM=0
62 D FIND
63 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
64 I '$D(NODATA) D PRINTIT(STORE,TITL)
65 D EXIT2
66 Q
67 ;
68ERR ;
69EXIT1 ;
70 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP
71 Q
72 ;
73EXIT2 ;
74 K @STORE
75 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,NODATA
76 Q
77 ;
78FIND ;
79 N TM,EN2,EN,ROL,NODE,TEND,ACT,INA,TPASS,TPCN,TMAX,TMP,TOA,TNPC
80 S TM=""
81 F S TM=$O(^SCTM(404.57,"C",TM)) Q:TM="" D
82 .;$O through team position file
83 .I '$D(TEAM(TM))&(TEAM'=1) Q
84 .;Q above, not a selected team
85 .;selected team
86 .S EN=""
87 .S TPASS(TM)=0,TMAX(TM)=0,TPCN(TM)=0
88 .F S EN=$O(^SCTM(404.57,"C",TM,EN)) Q:EN="" D
89 ..I '$D(^SCTM(404.57,EN,0)) Q
90 ..S NODE=$G(^SCTM(404.57,EN,0))
91 ..Q:NODE=""
92 ..S ROL=+$P(NODE,"^",3) ;role ien
93 ..I '$D(ROLE(ROL))&(ROLE'=1) Q
94 ..;Q above not a selected role
95 ..;find active position during date range
96 ..S TMP=$$DATES^SCAPMCU1(404.52,EN,DT)
97 ..I +TMP=0 Q
98 ..S EN2=+$P(TMP,"^",4)
99 ..D KEEP^SCRPSLT2(NODE,EN,EN2,ROL,TM,.TPCN,.TNPC)
100 ..S TPASS(TM)=$$TEAMCNT^SCAPMCU1(TM,DT)
101 ..S TMAX(TM)=+$P($G(^SCTM(404.51,+TM,0)),U,8)
102 ..S TOA(TM)=TMAX(TM)-TPASS(TM) S:TOA(TM)<0 TOA(TM)=0
103 ..D TEAMT^SCRPSLT2(TM,.TPASS,.TMAX,.TPCN,.TOA,.TNPC)
104 Q
105 ;
106PRINTIT(STORE,TITL) ;
107 N INST,EINST,ETEAM,TEM,EPRACT,PRACT,NXT,PAGE,NPAGE,NEW,POS
108 S (INST,EINST)="",(NPAGE,STOP)=0,PAGE=1 W:$E(IOST)="C" @IOF
109 D TITLE^SCRPU3(.PAGE,TITL)
110 D FORHEAD^SCRPSLT2
111 F S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP) D
112 .S INST=$O(@STORE@("I",EINST,""))
113 .I INST="" Q
114 .S (TEM,ETEAM)=""
115 .F S ETEAM=$O(@STORE@("T",INST,ETEAM)) Q:ETEAM=""!(STOP) D
116 ..S TEM=$O(@STORE@("T",INST,ETEAM,""))
117 ..I TEM="" Q
118 ..K NEW
119 ..I NPAGE,(IOST'?1"C-".E) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW=""
120 ..I NPAGE,(IOST?1"C-".E) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW=""
121 ..S NPAGE=1 I STOP Q
122 ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE) S NEW=""
123 ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM) S NEW=""
124 ..I STOP Q
125 ..I '$D(NEW) D HEADER^SCRPSLT2(INST,TEM)
126 ..S (PRACT,EPRACT)=""
127 ..F S EPRACT=$O(@STORE@("PN",INST,TEM,EPRACT)) Q:EPRACT=""!(STOP) D
128 ...S PRACT=$O(@STORE@("PN",INST,TEM,EPRACT,""))
129 ...I PRACT="" Q
130 ...S POS=""
131 ...F S POS=$O(@STORE@(INST,TEM,PRACT,POS)) Q:POS=""!(STOP) D
132 ....I IOST'?1"C-".E,$Y>(IOSL-4) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE)
133 ....I IOST?1"C-".E,$Y>(IOSL-4) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM)
134 ....I STOP Q
135 ....W !,$G(@STORE@(INST,TEM,PRACT,POS)) ;writes info
136 ..Q:STOP
137 ..I IOST'?1"C-".E,$Y>(IOSL-8) D NEWP^SCRPSLT2(INST,TEM,TITL,.PAGE,1)
138 ..I IOST?1"C-".E,$Y>(IOSL-8) D HOLD1^SCRPSLT2(.PAGE,TITL,INST,TEM,1)
139 ..D TOTAL^SCRPSLT2(INST,TEM)
140 .I STOP Q
141 .S NPAGE=1
142 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" D ^DIR
143 Q
Note: See TracBrowser for help on using the repository browser.