source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPEC3.m@ 1141

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1SCRPEC3 ;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 ;
6FIND ;
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 ;
19PRINTIT(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
Note: See TracBrowser for help on using the repository browser.