source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT.m@ 1147

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1SCRPPAT ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:17pm
2 ;;5.3;Scheduling;**41,52,177,297**;AUG 13, 1993
3 ;
4 ;Listing of Practitioner's Patients
5 ;
6PROMPTS ;
7 ;Prompt for division, team, role, practitioner, summary only and print device
8 ;
9 N QTIME,PRNT,VAUTP,Y,VAUTD,VAUTT,VAUTR,VAUTS,SORT,NUMBER
10 K SCUP
11 S QTIME=""
12 W ! D INST^SCRPU1 I Y=-1 G ERR
13 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR
14 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR
15 W ! D PRACT^SCRPU1 I '$D(VAUTP) G ERR
16 W ! S VAUTS=$$SUMM^SCRPU2() I VAUTS<0 G ERR
17 W ! S SORT=$$SORT^SCRPU2() I SORT<1 G ERR
18 S PRNT=$$PDEVICE^SCRPU3()
19 I PRNT=-1 G ERR
20 I PRNT["Q;" S QTIME=$$GETTIME^SCRPU3()
21 I QTIME=-1 G ERR
22 I PRNT'?1"Q;".E S PRNT="Q;"_PRNT
23 S NUMBER=$$ENTRY2(.VAUTD,.VAUTT,.VAUTR,.VAUTP,VAUTS,SORT,PRNT,QTIME)
24 I NUMBER>0 W !!,"Print queued, task number: ",NUMBER
25 Q
26 D QUE(.VAUTD,.VAUTT,.VAUTR,.VAUTP,VAUTS,SORT) Q
27 ;
28QUE(INST,TEAM,ROLE,PRACT,SUMM,SORT) ;queue report
29 ;Input Parameters:
30 ;INST - institutions selected (variable and array)
31 ;TEAM - teams selected (variable and array)
32 ;ROLE - roles selected (variable and array)
33 ;PRACT - practitioners selected (variable and array)
34 ;SUMM - summary info? y/n (1-yes/0-no) yes don't print patient data
35 ;SORT - sort criteria (1-d,t,p/2-d,p,t)
36 N ZTSAVE,II
37 F II="INST","INST(","TEAM","TEAM(","ROLE","ROLE(","PRACT(","PRACT","SUMM","SORT" S ZTSAVE(II)=""
38 W ! D EN^XUTMDEVQ("QENTRY^SCRPPAT","Practitioner's Patients",.ZTSAVE)
39 Q
40 ;
41ENTRY2(INST,TEAM,ROLE,PRACT,SUMM,SORT,IOP,ZTDTH) ;
42 ;Second entry point for GUI to use
43 ;Input Parameters:
44 ;INST - institutions selected (variable and array)
45 ;TEAM - teams selected (variable and array)
46 ;ROLE - roles selected (variable and array)
47 ;PRACT - practitioners selected (ien new person file) - (variable and array)
48 ;SUMM - summary info? y/n (1-yes/0-no) yes don't print patient data
49 ;SORT - sort criteria (1-d,t,p/2-d,p,t)
50 ;IOP - print device
51 ;ZTDTH - queue time (optional)
52 ;
53 ;validate parameters
54 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(PRACT)!'$D(SUMM)!'$D(SORT)!'$D(IOP)!(IOP="") Q
55 ;
56 N NUMBER
57 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
58 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
59 I IOST?1"C-".E D QENTRY G RET
60 I ZTDTH="" S ZTDTH=$H
61 S ZTRTN="QENTRY^SCRPPAT"
62 S ZTDESC="Practitioner's Patients",ZTIO=IOP
63 N II
64 F II="IOSL","INST","INST(","TEAM","TEAM(","ROLE","ROLE(","PRACT(","PRACT","SUMM","IOP","SORT" S ZTSAVE(II)=""
65 D ^%ZTLOAD
66RET S NUMBER=0
67 I $D(ZTSK) S NUMBER=ZTSK
68 D EXIT1
69 Q NUMBER
70 ;
71QENTRY ;
72 ;driver entry point
73 S TITL="Practitioner's Patients"
74 I SUMM S TITL=TITL_" Summary Report"
75 S STORE="^TMP("_$J_",""SCRPPAT"")"
76 K @STORE
77 S @STORE=0
78 D DRIVE^SCRPPAT2
79 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
80 I '$D(NODATA) D PRINTIT(STORE,IOP,TITL,SORT)
81 D EXIT2
82 Q
83 ;
84ERR ;
85EXIT1 ;
86 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,VAUTD,VAUTT,VAUTP,VAUTR
87 K SCUP,VAUTS,SORT
88 Q
89 ;
90EXIT2 ;
91 K @STORE
92 K STORE,TITL,IOP,PRACT,INST,TEAM,ROLE,SORT,SUMM,NODATA,STOP
93 Q
94 ;
95PRINTIT(STORE,IOP,TITL,SORT) ; Print All Data
96 ;STORE - global location of data
97 ;IOP - device to print to
98 ;TITL - title of report
99 ;SORT - sort order 1-div,team,pract/2-div,pract,team
100 ;
101 N PAGE
102 S PAGE=1,STOP=0 W:$E(IOST)="C" @IOF
103 N SEC1,SEC2,SEC2,SEC3,SEC4,ST1,ST2,ST3,ST4
104 I SORT=1 S SEC1="""T""",SEC2="""P""",SEC3="""TN""",SEC4="""PN"""
105 I SORT=2!(SORT=3) S SEC1="""P""",SEC2="""T""",SEC3="""PN""",SEC4="""TN"""
106 ;I SORT=3 S SEC4=SEC3,SEC3="""TN"""
107 N SEC,TRD,INS,INAME,SECN,TRDN,PT,FIRST
108 S (INAME,INS)="",FIRST=1
109 F S INAME=$O(@STORE@("I",INAME)) Q:INAME=""!(STOP) D
110 .S INS=$O(@STORE@("I",INAME,""))
111 .Q:INS=""!STOP
112 .D S
113 ;I SORT=3 D
114 ;.N I F I=0:0 S I=$O(@STORE@("P",I)) Q:'I D
115 ;..S A="" F S A=$O(@STORE@("P",I,A)) Q:A="" S @STORE@("P1",A,$O(@STORE@("P",I,A,0)))=""
116 ;.F S INAME=$O(@STORE@("P1",INAME)) Q:INAME=""!(STOP) D
117 ;..S INS=$O(@STORE@("P1",INAME,""))
118 ;..Q:INS=""!STOP
119 ;..D S W !,STORE,!,ST1 R XXX
120 D S1
121 Q
122S ;
123 S SECN="",ST1=$E(STORE,1,($L(STORE)-1))_","_SEC1_")"
124 F S SECN=$O(@ST1@(INS,SECN)) Q:SECN=""!(STOP) D
125 .S SEC=$O(@ST1@(INS,SECN,"")) ;ien of team or practitioner
126 .Q:SEC=""
127 .S ST3=$E(STORE,1,($L(STORE)-1))_","_SEC3_")"
128 .S TRDN="",ST2=$E(STORE,1,($L(STORE)-1))_","_SEC2_")"
129 .F S TRDN=$O(@ST2@(INS,TRDN)) Q:TRDN=""!(STOP) D
130 ..S TRD=$O(@ST2@(INS,TRDN,"")) ;ien of team or practitioner
131 ..Q:TRD=""
132 ..;have first team and first practitioner ien
133 ..S ST4=$E(STORE,1,($L(STORE)-1))_","_SEC4_")"
134 ..D PRNT(ST4,ST3,SEC3,.PAGE,TITL,INS,SEC,TRD) Q:STOP
135 Q
136S1 I $E(IOST)="C",'STOP W ! N DIR S DIR(0)="E" D ^DIR S STOP=Y'=1
137 I 'STOP,SUMM=0 S (FIRST,SUMM)=1,TITL=TITL_" Summary Report" W @IOF D PRINTIT(STORE,$G(IOP),TITL,SORT)
138 Q
139 ;
140PRNT(ST4,ST3,SEC3,PAGE,TITL,INS,SEC,TRD) ;
141 ;
142 N POS
143 I (SEC3="""PN""")&($D(@ST3@(INS,SEC,TRD))) D
144 .;get each position for practitioner
145 .N MORE S POS="",MORE=0
146 .F S POS=$O(@ST3@(INS,SEC,TRD,POS)) Q:POS=""!(STOP) D
147 ..I 'SUMM I SORT=3 D Q
148 ...;I MORE ;S FIRST=0
149 ...K @STORE@("H1") D SHEAD^SCRPPAT3
150 ...I 'MORE I (PAGE=1)!(IOST?1"C-".E) D TITLE^SCRPU3(.PAGE,TITL)
151 ...I 'MORE W !,$G(@ST3@(INS,SEC,TRD,POS)),!
152 ...D PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS) S MORE=1
153 ...I $O(@ST3@(INS,SEC,TRD,POS))="" D
154 ....I (IOST?1"C-".E) D HOLD(.PAGE,"") S PAGE=PAGE+1 Q:STOP
155 ....I (IOST'?1"C-".E) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP
156 ..I SUMM D Q
157 ...I FIRST D TITLE^SCRPU3(.PAGE,TITL),SHEAD^SCRPPAT3,SSH S FIRST=0
158 ...I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP D SSH
159 ...I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP D SSH
160 ...W !,@STORE@("SUM0",INS,SEC,TRD,POS)
161 ...W ?72,$J($G(@STORE@("TOTAL",INS,SEC,TRD,POS)),8)
162 ...Q
163 ..Q:SORT=3
164 ..I FIRST D:'MORE TITLE^SCRPU3(.PAGE,TITL) D SHEAD^SCRPPAT3
165 ..I (IOST'?1"C-".E),'SUMM,'FIRST D NEWP1^SCRPU3(.PAGE,TITL) W:'STOP !,$G(@STORE@(INS))
166 ..I (IOST?1"C-".E),'SUMM,'FIRST D HOLD^SCRPU3(.PAGE,TITL) W:'STOP !,$G(@STORE@(INS))
167 ..Q:STOP S FIRST=1 I 'MORE S FIRST=0
168 ..W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write practitioner (sort 1)
169 ..I $L($G(@ST3@(INS,SEC,TRD,POS,"PRCP"))) W !,@ST3@(INS,SEC,TRD,POS,"PRCP")
170 ..I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD)) ;write team (sort 2)
171 ..W !,$G(@STORE@(INS))
172 ..;$o through patients for practitioner on team
173 ..D PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS) Q:STOP
174 ..I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP
175 ..I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP
176 ..D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) ;print team/practitioner total
177 ;
178 I (SEC3="""TN""")&($D(@ST4@(INS,TRD,SEC))) D
179 .S POS=""
180 .F S POS=$O(@ST4@(INS,TRD,SEC,POS)) Q:POS=""!(STOP) D
181 ..I SUMM D Q
182 ...I FIRST D TITLE^SCRPU3(.PAGE,TITL),SHEAD^SCRPPAT3,SSH S FIRST=0
183 ...I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP D SSH
184 ...I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP D SSH
185 ...W !,@STORE@("SUM0",INS,TRD,SEC,POS)
186 ...W ?72,$J(@STORE@("TOTAL",INS,TRD,SEC,POS),8)
187 ...Q
188 ..I FIRST D TITLE^SCRPU3(.PAGE,TITL),SHEAD^SCRPPAT3
189 ..I (IOST'?1"C-".E),'SUMM,'FIRST D NEWP1^SCRPU3(.PAGE,TITL)
190 ..I (IOST?1"C-".E),'SUMM,'FIRST D HOLD^SCRPU3(.PAGE,TITL)
191 ..Q:STOP S FIRST=0
192 ..I $G(SORT)'=3 W !,$G(@ST3@(INS,SEC)) ;write team (sort 1)
193 ..W !,$G(@STORE@(INS))
194 ..I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write practitioner (sort 2)
195 ..I $L($G(@ST4@(INS,TRD,SEC,POS,"PRCP"))) W !,@ST4@(INS,TRD,SEC,POS,"PRCP")
196 ..W !
197 ..;$o through patients for practitioner on team
198 ..D PAT^SCRPPAT3(INS,SEC,TRD,SEC3,ST3,ST4,POS) Q:STOP
199 ..I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL) Q:STOP
200 ..I (IOST?1"C-".E),$Y>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) Q:STOP
201 ..D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) ;print team/practitioner total
202 Q
203 ;
204SSH ;Summary subheader
205 W !?72,"Patients",!,"Practitioner",?24,"Position",?48,"Team"
206 W ?72,"Assigned",! N SCI F SCI=1:1:80 W "="
207 Q
208HOLD(PAGE,TIT,MARG) ;
209 ;device is home, reached end of page
210 N X
211 S MARG=$G(MARG) S:MARG'>80 MARG=80
212 W !!,"Press Any Key to Continue or '^' to Quit" R X:DTIME
213 I '$T!(X="^") S STOP=1 Q
214 W @IOF
215 Q
Note: See TracBrowser for help on using the repository browser.