| [613] | 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
|
|---|
