source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPITP2.m@ 631

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

initial load of FOIAVistA 6/30/08 version

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