source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT3.m@ 1211

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

revised back to 6/30/08 version

File size: 4.9 KB
Line 
1SCRPPAT3 ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:14pm
2 ;;5.3;Scheduling;**41,52,148,174,181,177,297**;AUG 13, 1993
3 ;
4 ;Listing of Practitioner's Patients
5 ;
6PAT(INS,SEC,TRD,SEC3,ST3,ST4,POS) ;
7 ;writes patients for position/practitioner
8 N PTN,PT,FIRST
9 S PTN="",FIRST=1
10 I SUMM D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) Q ;Summary only
11 F S PTN=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN)) Q:PTN=""!(STOP) D
12 .S PT=0
13 .F S PT=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN,PT)) Q:'PT!(STOP) D
14 ..I (IOST'?1"C-".E),$Y>(IOSL-5) S MORE=0 D NEWP1^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:(('FIRST&'STOP)!($G(SORT)=3)) HEADER
15 ..I (IOST?1"C-".E),$Y>(IOSL-5) S MORE=0 D HOLD^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:'FIRST&'STOP HEADER
16 ..Q:STOP
17 ..I FIRST D HEADER S FIRST=0
18 ..W !,$G(@STORE@(INS,SEC,TRD,POS,PT)) ;print patient detail line
19 ..Q
20 .Q
21 Q
22 ;
23SPRINT(STORE,IOP,TITL,SORT) ; Summary Print Only
24 ;STORE - global location of data
25 ;IOP - device to print to
26 ;TITL - title of report
27 ;SORT - sort order 1-div,team,pract/2-div,pract,team
28 ;
29 N PAGE
30 S PAGE=1,STOP=0
31 D OPEN^SCRPU3
32 Q:$G(POP)
33 D TITLE^SCRPU3(.PAGE,TITL)
34 D CLOSE^SCRPU3
35 Q
36 ;
37TOTAL1(INS,SEC,TRD,POS) ;
38 ;print team/practitioner total
39 N TEM,PRC
40 I SORT=1 S TEM=SEC,PRC=TRD
41 I SORT=2!(SORT=3) S TEM=TRD,PRC=SEC
42 W !!,$G(@STORE@("TH",INS,PRC,TEM,POS)),$G(@STORE@("TOTAL",INS,PRC,TEM,POS))
43 Q
44 ;
45HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) ;
46 I (SEC3="""TN""")&($D(@ST4@(INS,TRD,SEC))) D
47 .W !,$G(@ST3@(INS,SEC)) ;write team (sort 1)
48 .W !,$G(@STORE@(INS))
49 .W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write practitioner (sort 2)
50 .I $L($G(@STORE@("PN",INS,TRD,SEC,POS,"PRCP"))) W !,@STORE@("PN",INS,TRD,SEC,POS,"PRCP")
51 .W !
52 I (SEC3="""PN""")&($D(@ST3@(INS,SEC,TRD))) D
53 .W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write practitioner (sort 1)
54 .I $G(SORT)'=3 I $L($G(@STORE@("PN",INS,SEC,TRD,POS,"PRCP"))) W !,@STORE@("PN",INS,SEC,TRD,POS,"PRCP")
55 .I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD)) ;write team (sort 2)
56 .W !,$G(@STORE@(INS))
57 Q
58 ;
59HEADER ;
60 Q:$G(MORE)
61 I SORT=3 S MORE=1
62 N NXT
63 F NXT="H1","H2","H3" W !,$G(@STORE@(NXT))
64 W !
65 Q
66 ;
67SHEAD ;
68 S @STORE@("H2")="Pt Name"
69 S $E(@STORE@("H2"),18)="Pt ID"
70 S $E(@STORE@("H1"),25)="M.T."
71 S $E(@STORE@("H2"),25)="Stat"
72 S $E(@STORE@("H1"),31)="Prim"
73 S $E(@STORE@("H2"),31)="Elig"
74 ;Removed by patch 174
75 ;S $E(@STORE@("H1"),39)="Pat"
76 ;S $E(@STORE@("H2"),39)="Stat"
77 S $E(@STORE@("H1"),42)="Last"
78 S $E(@STORE@("H2"),42)="Appt"
79 S $E(@STORE@("H1"),54)="Next"
80 S $E(@STORE@("H2"),54)="Appt"
81 S $E(@STORE@("H2"),66)="Clinic"
82 S $P(@STORE@("H3"),"=",81)=""
83 Q
84ALL ;
85 ;get all practitioners for all teams selected
86 I TEAM=1 D TALL ;all teams selected
87 N TIEN,OKAY,XLIST,YLIST,SCTP,SCI,SCDT
88 S TIEN=""
89 F S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N) D
90 .I $D(TEAM(TIEN)) D
91 ..K XLIST
92 ..S OKAY=$$TPTM^SCAPMC(TIEN,"","","","XLIST","ERROR")
93 ..S SCTP=0 F S SCTP=$O(XLIST("SCTP",TIEN,SCTP)) Q:'SCTP D
94 ...K YLIST S SCDT="SCDT",(SCDT("BEGIN"),SCDT("END"))=DT,SCDT("INCL")=0
95 ...S OKAY=$$PRTP^SCAPMC(SCTP,.SCDT,"YLIST","ERROR",1,0)
96 ...S SCI=0 F S SCI=$O(YLIST(SCI)) Q:'SCI D
97 ....S @TPRC@(0)=$G(@TPRC@(0))+1
98 ....S @TPRC@(@TPRC@(0))=YLIST(SCI)
99 Q
100 ;
101TALL ;
102 ;get all active team for divisions selected
103 N NXT,IIEN,NODE
104 S NXT=0,IIEN=""
105 ;$O through team file and find all active teams for selected divisions
106 F S IIEN=$O(^SCTM(404.51,"AINST",IIEN)) Q:IIEN="" D
107 .I INST=1!$D(INST(IIEN)) D
108 ..S TIEN=0
109 ..F S TIEN=$O(^SCTM(404.51,"AINST",IIEN,TIEN)) Q:TIEN="" D
110 ...I $$ACTTM^SCMCTMU(TIEN) S TEAM(TIEN)=""
111 Q
112 ;
113SETUP(IIEN,INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ;
114 ;setup data
115 S IIEN=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien
116 S INAME=$P($G(^DIC(4,IIEN,0)),"^") ;institution name
117 I INAME="" S INAME="[BAD DATA]"
118 ;
119 I PNAME="" S PNAME="[BAD DATA]"
120 I TNAME="" S TNAME="[BAD DATA]"
121 I $G(SORT)=3 S IIEN=1,TIEN=1
122 I '$D(@STORE@("PN",IIEN,PRAC,TIEN,TPI)) S @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Practitioner: "_PNAME_$S(SORT=3:"",1:" ("_POSN_")")
123 I $L(PRCP) S @STORE@("PN",IIEN,PRAC,TIEN,TPI,"PRCP")=" Preceptor: "_PRCP
124 I '$D(@STORE@("TN",IIEN,$S($G(SORT)=3:1,1:TIEN))) S @STORE@("TN",IIEN,$S($G(SORT)=3:1,1:TIEN))=" Team: "_TNAME
125 ;
126 I '$D(@STORE@("I",$S($G(SORT)=3:"S3",1:INAME),IIEN)) S @STORE@("I",$S($G(SORT)=3:"S3",1:INAME),IIEN)="",@STORE@(IIEN)=$S(SORT=3:"",1:" Division: "_INAME)
127 S @STORE@("T",IIEN,$S($G(SORT)=3:"T3",1:TNAME),$S($G(SORT)=3:1,1:TIEN))=""
128 I '$D(@STORE@("P",IIEN,PNAME,PRAC,TPI)) S @STORE@("P",IIEN,PNAME,PRAC,TPI)=""
129 I '$D(@STORE@("TOTAL",IIEN,PRAC,0)) S @STORE@("TOTAL",IIEN,PRAC,0)=0
130 I '$D(@STORE@("TOTAL",IIEN,PRAC,TIEN)) S @STORE@("TOTAL",IIEN,PRAC,TIEN)=0
131 ;
132 S @STORE@("TH",IIEN,PRAC)="Patient Count for "_PNAME_": "
133 S @STORE@("TH",IIEN,PRAC,TIEN,TPI)="Patient Count for "_PNAME_": "
134 N SCX
135 S SCX=$E(PNAME,1,22),$E(SCX,25)=$E(POSN,1,22),$E(SCX,49)=$E(TNAME,1,22)
136 S @STORE@("SUM0",IIEN,PRAC,TIEN,TPI)=SCX
137 ;
138 S @STORE@("TH",IIEN)="** Note: Patient Panel Count is a count of unique patients for each practitioner"
139 Q 0
Note: See TracBrowser for help on using the repository browser.