source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPPAT3.m@ 1535

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

initial load of FOIAVistA 6/30/08 version

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