source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPITP.m@ 975

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

revised back to 6/30/08 version

File size: 4.0 KB
Line 
1SCRPITP ;ALB/CMM - Individual Team Profile ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,52,177**;AUG 13, 1993
3 ;
4 ;Individual Team Profile
5 ;
6PROMPTS ;
7 ;Prompt for Institution, Team, and Print device
8 ;
9 N QTIME,PRNT,VAUTD,VAUTT,Y,NUMBER
10 K VAUTD,VAUTT,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 !!,"This report requires 132 column output!"
15 D QUE(.VAUTD,.VAUTT) Q
16 ;
17QUE(INST,TEAM) ;queue report
18 ;Input Parameters:
19 ;INST - institutions selected (variable and array)
20 ;TEAM - teams selected (variable and array)
21 N ZTSAVE,II
22 F II="INST","TEAM","INST(","TEAM(" S ZTSAVE(II)=""
23 W ! D EN^XUTMDEVQ("QENTRY^SCRPITP","Individual Team Profile",.ZTSAVE)
24 Q
25 ;
26ENTRY2(INST,TEAM,IOP,ZTDTH) ;
27 ;Second entry point for GUI to use
28 ;Input Parameters:
29 ;INST - institutions selected (variable and array)
30 ;TEAM - teams selected (variable and array)
31 ;IOP - print device
32 ;ZTDTH - queue time (optional)
33 ;
34 ;validate parameters
35 I '$D(INST)!'$D(TEAM)!'$D(IOP)!(IOP="") Q
36 ;
37 N NUMBER
38 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
39 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
40 I IOST?1"C-".E D QENTRY G RET
41 I ZTDTH="" S ZTDTH=$H
42 S ZTRTN="QENTRY^SCRPITP"
43 S ZTDESC="iIndividual Team Profile",ZTIO=IOP
44 N II
45 F II="INST","TEAM","INST(","TEAM(","IOP" S ZTSAVE(II)=""
46 D ^%ZTLOAD
47RET S NUMBER=0
48 I $D(ZTSK) S NUMBER=ZTSK
49 D EXIT1
50 Q NUMBER
51 ;
52QENTRY ;
53 ;driver entry point
54 S TITL="Individual Team Profile"
55 S STORE="^TMP("_$J_",""SCRPITP"")"
56 K @STORE
57 S @STORE=0
58 I TEAM=1 D TALL^SCRPPAT3 S TEAM=0
59 D FIND
60 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
61 I '$D(NODATA) D PRINTIT(STORE,TITL)
62 D EXIT2
63 Q
64 ;
65ERR ;
66EXIT1 ;
67 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE
68 Q
69 ;
70EXIT2 ;
71 K @STORE
72 K STOP,STORE,TITL,IOP,TEAM,INST,NODATA
73 Q
74 ;
75FIND ;
76 N TM,EN,NODE,TMP,TPNAME
77 S TM="" K ^TMP("SCRATCH",$J)
78 F S TM=$O(^SCTM(404.57,"C",TM)) Q:TM="" D
79 .;$O through team position file
80 .I '$D(TEAM(TM))&(TEAM'=1) Q
81 .;Q above, not a selected team
82 .;selected team
83 .S EN=""
84 .F S EN=$O(^SCTM(404.57,"C",TM,EN)) Q:EN="" D
85 ..I '$D(^SCTM(404.57,EN,0)) Q
86 ..S NODE=$G(^SCTM(404.57,EN,0))
87 ..Q:NODE=""
88 ..;active or inactive position
89 ..S TMP=$$DATES^SCAPMCU1(404.59,EN,DT)
90 ..S TPNAME=$P(NODE,U) S:'$L(TPNAME) TPNAME="~~~"
91 ..S ^TMP("SCRATCH",$J,TPNAME,EN)=NODE
92 ..I +TMP S ^TMP("SCRATCH",$J,TM,TPNAME,EN)=NODE
93 ..Q
94 .Q
95 S TM=""
96 F S TM=$O(^TMP("SCRATCH",$J,TM)) Q:TM="" S TPNAME="" D
97 .F S TPNAME=$O(^TMP("SCRATCH",$J,TM,TPNAME)) Q:TPNAME="" S EN="" D
98 ..F S EN=$O(^TMP("SCRATCH",$J,TM,TPNAME,EN)) Q:EN="" D
99 ...S NODE=^TMP("SCRATCH",$J,TM,TPNAME,EN)
100 ...D KEEP^SCRPITP2(NODE,EN,TM)
101 ...Q
102 ..Q
103 .Q
104 Q
105 ;
106PRINTIT(STORE,TITL) ;
107 N INST,EINST,ETEAM,TEM,NEW,PAGE,TNAME,TIEN,EN,SUB,POS,CIEN,INF
108 S (INST,EINST)="",STOP=0,(PAGE,NEW)=1 W:$E(IOST)="C" @IOF
109 D FORHEAD^SCRPITP2
110 F S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP) D
111 .S INST=$O(@STORE@("I",EINST,""))
112 .I INST="" Q
113 .I STOP Q
114 .;write team info
115 .S TNAME=""
116 .F S TNAME=$O(@STORE@("T",INST,TNAME)) Q:TNAME=""!(STOP) D
117 ..D:NEW TITLE^SCRPU3(.PAGE,TITL,132)
118 ..I 'NEW,$E(IOST)'="C" D NEWP1^SCRPU3(.PAGE,TITL,132)
119 ..I 'NEW,$E(IOST)="C" D HOLD^SCRPU3(.PAGE,TITL,132)
120 ..W !,$G(@STORE@(INST)),! S NEW=""
121 ..S TIEN=$O(@STORE@("T",INST,TNAME,""))
122 ..I TIEN="" Q
123 ..F SUB="TI","D" D
124 ...Q:STOP
125 ...I '$D(@STORE@(INST,TIEN,SUB)) Q
126 ...S EN=""
127 ...F S EN=$O(@STORE@(INST,TIEN,SUB,EN)) Q:EN=""!(STOP) D
128 ....I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132)
129 ....I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132)
130 ....I STOP Q
131 ....I '$D(NEW) W !,$G(@STORE@(INST)),!,$G(@STORE@(INST,TIEN)),!
132 ....W !,$G(@STORE@(INST,TIEN,SUB,EN))
133 ...W !
134 ..;write position info
135 ..S POS=""
136 ..I $Y<IOSL-10 D COLUMN^SCRPITP2
137 ..F S POS=$O(@STORE@(INST,TIEN,"P",POS)) Q:POS=""!(STOP) D
138 ...I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132) Q:STOP D CONT^SCRPITP2
139 ...I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132) Q:STOP D CONT^SCRPITP2
140 ...I STOP Q
141 ...W !,$G(@STORE@(INST,TIEN,"P",POS))
142 ..W !
143 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
144 Q
Note: See TracBrowser for help on using the repository browser.