source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPEC2.m@ 1621

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

WorldVistAEHR overlayed on FOIAVistA

File size: 5.4 KB
Line 
1SCRPEC2 ;ALB/CMM - Detail List of Pts & Enroll Clinics Continued ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,140,174,177**;AUG 13, 1993
3 ;
4 ;Detailed Listing of Patients and Their Enrolled Clinics Report
5 ;
6PAT(TIEN,PTLIST) ;
7 ;TIEN - team ien
8 ;PTLIST - array holding patients assigned to team TIEN
9 ;
10 N PTIEN,ENT,NODE,OKAY,CLLIST,ERR,PC
11 S ENT=0,CLLIST="LIST2",ERR="ERROR2"
12 K @CLLIST
13 F S ENT=$O(@PTLIST@(ENT)) Q:ENT=""!(ENT'?.N) D
14 .S NODE=$G(@PTLIST@(ENT))
15 .Q:NODE=""
16 .S PTIEN=+$P(NODE,"^") ;patient ien
17 .S PC=$$PCASSIGN(PTIEN,TIEN)
18 .Q:PC'=ASSUN ;not selected assigned/unassigned primary care
19 .K @CLLIST
20 .S OKAY=$$CLPT^SCAPMC29(PTIEN,"","",.CLLIST,.ERR)
21 .;all clinics for patient PTIEN
22 .Q:'OKAY
23 .D KEEP(TIEN,PTIEN,.CLLIST)
24 K @CLLIST
25 Q
26 ;
27KEEP(TIEN,PTIEN,CLLIST) ;keep data for report
28 ;TIEN - team ien
29 ;PTIEN - patient ien
30 ;CLLIST - array holding clinics for patient PTIEN
31 ;
32 N ENT,TNAME,INS,NODE,INAME,PDATA,NODE,CIEN,CNAME,PNAME
33 N SCPCPR,SCPCAP,SCI,PCLIST
34 S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name
35 S INS=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien
36 S INAME=$P($G(^DIC(4,INS,0)),"^") ;institution name
37 S PNAME=$P($G(^DPT(PTIEN,0)),"^") ;patient name
38 K ^TMP("SC",$J,PTIEN)
39 S SCI=$$GETALL^SCAPMCA(PTIEN) D
40 .;Name of PC Provider
41 .S SCPCPR=$P($G(^TMP("SC",$J,PTIEN,"PCPR",1)),U,2)
42 .;Name of Associate Provider
43 .S SCPCAP=$P($G(^TMP("SC",$J,PTIEN,"PCAP",1)),U,2)
44 .Q
45 ;
46 S ENT=0
47 F S ENT=$O(@CLLIST@(ENT)) Q:ENT=""!(ENT'?.N) D
48 .S NODE=$G(@CLLIST@(ENT))
49 .S CIEN=+$P(NODE,"^") ;clinic ien
50 .I CLINIC'=1,'$D(CLINIC(CIEN)) Q
51 .S CNAME=$P(NODE,"^",2) ;clinic name
52 .D SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME)
53 .S PDATA=$$PDATA^SCRPEC(PTIEN,CIEN,1)
54 .S $P(PDATA,U,9)=SCPCPR,$P(PDATA,U,10)=SCPCAP
55 .;name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov.
56 .D FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN)
57 Q
58 ;
59SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME) ;
60 ;INS - institution ien
61 ;INAME - institution name
62 ;TIEN - team ien
63 ;TNAME - team name
64 ;PTIEN - patient ien
65 ;PNAME - patient name
66 ;CIEN - clinic ien
67 ;CNAME - clinic name
68 ;
69 I INAME="" S INAME="[BAD DATA]"
70 I TNAME="" S TNAME="[BAD DATA]"
71 I CNAME="" S CNAME="[BAD DATA]"
72 I PNAME="" S PNAME="[BAD DATA]"
73 I '$D(@STORE@("I",INAME,INS)) S @STORE@("I",INAME,INS)="",@STORE@(INS)="Division: "_INAME
74 I '$D(@STORE@("T",INS,TNAME,TIEN)) S @STORE@("T",INS,TNAME,TIEN)="",@STORE@(INS,TIEN)="Team: "_TNAME
75 I '$D(@STORE@("C",INS,TIEN,CNAME,CIEN)) S @STORE@("C",INS,TIEN,CNAME,CIEN)="" ;D HEADER(INS,TIEN,CIEN)
76 I '$D(@STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)) S @STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)=""
77 Q
78 ;
79PCASSIGN(DFN,TIEN) ;patient assigned to team as primary care
80 ;DFN - patient ien
81 ;TIEN - team ien
82 ;1 - yes
83 ;0 - no
84 ;
85 N ADATE,ENTRY,PC
86 S PC=0
87 I '$D(^SCPT(404.42,"AIDT",DFN,TIEN)) Q PC
88 S ADATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,"")) ; -team assignemtn date
89 S ENTRY=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ADATE,"")) ;patient team assignemtn ien
90 I $P($G(^SCPT(404.42,+ENTRY,0)),"^",8)=1 S PC=1
91 Q PC
92 ;
93HEADER ;report column titles
94 N HLD
95 S HLD="H0"
96 S $E(@STORE@("SUBHEADER",HLD),25)="M.T."
97 S $E(@STORE@("SUBHEADER",HLD),31)="Prim"
98 ;Removed by patch 174
99 ;S $E(@STORE@("SUBHEADER",HLD),31)="Pat"
100 ;S $E(@STORE@("SUBHEADER",HLD),36)="Status"
101 S $E(@STORE@("SUBHEADER",HLD),42)="Last"
102 S $E(@STORE@("SUBHEADER",HLD),54)="Next"
103 S $E(@STORE@("SUBHEADER",HLD),66)="Enrolled"
104 S $E(@STORE@("SUBHEADER",HLD),95)="Primary Care"
105 S $E(@STORE@("SUBHEADER",HLD),115)="Associate"
106 S HLD="H1"
107 S @STORE@("SUBHEADER",HLD)="Patient Name"
108 S $E(@STORE@("SUBHEADER",HLD),18)="Pt ID"
109 S $E(@STORE@("SUBHEADER",HLD),25)="Stat"
110 S $E(@STORE@("SUBHEADER",HLD),31)="Elig"
111 ;Removed by patch 174
112 ;S $E(@STORE@("SUBHEADER",HLD),31)="Stat"
113 ;S $E(@STORE@("SUBHEADER",HLD),36)="Date"
114 S $E(@STORE@("SUBHEADER",HLD),42)="Appt"
115 S $E(@STORE@("SUBHEADER",HLD),54)="Appt"
116 S $E(@STORE@("SUBHEADER",HLD),66)="Clinic"
117 S $E(@STORE@("SUBHEADER",HLD),95)="Provider"
118 S $E(@STORE@("SUBHEADER",HLD),115)="Provider"
119 S HLD="H2"
120 S $P(@STORE@("SUBHEADER",HLD),"=",133)=""
121 Q
122 ;
123FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) ;format data for report
124 ;PTIEN - patient ien
125 ;INS - institution ien
126 ;TIEN - team ien
127 ;PDATA - pt name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov.
128 ;CNAME - clinic name
129 ;CIEN - clinic ien
130 ;
131 S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,15) ;patient name
132 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),18)=$E($P(PDATA,"^",2),6,10) ;primary long id last 4 plus P
133 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),25)=$P(PDATA,"^",3) ;means test category
134 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",4) ;primary eligibility
135 ;Removed by patch 174
136 ;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",5) ;patient status
137 ;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),35)=$P(PDATA,"^",6) ;status date
138 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),42)=$P(PDATA,"^",7) ;last appointment
139 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),54)=$P(PDATA,"^",8) ;next appointment
140 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),66)=$E(CNAME,1,27) ;clinic name
141 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),95)=$E($P(PDATA,U,9),1,18) ;PC prov.
142 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),115)=$E($P(PDATA,U,10),1,18) ;Assoc. Prov.
143 Q
144 ;
145CHEAD(INS,TEAM,CLINIC) ;
146 ;column headings
147 ;
148 N EN,NEWP
149 W !
150 S NEWP=0
151 I IOST'?1"C-".E,$Y+5>(IOSL-6) D NEWP1^SCRPU3(.PAGE,TITL) S NEWP=1
152 I IOST?1"C-".E,$Y+5>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) S NEWP=1
153 I STOP Q
154 I NEWP W !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)),!
155CH2 F EN="H0","H1","H2" W !,$G(@STORE@("SUBHEADER",EN))
156 Q
157 ;
Note: See TracBrowser for help on using the repository browser.