source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTA.m@ 1766

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

revised back to 6/30/08 version

File size: 4.6 KB
Line 
1SCRPTA ;ALB/CMM - Patient Listing w/Team Assignment Data ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,48,52,114,174,181,177**;AUG 13, 1993
3 ;
4 ;Patient Listing w/Team Assignment Data Report
5 ;
6PROMPTS ;
7 ;Prompt for Institution, Team, Role, Practitioner and Print device
8 ;
9 N PRNT,QTIME,NUMBER
10 K VAUTD,VAUTT,VAUTR,VAUTP,VAUTPP,SCUP
11 S QTIME=""
12 W ! D INST^SCRPU1 I Y=-1 G ERR
13 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR
14 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR
15 W ! K Y S VAUTPP="" D PRACT^SCRPU1 K VAUTPP I '$D(VAUTP) G ERR
16 W !!,"This report requires 132 column output!"
17 D QUE(.VAUTD,.VAUTT,.VAUTR,.VAUTP) Q
18 ;
19QUE(INST,TEAM,ROLE,PRACT) ;
20 ;Input Parameters:
21 ;INST - institutions selected (variable and array)
22 ;TEAM - teams selected (variable and array)
23 ;ROLE - roles selected (variable and array)
24 ;PRACT - practitioners selected (variable and array)
25 N ZTSAVE,II
26 F II="INST","TEAM","ROLE","INST(","TEAM(","PRACT","PRACT(","ROLE(" S ZTSAVE(II)=""
27 W ! D EN^XUTMDEVQ("QENTRY^SCRPTA","Patient Listing for Team Assignments",.ZTSAVE)
28 Q
29 ;
30ENTRY2(INST,TEAM,ROLE,PRACT,IOP,ZTDTH) ;
31 ;Second entry point for GUI to use
32 ;Input Parameters:
33 ;INST - institutions selected (variable and array)
34 ;TEAM - teams selected (variable and array)
35 ;ROLE - roles selected (variable and array)
36 ;PRACT - practitioners selected (variable and array)
37 ;IOP - print device
38 ;ZTDTH - queue time (optional)
39 ;
40 ;validate parameters
41 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(PRACT)!'$D(IOP)!(IOP="") Q
42 ;
43 N NUMBER
44 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
45 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
46 I IOST?1"C-".E D QENTRY G RET
47 I ZTDTH="" S ZTDTH=$H
48 S ZTRTN="QENTRY^SCRPTA"
49 S ZTDESC="Patient Listing w/Team Assignment",ZTIO=IOP
50 N II
51 F II="INST","TEAM","ROLE","INST(","TEAM(","PRACT","PRACT(","ROLE(","IOP" S ZTSAVE(II)=""
52 D ^%ZTLOAD
53RET S NUMBER=0
54 I $D(ZTSK) S NUMBER=ZTSK
55 D EXIT1
56 Q NUMBER
57 ;
58QENTRY ;
59 ;driver entry point
60 S TITL="Patient Listing For Team Assignments"
61 S STORE="^TMP("_$J_",""SCRPTA"")"
62 K @STORE
63 S @STORE=0
64 I TEAM=1 D TALL^SCRPPAT3 S TEAM=0
65 D FIND
66 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
67 I '$D(NODATA) D PRINTIT(STORE,TITL)
68 D EXIT2
69 Q
70 ;
71ERR ;
72EXIT1 ;
73 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,Y,SCUP
74 Q
75 ;
76EXIT2 ;
77 K @STORE
78 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,NODATA,PRACT
79 Q
80 ;
81FIND ;
82 N NXT,TLIST,TERR,CNT,ERR1,TNODE,NODE1,PIEN,PTAIEN
83 S NXT=0,TLIST="^TMP("_$J_",""SCRPTA"",""LIST1"")",TERR="ERR1"
84 K @TLIST,@TERR
85 F S NXT=$O(TEAM(NXT)) Q:NXT=""!(NXT'?.N) D
86 .S ERR1=$$PTTM^SCAPMC2(NXT,,.TLIST,.TERR) ;Patients assigned to team NXT
87 .Q:ERR1=0
88 .S CNT=0
89 .F S CNT=$O(@TLIST@(CNT)) Q:CNT=""!(CNT'?.N) D
90 ..S TNODE=$G(@TLIST@(CNT))
91 ..Q:TNODE=""
92 ..S PIEN=+$P(TNODE,"^") ;patient ien
93 ..S PTAIEN=+$P(TNODE,"^",3) ;ien Patient Team Assignment #404.42
94 ..D CHK^SCRPTA2(PTAIEN,PIEN)
95 .K @TLIST,@TERR
96 K @TLIST,@TERR
97 Q
98 ;
99PRINTIT(STORE,TITL) ;
100 N NXT,PAGE,NPAGE,INTN,TMN,INT,TM,PRN,PR,POS
101 S (NPAGE,STOP,PAGE)=0,INTN="" W:$E(IOST)="C" @IOF
102 D SHEAD ;setup headers
103 F S INTN=$O(@STORE@("I",INTN)) Q:INTN=""!(STOP) D
104 .S INT=$O(@STORE@("I",INTN,"")) ;institution
105 .Q:INT=""
106 .S TMN=""
107 .F S TMN=$O(@STORE@("T",INT,TMN)) Q:TMN=""!(STOP) D
108 ..S TM=$O(@STORE@("T",INT,TMN,"")) ;team
109 ..Q:TM=""
110 ..D NEWP1^SCRPU3(.PAGE,TITL,132) W !,$G(@STORE@(INT)),!!,$G(@STORE@(INT,TM))
111 ..Q:STOP
112 ..S PRN=""
113 ..D HEADER
114 ..F S PRN=$O(@STORE@("P",INT,TM,PRN)) Q:PRN=""!(STOP) D
115 ...S PR=$O(@STORE@("P",INT,TM,PRN,"")) ;practitioner
116 ...Q:PR=""
117 ...S POS=""
118 ...F S POS=$O(@STORE@("P",INT,TM,PRN,PR,POS)) Q:POS=""!(STOP) D
119 ....D PRNT(INT,TM,PR,POS)
120 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
121 Q
122 ;
123PRNT(INT,TM,PR,POS) ;
124 ;INT - institution ien
125 ;TM - team ien
126 ;PR - practitioner ien
127 ;POS - position ien
128 ;
129 N PTIEN,PTNAME
130 S PTNAME=""
131 F S PTNAME=$O(@STORE@(INT,TM,PR,POS,PTNAME)) Q:PTNAME=""!(STOP) D
132 .S PTIEN=""
133 .F S PTIEN=$O(@STORE@(INT,TM,PR,POS,PTNAME,PTIEN)) Q:PTIEN=""!(STOP) D
134 ..I (IOST'?1"C-".E),$Y>(IOSL-4) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INT)),!!,$G(@STORE@(INT,TM)) D:'STOP HEADER
135 ..I (IOST?1"C-".E),$Y>(IOSL-4) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INT)),!!,$G(@STORE@(INT,TM)) D:'STOP HEADER
136 ..Q:STOP
137 ..W !,$G(@STORE@(INT,TM,PR,POS,PTNAME,PTIEN))
138 .Q
139 Q
140 ;
141HEADER ;
142 ;write column headers
143 N EN
144 W !
145 F EN="H1","H2","H3" D
146 .W !,$G(@STORE@(EN))
147 Q
148SHEAD ;
149 ;setup column headers
150 S @STORE@("H2")="Patient Name"
151 S $E(@STORE@("H2"),24)="Pt ID"
152 S $E(@STORE@("H1"),31)="Date"
153 S $E(@STORE@("H2"),31)="Assigned"
154 S $E(@STORE@("H2"),43)="PC?"
155 S $E(@STORE@("H2"),49)="Practitioner"
156 S $E(@STORE@("H2"),70)="Position"
157 S $E(@STORE@("H2"),92)="Standard Role"
158 S $E(@STORE@("H2"),113)="Preceptor"
159 S $P(@STORE@("H3"),"=",133)=""
160 Q
Note: See TracBrowser for help on using the repository browser.