1 | SCRPEC3 ;ALB/CMM - Detail List of Pts & Enroll Clinics ; 29 Jun 99 04:11PM
|
---|
2 | ;;5.3;Scheduling;**41,48,52,177**;AUG 13, 1993
|
---|
3 | ;
|
---|
4 | ;Detailed Listing of Patients and Their Enrolled Clinics Report
|
---|
5 | ;
|
---|
6 | FIND ;
|
---|
7 | N TIEN,OKAY,PTLIST,ERR
|
---|
8 | I TEAM=1 D TALL^SCRPPAT3 ;get all teams for all divisions selected
|
---|
9 | S TIEN=0,PTLIST="^TMP(""SCLIST"","_$J_")",ERR="ERROR"
|
---|
10 | K @PTLIST
|
---|
11 | F S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N) D
|
---|
12 | .K @PTLIST,@ERR
|
---|
13 | .S OKAY=$$PTTM^SCAPMC2(TIEN,"",.PTLIST,.ERR)
|
---|
14 | .Q:'OKAY
|
---|
15 | .D PAT^SCRPEC2(TIEN,.PTLIST)
|
---|
16 | K @PTLIST
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | PRINTIT(STORE,TITL) ;
|
---|
20 | ;print title
|
---|
21 | N INS,EINST,ETEAM,TEAM,ECLN,CLINIC,PAGE,FIRST,PTIEN,PTNAME,CH2
|
---|
22 | S (CH2,PAGE)=1,STOP=0
|
---|
23 | W:$E(IOST)="C" @IOF
|
---|
24 | D TITLE^SCRPU3(.PAGE,TITL,132)
|
---|
25 | S (INS,EINST)=""
|
---|
26 | S FIRST=0
|
---|
27 | F S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP) D
|
---|
28 | .S INS=$O(@STORE@("I",EINST,INS))
|
---|
29 | .Q:INS=""
|
---|
30 | .I FIRST,IOST'?1"C-".E D NEWP1^SCRPU3(.PAGE,TITL,132)
|
---|
31 | .I FIRST,IOST?1"C-".E D HOLD^SCRPU3(.PAGE,TITL,132)
|
---|
32 | .Q:STOP
|
---|
33 | .I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132)
|
---|
34 | .I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132)
|
---|
35 | .Q:STOP!INS=""
|
---|
36 | .W !,$G(@STORE@(INS)) ;write institution
|
---|
37 | .S FIRST=1
|
---|
38 | .S (ETEAM,TEAM)=""
|
---|
39 | .F S ETEAM=$O(@STORE@("T",INS,ETEAM)) Q:ETEAM=""!(STOP) D
|
---|
40 | ..S TEAM=$O(@STORE@("T",INS,ETEAM,""))
|
---|
41 | ..I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)) D CHEAD^SCRPEC2(INS,TEAM,CLINIC)
|
---|
42 | ..I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)) D CHEAD^SCRPEC2(INS,TEAM,CLINIC)
|
---|
43 | ..I STOP Q
|
---|
44 | ..W !!,$G(@STORE@(INS,TEAM)) W ! D CH2^SCRPEC2 ;write team
|
---|
45 | ..S (ECLN,CLINIC)=0
|
---|
46 | ..F S ECLN=$O(@STORE@("C",INS,TEAM,ECLN)) Q:ECLN=""!(STOP) D
|
---|
47 | ...S CLINIC=$O(@STORE@("C",INS,TEAM,ECLN,""))
|
---|
48 | ...S PTNAME=""
|
---|
49 | ...F S PTNAME=$O(@STORE@("PT",INS,TEAM,CLINIC,PTNAME)) Q:PTNAME=""!(STOP) D
|
---|
50 | ....S PTIEN=$O(@STORE@("PT",INS,TEAM,CLINIC,PTNAME,""))
|
---|
51 | ....I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132) Q:STOP W !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)) D CHEAD^SCRPEC2(INS,TEAM,CLINIC)
|
---|
52 | ....I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132) Q:STOP W !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)) D CHEAD^SCRPEC2(INS,TEAM,CLINIC)
|
---|
53 | ....Q:STOP
|
---|
54 | ....W !,$G(@STORE@(INS,TEAM,CLINIC,PTIEN))
|
---|
55 | I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
|
---|
56 | Q
|
---|