source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPITP2.m@ 699

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

revised back to 6/30/08 version

File size: 4.0 KB
Line 
1SCRPITP2 ;ALB/CMM - Individual Team Profile Continued ;7/25/99 18:24
2 ;;5.3;Scheduling;**41,177**;AUG 13, 1993
3 ;
4 ;Individual Team Profile
5 ;
6KEEP(TNODE,TPOS,TM,SCEN) ;
7 ;TNODE - zero node of the team position file entry TPOS
8 ;TPOS - ien of team position file entry TNODE
9 ;TM - ien of team
10 ;
11 N POS,PPC,CLIEN,PCLIN,MAX,ROL,CIEN,DIV
12 N SCRDATE,SCI,PROVLIST,SCPROV,SCPTASS,ERR
13 ;
14 D TEAM(TM,.DIV)
15 ;
16 S POS=$P(TNODE,"^") ;position name
17 S ROL=$P($G(^SD(403.46,+$P(TNODE,"^",3),0)),"^") ;standard position
18 S PPC=$S($P(TNODE,"^",4)'=1:"NPC",+$$OKPREC3^SCMCLK(TPOS,DT)>1:" AP",1:"PCP") ;primary care position
19 S MAX=$P(TNODE,"^",8)
20 ;
21 S SCRDATE="SCRDATE",(SCRDATE("BEGIN"),SCRDATE("END"))=DT,SCRDATE("INCL")=0
22 S SCI="PROVLIST",SCI=$$PRTP^SCAPMC(TPOS,.SCRDATE,SCI,"ERR",1,0)
23 S SCPROV=$P($G(PROVLIST(1)),U,2)
24 S SCPTASS=$$PCPOSCNT^SCAPMCU1(TPOS,DT,0)
25 ;
26 S CIEN=+$P(TNODE,"^",9) ;clinic ien
27 S PCLIN=""
28 I CIEN>0 S PCLIN=$P($G(^SC(CIEN,0)),"^") ;associated clinic
29 ;
30 D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,PCLIN,SCPROV,SCPTASS)
31 ;
32 Q
33 ;
34TEAM(TM,DIV) ;
35 ;
36 N TMN,TNAME,TDIV,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR
37 S TMN=$G(^SCTM(404.51,TM,0)) ;zero node of team file
38 S TNAME=$P(TMN,"^") ;team name
39 S DIV=+$P(TMN,"^",7) ;division ien
40 S TDIV=$P($G(^DIC(4,DIV,0)),"^") ;team division
41 S TPHONE=$P(TMN,"^",2) ;team phone
42 S TPC=+$P(TMN,"^",5) ;Primary Care Team ien
43 S TSERV=$P($G(^DIC(49,+$P(TMN,"^",6),0)),"^") ;Service/section
44 S STAT=$S(+$$ACTTM^SCMCTMU(TM)=1:"ACTIVE",1:"INACTIVE") ;Team status
45 S PUR=$P($G(^SD(403.47,+$P(TMN,"^",3),0)),"^")
46 S MAX=$P(TMN,"^",8)
47 S CUR=$$TEAMCNT^SCAPMCU1(TM,DT)
48 D TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR)
49 ;
50 ;GET TEAM DESCRIPTION (WORD PROCESSING FIELD)
51 D TDESC(TM,DIV)
52 Q
53TDESC(TEM,DIV) ;
54 ;gets team description - word processing field
55 Q:'$O(^SCTM(404.51,TEM,"D",0))
56 N EN
57 S EN=0
58 S @STORE@(DIV,TEM,"D",0)="Team Description: "
59 S @STORE@(DIV,TEM,"D",.5)=""
60 F S EN=$O(^SCTM(404.51,TEM,"D",EN)) Q:EN="" D
61 .S @STORE@(DIV,TEM,"D",EN)=$G(^SCTM(404.51,TEM,"D",EN,0))
62 Q
63 ;
64TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR) ;
65 ;
66 I TNAME="" S TNAME="[BAD DATA]"
67 I TDIV="" S TDIV="[BAD DATA]"
68 S @STORE@("I",TDIV,DIV)=""
69 S @STORE@("T",DIV,TNAME,TM)=""
70 S @STORE@(DIV)="Division: "_TDIV
71 ;
72 S @STORE@(DIV,TM,"TI",1)="Team Name: "_TNAME
73 S $E(@STORE@(DIV,TM,"TI",1),44)="Service/Section: "_$E(TSERV,1,30)
74 S $E(@STORE@(DIV,TM,"TI",1),(120-$L(TPHONE)))="Team Phone: "_TPHONE
75 S @STORE@(DIV,TM,"TI",2)=""
76 S @STORE@(DIV,TM,"TI",3)="Team Settings:"
77 S @STORE@(DIV,TM,"TI",4)=""
78 S @STORE@(DIV,TM,"TI",5)="Status: "_STAT
79 S $E(@STORE@(DIV,TM,"TI",5),19)="Maximum Patients: "_MAX
80 S $E(@STORE@(DIV,TM,"TI",5),47)="Unique Patients Assigned: "_CUR
81 S $E(@STORE@(DIV,TM,"TI",5),83)="Purpose: "_$E(PUR,1,35)
82 S @STORE@(DIV,TM,"TI",6)=""
83 I CUR+1>MAX S @STORE@(DIV,TM,"TI",7)="This team is not accepting patients."
84 I CUR<MAX,CUR'=MAX S @STORE@(DIV,TM,"TI",7)="This team is still accepting patients."
85 Q
86 ;
87FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,CNAME,SCPROV,SCPTASS) ;
88 ;
89 I POS="" S POS="[BAD DATA]"
90 S @STORE@(DIV,TM,"P",POS)=$E(POS,1,24) ;position
91 S $E(@STORE@(DIV,TM,"P",POS),27)=$E(SCPROV,1,24) ;provider
92 S $E(@STORE@(DIV,TM,"P",POS),53)=$E(ROL,1,24) ;standard role
93 S $E(@STORE@(DIV,TM,"P",POS),77)=PPC ;primary care yes/no
94 S $E(@STORE@(DIV,TM,"P",POS),82)=$J(MAX,6,0) ;number of patients allowed
95 S $E(@STORE@(DIV,TM,"P",POS),92)=$J(SCPTASS,6,0) ;patients assigned
96 S $E(@STORE@(DIV,TM,"P",POS),103)=$E(CNAME,1,30) ;clinic name
97 Q
98 ;
99FORHEAD ;
100 S @STORE@("C",2)="Team Position"
101 S $E(@STORE@("C",2),27)="Provider Name"
102 S $E(@STORE@("C",2),53)="Standard Role"
103 S $E(@STORE@("C",2),77)="PC?"
104 S $E(@STORE@("C",1),82)="Patients"
105 S $E(@STORE@("C",2),82)="Allowed"
106 S $E(@STORE@("C",1),92)="Patients"
107 S $E(@STORE@("C",2),92)="Assigned"
108 S $E(@STORE@("C",2),103)="Associated Clinic"
109 S $P(@STORE@("C",3),"=",133)=""
110 Q
111 ;
112CONT ;Team continuation header
113 W !,"Team '",TNAME,"' continued..."
114COLUMN ;
115 I STOP Q
116 N EN
117 S EN=0
118 F S EN=$O(@STORE@("C",EN)) Q:EN="" D
119 .W !,$G(@STORE@("C",EN))
120 Q
121 ;
Note: See TracBrowser for help on using the repository browser.