source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPTP.m@ 731

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1SCRPTP ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,48,174,177,526,520**;AUG 13, 1993;Build 26
3 ;
4PROMPTS ;Prompt for Institution, Team, Role, Patient Status and Print device
5 N QTIME,PRNT,VAUTD,VAUTT,VAUTR,VAUTPS,NUMBER
6 K SCUP
7 S QTIME=""
8 W ! D INST^SCRPU1 I Y=-1 G ERR
9 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR
10 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR
11 W ! K Y D PTSTAT^SCRPU2 I '$D(VAUTPS) G ERR
12 W ! K Y S SORT=$$SORT2^SCRPU2()
13 I SORT<1 G ERR
14 W !!,"This report requires 132 column output!"
15 D QUE(.VAUTD,.VAUTT,.VAUTR,VAUTPS,SORT) Q
16 ;
17QUE(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;queue report
18 ;INST - institutions selected (variable and array)
19 ;TEAM - teams selected (variable and array)
20 ;ROLE - roles selected (variable and array)
21 ;PSTAT - patient status - 1=all or OPT or AC
22 ;SORT - 1=d,t,ptname 2=d,t,Pt ID 3=d,t,pract,pt name 4=d,t,pract,Pt ID
23 N ZTSAVE,II
24 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(" S ZTSAVE(II)=""
25 W ! D EN^XUTMDEVQ("QENTRY^SCRPTP","Team Patient Listing",.ZTSAVE)
26 Q
27 ;
28ENTRY2(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;Second entry point for GUI to use
29 ;INST - institutions selected (variable and array)
30 ;TEAM - teams selected (variable and array)
31 ;ROLE - roles selected (variable and array)
32 ;PSTAT - patient status - 1=all or OPT or AC
33 ;SORT - 1=d,t,ptname 2=d,t,Pt ID 3=d,t,pract,pt name 4=d,t,pract,Pt ID
34 ;IOP - print device
35 ;ZTDTH - queue time (optional)
36 ;
37 ;validate parameters
38 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(PSTAT)!'$D(SORT)!'$D(IOP)!(IOP="") Q
39 N NUMBER
40 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
41 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
42 I IOST?1"C-".E D QENTRY G RET
43 I ZTDTH="" S ZTDTH=$H
44 S ZTRTN="QENTRY^SCRPTP"
45 S ZTDESC="List of Team's Patients",ZTIO=IOP
46 N II
47 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(","IOP" S ZTSAVE(II)=""
48 D ^%ZTLOAD
49RET S NUMBER=0
50 I $D(ZTSK) S NUMBER=ZTSK
51 D EXIT1
52 Q NUMBER
53 ;
54QENTRY ;driver entry point
55 S TITL="Team Patient Listing",STORE="^TMP("_$J_",""SCRPTP"")"
56 K @STORE
57 S @STORE=0
58 D FIND
59 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
60 I '$D(NODATA) D PRINTIT^SCRPTP2(STORE,TITL)
61 D EXIT2
62 Q
63ERR ;
64EXIT1 ;
65 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP
66 Q
67EXIT2 ;
68 K @STORE
69 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,PSTAT,SORT,NODATA
70 Q
71FIND ;
72 N TIEN,ERR,LIST,OKAY
73 I TEAM=1 D TALL^SCRPPAT3 ;gets all teams for all divisions selected
74 S TIEN="",LIST="^TMP("_$J_",""SCRPTP ARRAY"")",ERR="ERROR"
75 K @LIST,@ERR
76 F S TIEN=$O(TEAM(TIEN)) Q:TIEN="" D
77 .;TIEN - team ien
78 .S OKAY=$$PTTM^SCAPMC2(TIEN,"",LIST,ERR)
79 .; gets all patients for given team
80 .D HITS^SCRPTP3(LIST,TIEN)
81 .K @LIST,@ERR
82 K @LIST,@ERR
83 Q
84TINF(TIEN) ;team information
85 ;TIEN - team ien
86 ;returns: institution ien ^ team name ^ primary care ^ team phone
87 N PC,PHONE,TNODE,TNAME
88 S TNODE=$G(^SCTM(404.51,TIEN,0))
89 S TNAME=$P(TNODE,"^") ;team name
90 S PC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care team
91 S PHONE=$P(TNODE,"^",2) ;team phone
92 S INS=+$P(TNODE,"^",7) ;institution ien
93 D TDESC^SCRPITP2(TIEN,INS) ;gets team description
94 Q INS_"^"_TNAME_"^"_PC_"^"_PHONE
95 ;
96PST(PTIEN,CLIEN) ;
97 ;PTIEN - patient ien
98 ;CLIEN - associated clinic ien
99 ;returns 1=selected patient status, 0=not selected patient status
100 ;
101 N EN,NXT,FOUND,ENODE
102 S EN="",(FOUND,NXT)=0
103 Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND
104 S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,""))
105 I EN=""&(PSTAT=1) S FOUND=1 Q FOUND
106 Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND
107 F S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N) D
108 .;check if active enrollment
109 .S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0))
110 .I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q ;not active enrollment
111 .; ^ discharge date ^ enrollment date
112 .Q:$P(ENODE,"^",2)'=$E(PSTAT,1)&(PSTAT'=1) ;not selected patient status
113 .S FOUND=1
114 Q FOUND
115 ;
116FORMAT(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,PINF,ROLN,PCAP) ;Format column information
117 ;INS - Institution ien
118 ;TIEN - team ien
119 ;PTIEN - patient ien
120 ;PTNAME - patient name
121 ;PID - SSN
122 ;PIEN - practitioner ien
123 ;PNAME - practitioner name
124 ;CNAME - clinic name
125 ;LAST - last appointment
126 ;NEXT - next appointment
127 ;ROLN - role name
128 ;PCAP - PC?
129 ;
130 N SEC,TRD
131 I PNAME="" S PNAME="[BAD DATA]"
132 I PTNAME="" S PTNAME="[BAD DATA]"
133 I PID="" S PID="*********"
134 S @STORE@("P",INS,TIEN,PNAME,PIEN)="" ;practitioner
135 S @STORE@("PT",INS,TIEN,PTNAME,PTIEN)="" ;patient
136 S @STORE@("PID",INS,TIEN,PID,PTIEN)=""
137 I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner
138 I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner
139 S @STORE@(INS,TIEN,SEC,TRD)=$E(PTNAME,1,15) ;patient name
140 S $E(@STORE@(INS,TIEN,SEC,TRD),18)=PID ;9 digit pid
141 S $E(@STORE@(INS,TIEN,SEC,TRD),32)=$E(PNAME,1,22) ;practitioner name
142 S $E(@STORE@(INS,TIEN,SEC,TRD),56)=$E($G(ROLN),1,22) ;role name
143 S $E(@STORE@(INS,TIEN,SEC,TRD),80)=$G(PCAP) ;PC?
144 S $E(@STORE@(INS,TIEN,SEC,TRD),85)=$P(PINF,"^",8) ;last appointment
145 S $E(@STORE@(INS,TIEN,SEC,TRD),97)=$P(PINF,"^",9) ;next appointment
146 S $E(@STORE@(INS,TIEN,SEC,TRD),109)=$E(CNAME,1,24) ;clinic name
147 Q
148FORMATAC(SCCNT,CNAME,PINF,INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,ROLN,PCAP) ;Format MULTIPLES
149 ;INS - Institution ien
150 ;TIEN - team ien
151 ;PTIEN - patient ien
152 ;PTNAME - patient name
153 ;PID - last 4 PID - includes pseudo notation as 5th
154 ;PIEN - practitioner ien
155 ;PNAME - practitioner name
156 ;CNAME - clinic name
157 ;LAST - last appointment
158 ;NEXT - next appointment
159 ;ROLN - role name
160 ;PCAP - PC?
161 ;
162 N SEC,TRD
163 I PNAME="" S PNAME="[BAD DATA]"
164 I PTNAME="" S PTNAME="[BAD DATA]"
165 I PID="" S PID="****"
166 S @STORE@("P",INS,TIEN,PNAME,PIEN)="" ;practitioner
167 S @STORE@("PT",INS,TIEN,PTNAME,PTIEN)="" ;patient
168 S @STORE@("PID",INS,TIEN,PID,PTIEN)="" ;last 4 pid
169 N TRD
170 I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner
171 I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner
172 I '$D(@STORE@(INS,TIEN,SEC,TRD,SCCNT)) D
173 .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),85)=$P(PINF,"^",8) ;last appointment
174 .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),97)=$P(PINF,"^",9) ;next appointment
175 .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),109)=$E(CNAME,1,24) ;clinic name
176 .Q
177 Q
Note: See TracBrowser for help on using the repository browser.