source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPPAT2.m@ 1487

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

initial load of FOIAVistA 6/30/08 version

File size: 6.6 KB
Line 
1SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
2 ;;5.3;Scheduling;**41,48,174,181,177,231,433,297,526,520**;AUG 13, 1993;Build 26
3 ;
4 ;Listing of Practitioner's Patients
5 ;
6DRIVE ;
7 ;driver module
8 N PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC
9 S ARRY="^TMP(""SCARRAY"","_$J_")",ERROR="ERR"
10 S TPRC="^TMP(""SCRP"",$J,""PRACT"")" M @TPRC=PRACT
11 K @ARRY,@ERROR,PRACT
12 I @TPRC=1 D ALL^SCRPPAT3 ;all practitioners selected
13 S NXT=0
14 F S NXT=$O(@TPRC@(NXT)) Q:NXT=""!(NXT'?.N) D
15 .I @TPRC=0 S PIEN=NXT
16 .I @TPRC=1 S PIEN=$P(@TPRC@(NXT),"^")
17 .K @ARRY,@ERROR
18 .S OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR) ;patients for practitioner
19 .I '+OKAY Q
20 .D LOOPPT(ARRY,PIEN) ;loop through patients for practitioner
21 K @ARRY,@ERROR,@TPRC
22 K:SUMM @STORE@("PT")
23 Q
24 ;
25LOOPPT(ARY,PRAC) ;loop through patients for practitioner
26 ;ARY - array of patients for selected practitioner
27 ;PRAC - practitioner ien
28 N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
29 N PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
30 S NXT=0
31 F S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N) D
32 .S NODE=$G(@ARY@(NXT))
33 .Q:NODE=""
34 .S PIEN=+$P(NODE,"^") ;ien of patient file entry
35 .S TPIEN=+$P(NODE,"^",3) ;ien of patient team position assignment
36 .S PTP=$G(^SCPT(404.43,TPIEN,0))
37 .Q:PTP=""
38 .S PTA=+$P(PTP,"^") ;patient team assignment ien (404.42)
39 .S PTAN=$G(^SCPT(404.42,PTA,0))
40 .Q:PTAN=""
41 .S TIEN=+$P(PTAN,"^",3) ;team file ien (404.51)
42 .I $G(TEAM)'=1,'$D(TEAM(TIEN)) Q ;not a selected team
43 .S TNODE=$G(^SCTM(404.51,TIEN,0))
44 .Q:TNODE="" I $G(INST)'=1,'$D(INST(+$P(TNODE,U,7))) Q
45 .S TNAME=$P(TNODE,"^") ;team name
46 .S TPI=+$P(PTP,"^",2) ;Team Position file ien (404.57)
47 .S TPN=$G(^SCTM(404.57,TPI,0))
48 .Q:TPN=""
49 .I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q ;not a selected role
50 .S POSN=$P(TPN,"^") ;position name
51 .D SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN) ;get clinics from multiple
52 .;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
53 .;commented next line off - clinic enrollment no longer needed SD*5.3*433
54 .;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
55 .;S CNAME=$P($G(^SC(CLIEN,0)),"^") ; SD*5.3*433 remove enroll check
56 .S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no
57 .S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;practitioner name
58 .Q:PNAME=""
59 .S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2)
60 .D GETPINF(PIEN,.CLIEN,.PINF) ;get patient information and appointments
61 .S CNAME=$G(CNAME(0)) ;first line will capture position information
62 .S PINF=$G(PINF(0))
63 .I PINF="" D
64 ..S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
65 .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
66 .D SETFORM(PIEN,.CNAME,.PINF)
67SETFORM(PIEN,CNAME,PINF) ;Format for clinic info only for multiples
68 N SCCNT
69 S SCCNT=0 F S SCCNT=$O(PINF(SCCNT)) Q:SCCNT="" D FORMATAC(CNAME(SCCNT),PINF(SCCNT),PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
70 Q
71GETPINF(PIEN,CLIEN,PINF) ;get patient info
72 N SCCNT
73 S SCCNT="" F S SCCNT=$O(CLIEN(SCCNT)) Q:SCCNT="" D
74 .S PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
75 Q
76 ;
77CECHK(CLIEN,CNAME,PIEN) ;should no longer be used as of patch SD*5.3*433
78 ;CLIEN - clinic ien
79 ;CNAME - clinic name returned if patient is enrolled in clien clinic
80 ;PIEN - patien ien
81 ;
82 N EN,NODE
83 S CNAME=""
84 I $D(^DPT(PIEN,"DE","B",CLIEN)) D
85 .;enrolled at one time, check if discharged
86 .S EN=$O(^DPT(PIEN,"DE","B",CLIEN,""))
87 .S NODE=$G(^DPT(PIEN,"DE",EN,0))
88 .Q:NODE=""
89 .I $P(NODE,"^",3)="" S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name
90 .I $P(NODE,"^",3)'="",$P(NODE,"^",3)>DT S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name
91 Q
92 ;
93FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
94 ;CNAME - clinic name
95 ;PINF - patient/clinic data
96 ;PC - primary care 1/0
97 ;TIEN - team file ien (#404.51)
98 ;TNAME - team name
99 ;PRAC - practitioner ien (#200)
100 ;PNAME - practitioner name
101 ;POSN - position name
102 ;TPI - team position ien (#404.57)
103 ;PRCP - preceptor name
104 ;
105 N IIEN,INAME,ERR
106 S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
107 I ERR Q
108 ;
109 I SORT=1 D STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI) ;sort division,team,practitioner
110 I SORT=2 D STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI) ;sort division,practitioner,team
111 I SORT=3 D STOR(1,PRAC,1,PINF,PNAME,"T3",TPI)
112 Q
113 ;
114FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
115 ;CNAME - clinic name
116 ;PINF - patient/clinic data
117 ;PC - primary care 1/0
118 ;TIEN - team file ien (#404.51)
119 ;TNAME - team name
120 ;PRAC - practitioner ien (#200)
121 ;PNAME - practitioner name
122 ;POSN - position name
123 ;TPI - team position ien (#404.57)
124 ;PRCP - preceptor name
125 ;
126 N IIEN,INAME,ERR
127 S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
128 I ERR Q
129 ;
130 I SORT=1 D STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,team,practitioner
131 I SORT=2 D STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,practitioner,team
132 I SORT=3 D STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
133 Q
134 ;
135STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
136 ;IIEN - ien institution
137 ;SEC - second sort subscript, IEN team or IEN practitioner
138 ;TRD - third sort subscript, IEN team or IEN practitioner
139 ;PINF - patient/clinic info
140 ;PNAME - practitioner name
141 ;TNAME - team name
142 ;TPI - team position ien
143 ;
144 N PIEN,PTNAME,PID
145 S PIEN=+$P(PINF,"^") ;patient ien
146 S PTNAME=$E($P(PINF,"^",2),1,10) ;patient name
147 Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
148 S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
149 I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D
150 .;count each unique patient for any given practitioner for grand total
151 .S @STORE@("PTOT",IIEN,SEC,TRD,PIEN)=""
152 .S @STORE@("TOTAL",IIEN,PRAC,0)=$G(@STORE@("TOTAL",IIEN,PRAC,0))+1 ;patient count by practitioner
153 ;
154 S @STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI)=$G(@STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI))+1 ;patient count by practitioner and team
155 Q:SUMM
156 ;
157 S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
158 S PID=$P(PINF,"^",3),PID=$TR(PID,"-","")
159 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID ;ssn
160 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status
161 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility
162 ;Removed by patch 174
163 ;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status
164 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$P(PINF,"^",8) ;last appt
165 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$P(PINF,"^",9) ;nxt appt
166 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic
167 Q
168STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
169 I '$D(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT)) D
170 .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$P(PINF,"^",8) ;last appt
171 .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$P(PINF,"^",9) ;nxt appt
172 .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$E(CNAME,1,15) ;clinic
173 .Q
174 Q
Note: See TracBrowser for help on using the repository browser.