source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP2.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1SCRPTP2 ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,53,52,174,177,231,526,520**;AUG 13, 1993;Build 26
3 ;
4 ;List of Team's Patients Report
5 ;
6TFORMAT(INST,INAME,TIEN,TNAME,PHONE,PC) ; Format team information
7 ;INST - institution ien
8 ;INAME - institution name
9 ;TIEN - team ien
10 ;TNAME - team name
11 ;PHONE - team phone
12 ;PC - primary care team (yes/no)
13 ;
14 I INAME="" S INAME="[BAD DATA]"
15 I TNAME="" S TNAME="[BAD DATA]"
16 S @STORE@("I",INAME,INST)=""
17 S @STORE@("T",INST,TNAME,TIEN)=""
18 S @STORE@(INST)="Division: "_INAME
19 S @STORE@(INST,TIEN)="Team: "_TNAME
20 S $E(@STORE@(INST,TIEN),45)="Team Phone: "_PHONE
21 S @STORE@(INST,TIEN,1)="Primary Care Team: "_PC
22 Q
23 ;
24PRINTIT(STORE,TITL) ;
25 N INST,INAME,TNAME,TIEN
26 S (NEW,PAGE)=1,STOP=0 W:$E(IOST)="C" @IOF
27 D TITLE^SCRPU3(.PAGE,TITL,132) ;write title
28 D SETH
29 ;
30 S INAME=""
31 F S INAME=$O(@STORE@("I",INAME)) Q:INAME=""!(STOP) D
32 .S INST=$O(@STORE@("I",INAME,""))
33 .Q:INST=""
34 .I ('NEW)&(IOST'?1"C-".E) D NEWP1^SCRPU3(.PAGE,TITL,132)
35 .I ('NEW)&(IOST?1"C-".E) D HOLD^SCRPU3(.PAGE,TITL,132)
36 .Q:STOP
37 .W !,$G(@STORE@(INST)) ;write institution
38 .S TNAME=""
39 .F S TNAME=$O(@STORE@("T",INST,TNAME)) Q:TNAME=""!(STOP) D
40 ..S TIEN=$O(@STORE@("T",INST,TNAME,""))
41 ..Q:TIEN=""
42 ..D TPRINT(INST,TIEN) ;writes team info
43 ..Q:STOP
44 ..;
45 ..I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132)
46 ..I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132)
47 ..Q:STOP
48 ..D HEADER
49 ..I (SORT=3)!(SORT=4) D PRACT(INST,TIEN,.NEW)
50 ..I (SORT=1)!(SORT=2) D PTP(INST,TIEN,.NEW)
51 K NEW,PAGE
52 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
53 Q
54 ;
55PRACT(INST,TIEN,NEW) ;Print by practitioner/patient
56 N PNAME,PIEN,SEC2,ST1,TRD,TRDI
57 S PNAME="",PIEN=""
58 F S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP) D
59 . F S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP) D
60 . . I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name
61 . . I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID
62 . . S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")"
63 . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
64 . . Q:STOP
65 . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
66 . . Q:STOP
67 . . S (TRDI,TRD)=""
68 . . F S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP) D
69 . . . F S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP) D
70 . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
71 . . . . Q:STOP
72 . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
73 . . . . Q:STOP
74 . . . . I $D(@STORE@(INST,TIEN,PIEN,TRDI)) W !,$G(@STORE@(INST,TIEN,PIEN,TRDI)) ;write column data
75 . . . . N SCACL
76 . . . . S SCACL="" F S SCACL=$O(@STORE@(INST,TIEN,PIEN,TRDI,SCACL)) Q:SCACL="" D
77 . . . . . W !,$G(@STORE@(INST,TIEN,PIEN,TRDI,SCACL))
78 . S NEW=0
79 Q
80 ;
81PTP(INST,TIEN,NEW) ;Print by patient/practitioner
82 N SEC2,ST1,TRDI,TRD,PNAME,PIEN
83 I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name
84 I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID
85 S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")"
86 I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132)
87 I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132)
88 Q:STOP
89 S (TRDI,TRD)=""
90 F S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP) D
91 . F S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP) D
92 . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
93 . . Q:STOP
94 . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
95 . . Q:STOP
96 . . S PNAME="",PIEN=""
97 . . F S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP)!(PIEN=0) D
98 . . . F S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP) D
99 . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
100 . . . . Q:STOP
101 . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
102 . . . . Q:STOP
103 . . . . I $D(@STORE@(INST,TIEN,TRDI,PIEN)) W !,$G(@STORE@(INST,TIEN,TRDI,PIEN)) ;write column data
104 . . . . N SCACL
105 . . . . S SCACL="" F S SCACL=$O(@STORE@(INST,TIEN,TRDI,PIEN,SCACL)) Q:SCACL="" D
106 . . . . . W !,$G(@STORE@(INST,TIEN,TRDI,PIEN,SCACL))
107 . S NEW=0
108 Q
109 ;
110TPRINT(INST,TIEN) ;
111 ;prints team data
112 N NXT
113 I (IOST'?1"C-".E)&($Y>(IOSL-13)) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
114 I (IOST?1"C-".E)&($Y>(IOSL-13)) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
115 Q:STOP
116 W !!,$G(@STORE@(INST,TIEN))
117 S NXT=0
118 W !,$G(@STORE@(INST,TIEN,1)) ;write team info
119 Q:'$D(@STORE@(INST,TIEN,"D")) W !
120 S NXT=""
121 ;write team description
122 F S NXT=$O(@STORE@(INST,TIEN,"D",NXT)) Q:NXT=""!(STOP) D
123 .I (IOST'?1"C-".E)&$Y>(IOSL-13) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
124 .I (IOST?1"C-".E)&$Y>(IOSL-13) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
125 .Q:STOP
126 .W !,$G(@STORE@(INST,TIEN,"D",NXT))
127 W !!,"[Not Assigned] = Patient assigned to Team but not to a position/provider"
128 W !,"[Inactive Position] = Patient assigned to Team & Position but has no active provider"
129 Q
130 ;
131HEADER ;prints column headings
132 N NXT
133 F NXT="H1","H2","H3" D
134 .W !,$G(@STORE@(NXT))
135 Q
136 ;
137SETH ;sets column headings
138 S @STORE@("H2")="Patient Name"
139 S $E(@STORE@("H2"),18)="Pt ID"
140 S $E(@STORE@("H2"),32)="Practitioner"
141 S $E(@STORE@("H2"),56)="Role"
142 S $E(@STORE@("H2"),80)="PC?"
143 S $E(@STORE@("H1"),85)="Last"
144 S $E(@STORE@("H2"),85)="Appt."
145 S $E(@STORE@("H1"),97)="Next"
146 S $E(@STORE@("H2"),97)="Appt."
147 S $E(@STORE@("H2"),109)="Associated Clinic"
148 S $P(@STORE@("H3"),"=",133)=""
149 Q
Note: See TracBrowser for help on using the repository browser.