source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m@ 996

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1SCRPTM2 ;ALB/CMM - List of Team's Members Report Continued;01/29/96 ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,140,177,520**;AUG 13, 1993;Build 26
3 ;
4 ;List of Team's Members Report
5 ;
6PULL(TIEN,PLIST) ;
7 ;TIEN - team file ien
8 ;PLIST - array of positions and their practitioners
9 ;
10 N PNAME,TPIEN,ACT,INACT,RNAME,UNAME,CNT,NODE,TNODE,PCLIN,TNAME,SCI
11 N TPHONE,TPC,INS,INAME,PRIEN,PRNAME,OPH,ROOM,SERV,TPNODE,PRCP,PCLASS
12 ;
13 S CNT=0
14 F S CNT=$O(@PLIST@(CNT)) Q:CNT=""!(CNT'?.N) D
15 .;get each practitioner/position
16 .S NODE=$G(@PLIST@(CNT))
17 .S TPIEN=+$P(NODE,"^",3) ;team position ien
18 .S PNAME=$P(NODE,"^",4) ;position name
19 .S ACT=$P(NODE,"^",9) ;active date (fm)
20 .I ACT'=""&(ACT'=0) S ACT=$TR($$FMTE^XLFDT(ACT,"5DF")," ","0")
21 .S INACT=$P(NODE,"^",10) ;inactive date (fm)
22 .I INACT'=""&(INACT'=0) S INACT=$TR($$FMTE^XLFDT(INACT,"5DF")," ","0")
23 .S RNAME=$P(NODE,"^",8) ;standard role name
24 .S UNAME=$P(NODE,"^",6) ;user class name
25 .S PRIEN=+$P(NODE,"^") ;practitioner ien
26 .S PRNAME=$P(NODE,"^",2) ;practitioner name
27 .;
28 .;Get person class information
29 .S PCLASS=$$GET^XUA4A72(PRIEN)
30 .F SCI=1,2,3 S PCLASS(SCI)=$P(PCLASS,U,(SCI+1))
31 .;
32 .S TPNODE=$G(^SCTM(404.57,+TPIEN,0))
33 .D SETASCL^SCRPRAC2(TPIEN,.PCLIN)
34 .S PCLIN=$G(PCLIN(0))
35 .;S PCLIN=+$P(TPNODE,"^",9) ;associated clinic ien
36 .;S PCLIN=$P($G(^SC(PCLIN,0)),"^") ;associated clinic name
37 .;
38 .;Get preceptor
39 .S PRCP=$P($$OKPREC2^SCMCLK(TPIEN,DT),U,2)
40 .;
41 .S TNODE=$G(^SCTM(404.51,TIEN,0)) ;team node
42 .S TNAME=$P(TNODE,"^") ;team name
43 .S TPHONE=$P(TNODE,"^",2) ;team phone
44 .S TPC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care?
45 .S INS=+$P(TNODE,"^",7) ;team division ien
46 .S INAME=$P($G(^DIC(4,INS,0)),"^") ;team division name
47 .D KTEAM(TNAME,TPHONE,TPC,INAME,TIEN,INS)
48 .;
49 .S OPH=$P($G(^VA(200,PRIEN,.13)),"^",2) ;office phone
50 .S ROOM=$P($G(^VA(200,PRIEN,.14)),"^") ;room
51 .S SERV=+$P($G(^VA(200,PRIEN,5)),"^") ;service/section ien
52 .S SERV=$P($G(^DIC(49,SERV,0)),"^") ;service/section name
53 .;
54 .D FORMAT(PNAME,TPIEN,PCLIN,RNAME,UNAME,ACT,INACT,PRIEN,PRNAME,OPH,ROOM,SERV,INS,TIEN,PRCP,.PCLASS)
55 .N SCAC
56 .S SCAC=0
57 .F S SCAC=$O(PCLIN(SCAC)) Q:SCAC="" D FORMATAC(INS,TIEN,PRIEN,TPIEN,PCLIN(SCAC))
58 Q
59 ;
60KTEAM(TNAME,TPHONE,TPC,TDIV,TIEN,IEND) ;
61 ;store team information
62 I TDIV="" S TDIV="[BAD DATA]"
63 I TNAME="" S TNAME="[BDA DATA]"
64 S @STORE@("I",TDIV,IEND)=""
65 S @STORE@("T",IEND,TNAME,TIEN)=""
66 S @STORE@(IEND)="Division: "_TDIV
67 S @STORE@(IEND,TIEN,"H1")="Team Name: "_TNAME
68 S $E(@STORE@(IEND,TIEN,"H1"),40)="Team Phone: "_TPHONE
69 S @STORE@(IEND,TIEN,"H2")="Primary Care Team: "_TPC
70 S @STORE@(IEND,TIEN,"H3")=""
71 S @STORE@(IEND,TIEN,"H4")="Members:"
72 Q
73 ;
74FORMAT(POS,TPIEN,PCLIN,SPOS,UCLASS,BEG,END,PIEN,PRACT,OPH,ROOM,SERV,DIV,TEM,PRCP,PCLASS) ;
75 ;POS - position name
76 ;TPIEN - position ien
77 ;PCLIN - associated clinic
78 ;SPOS - standard position
79 ;UCLASS - user class
80 ;BEG - begin date
81 ;END - end date
82 ;PIEN - ien of new person file
83 ;PRACT - practitioner name
84 ;OPH - office number
85 ;ROOM - room
86 ;SERV - service
87 ;DIV - ien of division
88 ;TEM - ien of team
89 ;PRCP - preceptor
90 ;PCLASS - person class
91 ;
92 N SCI
93 I PRACT="" S PRACT="[BAD DATA]"
94 S @STORE@("PN",DIV,TEM,PRACT,PIEN,TPIEN)=""
95 S @STORE@(DIV,TEM,PIEN,TPIEN,1)=PRACT
96 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,1),35)="Position: "_POS
97 S @STORE@(DIV,TEM,PIEN,TPIEN,2)="Standard Role: "_SPOS
98 S @STORE@(DIV,TEM,PIEN,TPIEN,3)="User Class: "_UCLASS
99 S @STORE@(DIV,TEM,PIEN,TPIEN,4)=SERV
100 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4),35)="Assoc Clinic: "_PCLIN
101 S @STORE@(DIV,TEM,PIEN,TPIEN,5)="Office Phone: "_OPH
102 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,5),35)="Room: "_ROOM
103 S @STORE@(DIV,TEM,PIEN,TPIEN,6)="Begin Date: "_BEG
104 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,6),35)="End Date: "_END
105 S SCI=7
106 I $L(PRCP) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Preceptor: "_PRCP,SCI=8
107 I $L(PCLASS(1)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Person Class: "_PCLASS(1),SCI=SCI+1
108 I $L(PCLASS(2)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(2),SCI=SCI+1
109 I $L(PCLASS(3)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(3)
110 Q
111 ;
112FORMATAC(DIV,TEM,PIEN,TPIEN,PCLIN) ;
113 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4,SCAC),49)=$E(PCLIN,1,30)
114 Q
115 ;
116NEWP(INST,TEM,TITL,PAGE,HEAD) ;
117 ;new page
118 D NEWP1^SCRPU3(.PAGE,TITL)
119 D HEAD1(INST,TEM,.HEAD)
120 Q
121 ;
122HEAD1(INST,TEM,HEAD) ;
123 ;write headings
124 W !,$G(@STORE@(INST))
125 N NXT
126 S NXT="H"
127 F S NXT=$O(@STORE@(INST,TEM,NXT)) Q:NXT'?1"H".E D
128 .W !,$G(@STORE@(INST,TEM,NXT))
129 W ! ;extra line between MEMBERS and practitioner list
130 S HEAD=1
131 Q
132HOLD1(PAGE,TITL,INST,TEM,HEAD) ;
133 ;device is home, reached end of page
134 D HOLD^SCRPU3(.PAGE,TITL)
135 I STOP Q
136 D HEAD1(INST,TEM,.HEAD)
137 Q
Note: See TracBrowser for help on using the repository browser.