| 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
 | 
|---|