SCRPEC3 ;ALB/CMM - Detail List of Pts & Enroll Clinics ; 29 Jun 99  04:11PM
 ;;5.3;Scheduling;**41,48,52,177**;AUG 13, 1993
 ;
 ;Detailed Listing of Patients and Their Enrolled Clinics Report
 ;
FIND ;
 N TIEN,OKAY,PTLIST,ERR
 I TEAM=1 D TALL^SCRPPAT3 ;get all teams for all divisions selected
 S TIEN=0,PTLIST="^TMP(""SCLIST"","_$J_")",ERR="ERROR"
 K @PTLIST
 F  S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N)  D
 .K @PTLIST,@ERR
 .S OKAY=$$PTTM^SCAPMC2(TIEN,"",.PTLIST,.ERR)
 .Q:'OKAY
 .D PAT^SCRPEC2(TIEN,.PTLIST)
 K @PTLIST
 Q
 ;
PRINTIT(STORE,TITL) ;
 ;print title
 N INS,EINST,ETEAM,TEAM,ECLN,CLINIC,PAGE,FIRST,PTIEN,PTNAME,CH2
 S (CH2,PAGE)=1,STOP=0
 W:$E(IOST)="C" @IOF
 D TITLE^SCRPU3(.PAGE,TITL,132)
 S (INS,EINST)=""
 S FIRST=0
 F  S EINST=$O(@STORE@("I",EINST)) Q:EINST=""!(STOP)  D
 .S INS=$O(@STORE@("I",EINST,INS))
 .Q:INS=""
 .I FIRST,IOST'?1"C-".E D NEWP1^SCRPU3(.PAGE,TITL,132)
 .I FIRST,IOST?1"C-".E D HOLD^SCRPU3(.PAGE,TITL,132)
 .Q:STOP
 .I IOST'?1"C-".E,$Y>(IOSL-5) D NEWP1^SCRPU3(.PAGE,TITL,132)
 .I IOST?1"C-".E,$Y>(IOSL-5) D HOLD^SCRPU3(.PAGE,TITL,132)
 .Q:STOP!INS=""
 .W !,$G(@STORE@(INS)) ;write institution
 .S FIRST=1
 .S (ETEAM,TEAM)=""
 .F  S ETEAM=$O(@STORE@("T",INS,ETEAM)) Q:ETEAM=""!(STOP)  D
 ..S TEAM=$O(@STORE@("T",INS,ETEAM,""))
 ..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)
 ..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)
 ..I STOP Q
 ..W !!,$G(@STORE@(INS,TEAM)) W ! D CH2^SCRPEC2 ;write team
 ..S (ECLN,CLINIC)=0
 ..F  S ECLN=$O(@STORE@("C",INS,TEAM,ECLN)) Q:ECLN=""!(STOP)  D
 ...S CLINIC=$O(@STORE@("C",INS,TEAM,ECLN,""))
 ...S PTNAME=""
 ...F  S PTNAME=$O(@STORE@("PT",INS,TEAM,CLINIC,PTNAME)) Q:PTNAME=""!(STOP)  D
 ....S PTIEN=$O(@STORE@("PT",INS,TEAM,CLINIC,PTNAME,""))
 ....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)
 ....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)
 ....Q:STOP
 ....W !,$G(@STORE@(INS,TEAM,CLINIC,PTIEN))
 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
 Q