source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTM2.m@ 1718

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

WorldVistAEHR overlayed on FOIAVistA
File size: 4.2 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**;AUG 13, 1993
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 .S PCLIN=+$P(TPNODE,"^",9) ;associated clinic ien
34 .S PCLIN=$P($G(^SC(PCLIN,0)),"^") ;associated clinic name
35 .;
36 .;Get preceptor
37 .S PRCP=$P($$OKPREC2^SCMCLK(TPIEN,DT),U,2)
38 .;
39 .S TNODE=$G(^SCTM(404.51,TIEN,0)) ;team node
40 .S TNAME=$P(TNODE,"^") ;team name
41 .S TPHONE=$P(TNODE,"^",2) ;team phone
42 .S TPC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care?
43 .S INS=+$P(TNODE,"^",7) ;team division ien
44 .S INAME=$P($G(^DIC(4,INS,0)),"^") ;team division name
45 .D KTEAM(TNAME,TPHONE,TPC,INAME,TIEN,INS)
46 .;
47 .S OPH=$P($G(^VA(200,PRIEN,.13)),"^",2) ;office phone
48 .S ROOM=$P($G(^VA(200,PRIEN,.14)),"^") ;room
49 .S SERV=+$P($G(^VA(200,PRIEN,5)),"^") ;service/section ien
50 .S SERV=$P($G(^DIC(49,SERV,0)),"^") ;service/section name
51 .;
52 .D FORMAT(PNAME,TPIEN,PCLIN,RNAME,UNAME,ACT,INACT,PRIEN,PRNAME,OPH,ROOM,SERV,INS,TIEN,PRCP,.PCLASS)
53 Q
54 ;
55KTEAM(TNAME,TPHONE,TPC,TDIV,TIEN,IEND) ;
56 ;store team information
57 I TDIV="" S TDIV="[BAD DATA]"
58 I TNAME="" S TNAME="[BDA DATA]"
59 S @STORE@("I",TDIV,IEND)=""
60 S @STORE@("T",IEND,TNAME,TIEN)=""
61 S @STORE@(IEND)="Division: "_TDIV
62 S @STORE@(IEND,TIEN,"H1")="Team Name: "_TNAME
63 S $E(@STORE@(IEND,TIEN,"H1"),40)="Team Phone: "_TPHONE
64 S @STORE@(IEND,TIEN,"H2")="Primary Care Team: "_TPC
65 S @STORE@(IEND,TIEN,"H3")=""
66 S @STORE@(IEND,TIEN,"H4")="Members:"
67 Q
68 ;
69FORMAT(POS,TPIEN,PCLIN,SPOS,UCLASS,BEG,END,PIEN,PRACT,OPH,ROOM,SERV,DIV,TEM,PRCP,PCLASS) ;
70 ;POS - position name
71 ;TPIEN - position ien
72 ;PCLIN - associated clinic
73 ;SPOS - standard position
74 ;UCLASS - user class
75 ;BEG - begin date
76 ;END - end date
77 ;PIEN - ien of new person file
78 ;PRACT - practitioner name
79 ;OPH - office number
80 ;ROOM - room
81 ;SERV - service
82 ;DIV - ien of division
83 ;TEM - ien of team
84 ;PRCP - preceptor
85 ;PCLASS - person class
86 ;
87 N SCI
88 I PRACT="" S PRACT="[BAD DATA]"
89 S @STORE@("PN",DIV,TEM,PRACT,PIEN,TPIEN)=""
90 S @STORE@(DIV,TEM,PIEN,TPIEN,1)=PRACT
91 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,1),35)="Position: "_POS
92 S @STORE@(DIV,TEM,PIEN,TPIEN,2)="Standard Role: "_SPOS
93 S @STORE@(DIV,TEM,PIEN,TPIEN,3)="User Class: "_UCLASS
94 S @STORE@(DIV,TEM,PIEN,TPIEN,4)=SERV
95 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4),35)="Assoc Clinic: "_PCLIN
96 S @STORE@(DIV,TEM,PIEN,TPIEN,5)="Office Phone: "_OPH
97 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,5),35)="Room: "_ROOM
98 S @STORE@(DIV,TEM,PIEN,TPIEN,6)="Begin Date: "_BEG
99 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,6),35)="End Date: "_END
100 S SCI=7
101 I $L(PRCP) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Preceptor: "_PRCP,SCI=8
102 I $L(PCLASS(1)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Person Class: "_PCLASS(1),SCI=SCI+1
103 I $L(PCLASS(2)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(2),SCI=SCI+1
104 I $L(PCLASS(3)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(3)
105 Q
106 ;
107NEWP(INST,TEM,TITL,PAGE,HEAD) ;
108 ;new page
109 D NEWP1^SCRPU3(.PAGE,TITL)
110 D HEAD1(INST,TEM,.HEAD)
111 Q
112 ;
113HEAD1(INST,TEM,HEAD) ;
114 ;write headings
115 W !,$G(@STORE@(INST))
116 N NXT
117 S NXT="H"
118 F S NXT=$O(@STORE@(INST,TEM,NXT)) Q:NXT'?1"H".E D
119 .W !,$G(@STORE@(INST,TEM,NXT))
120 W ! ;extra line between MEMBERS and practitioner list
121 S HEAD=1
122 Q
123HOLD1(PAGE,TITL,INST,TEM,HEAD) ;
124 ;device is home, reached end of page
125 D HOLD^SCRPU3(.PAGE,TITL)
126 I STOP Q
127 D HEAD1(INST,TEM,.HEAD)
128 Q
Note: See TracBrowser for help on using the repository browser.