source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP.m@ 613

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

initial load of WorldVistAEHR
File size: 9.2 KB
Line 
1ORLP ; SLC/CLA - Manager for Team List options ; 5/30/08 6:28am
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**47,90,98,243**;Dec 17, 1997;Build 242
3 ;
4CLEAR ; From TM, MERG^ORLP1, END^ORLP0.
5 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0
6 Q
7 ;
8TM ; From option ORLP TEAM ADD - create/add a team list.
9 N ORLTYP
10 D CLEAR
11 W @IOF,!,"A team list is a list containing patients related to several providers.",!,"These providers are the list's users. You may now create a new team list"
12 W !,"or add autolinks, users and/or patients to an existing team list. Autolinks",!,"automatically add or remove patients with ADT movements. Users on the list"
13 W !,"may receive notifications regarding patients on the same list. Please prefix",!,"your list name with 'TEAM' or 'SERVICE' (e.g. TEAM7B, SERVICECARDIOLOGY.)",!
14 D ASKLIST,END
15 Q
16 ;
17ASKLIST ; Ask for team list.
18 ; NOTE: For new entries, TYPE field is required and trigger
19 ; stuffs CREATOR field with DUZ of current user.
20 ;
21AL N DLAYGO,DIC,DIE,DIK,DR,ORFLAG,ORLTNAM,OROWNER,ORROOT,ORDA,ORYY
22 N DIR S DIR(0)="FAO^3:30",DIR("A")="Enter team list name: "
23 D ^DIR
24 I '$D(X)!$D(DIRUT) K DIR,DIRUT Q
25 S ORLTNAM=$$CHKNAM(Y) ; Check for duplication.
26 K DIR
27 N DIC S X=$G(X),(ORROOT,DIC)="^OR(100.21,",DLAYGO=100.21,DIC(0)="LEFQZ" D ^DIC
28 I '$D(X)!(+Y<0)!$D(DIRUT) K DIRUT Q ; User aborted or problem.
29 I +Y,'+$G(^OR(100.21,+Y,11)) S ^OR(100.21,+Y,11)="0^"
30 ; Check for "Personal" lists (and not a new entry):
31 I ORLTNAM>0,(+Y>0),$P($G(^OR(100.21,+Y,0)),U,2)="P" W !!," Personal lists cannot be edited here.",! G AL
32 S (ORYY,TEAM)=Y,ORDA=+Y,TEAM(0)=Y(0),^TMP("ORLP",$J,"TLIST")=+Y K DIC
33 ; Check for entry of team type (new team entry):
34 I $P(TEAM,U,3) D Q
35 .I $P(TEAM(0),U,2)="" D
36 ..SET Y=TEAM,Y(0)=TEAM(0) ; Reassign in case DIE previously called.
37 ..N DIE S DIE=ORROOT,DA=+Y,DR="1 Enter type: ~R" D ^DIE I $O(Y(0)) S DIK=DIE D ^DIK Q
38 .S (ORLTYP,OROWNER)=""
39 .S ORLTYP=$P(^OR(100.21,+TEAM,0),U,2) Q:'$L(ORLTYP)
40 .; Check for "P" type, ask for user/owner input:
41 .I ORLTYP="P" D OWNER^ORLP1 ; Sets OROWNER variable.
42 .I (ORLTYP="P")&(OROWNER="") S DIK=ORROOT,DA=ORDA D ^DIK Q
43 .;
44 .; Allow further editing of autolink type teams:
45 .I ORLTYP["A" S:'$D(^OR(100.21,+TEAM,2,0)) ^(0)="^100.213AVI^^" D Q
46 .. D ASKLINK,ASKUSER,ASKDEV,ASKSUB
47 .;
48 .; Proceed with editing for "TM" type teams:
49 .D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV
50 ;
51 ; For existing teams, display team type:
52 W !," Type: "_$S($P(Y(0),U,2)="TM":"Manual Team List",$P(Y(0),U,2)="TA":"Autolinked Team List",$P(Y(0),U,2)="MRAL":"Manual Removal Autolinked Team List",1:"(Unknown)")
53 ;
54 ; Lock before allowing editing:
55 I $O(^OR(100.21,+TEAM,10,0)) L +^OR(100.21,+TEAM):3 I '$T W !?5," Another user is editing this entry." Q
56 ;
57 ; Allow applicable editing for all types but "TM" teams:
58 I $P(TEAM(0),U,2)'="TM" D
59 . D ASKLINK,ASKUSER,ASKDEV
60 . ;
61 . ; Editing of "subscription" attribute for "TA" and "MRAL" teams:
62 . I $P(TEAM(0),U,2)["A" D
63 . . D ASKSUB
64 ;
65 ; Proceed with editing for "TM" type teams:
66 I $P(TEAM(0),U,2)="TM" D ASKPT^ORLP00(+TEAM),ASKUSER,ASKDEV
67 Q
68 ;
69ASKLINK ; Ask for autolinks.
70 N DIC,DA,DLAYGO,Y,DUOUT,LVP,LVPT,LNAME
71 W !
72 F K DIC,DA,DUOUT D I LVP<1 Q
73 .S DLAYGO=100.21,DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",2,",DIC(0)="AELMQZ",DIC("A")=" Enter team autolink: "
74 .D ^DIC S LVP=Y I Y<1 Q
75 .I $P($G(Y),U,3)=1 D
76 ..S LNAME=Y(0,0)
77 ..I LVP["VA(200" F D Q:'$D(Y)
78 ...S DA(1)=+TEAM,DIE="^OR(100.21,"_DA(1)_",2,",DA(1)=+TEAM,DA=+LVP,DR="1R" D ^DIE I $D(Y) W !," This field is required in order for Provider autolinks to work correctly.",!," Please answer the question."
79 ..S LVPT=$P($G(^OR(100.21,+TEAM,2,+LVP,0)),U,2)
80 ..; For clinics, take a fork in the road:
81 ..I $P($P(LVP,U,2),";",2)="SC(" D BYCL(LVP) Q
82 ..; For autolinks besides clinics, truck on:
83 ..D ADDLPTS
84 Q
85 ;
86ADDLPTS ; Add patients linked to autolink.
87 W !
88 W !," [ADT movements linked to "
89 W !," ",LNAME
90 W !," will now automatically add patients to this list.]"
91 S LINK=$P(LVP,U,2),FILE="^"_$P(LINK,";",2),X="",CNT=0
92 W !!," Adding patients linked to ",LNAME,"..."
93 W !
94 I FILE="^DIC(42," D LOOPTS("CN",LNAME) Q
95 I FILE="^DG(405.4," D LOOPTS("RM",LNAME) Q
96 I FILE="^VA(200," D Q
97 . ; Variable LVPT determines if provider pointer is for:
98 . ; B - Both Primary and Attending
99 . ; A - Attending
100 . ; P - Primary
101 . I LVPT["B" D LOOPTS("APR",+LINK) N CNTAPR S CNTAPR=CNT,CNT=0 D LOOPTS("AAP",+LINK) Q
102 . I LVPT["P" D LOOPTS("APR",+LINK) Q
103 . I LVPT["A" D LOOPTS("AAP",+LINK)
104 I FILE="^DIC(45.7," D LOOPTS("ATR",+LINK) Q
105 Q
106 ;
107BYCL(CLINIC) ; SLC/PKS - 6/99 - Return list of clinic patients by enrollment.
108 ;
109 ; Called by ASKLINK.
110 ;
111 ; Variables used:
112 ;
113 ; CLINIC = Clinic to search.
114 ; ORLIST = Array, returned by call to PTCL^SCAPMC.
115 ; ORERR = Array for errors, returned by call to PTCL^SCAPMC.
116 ; ORRET = Flag for problem with PTCL^SCAPMC call.
117 ; RESULT = Holds result of PTCL^SCAPMC call (1=OK, 0=error).
118 ; RCD = Holder for each record in ^TMP of PTCL^SCAPMC.
119 ; DFN = Patient IEN.
120 ; ALCNT = Count of autolink patients added.
121 ; DUPCNT = Count of duplicate patients already on list.
122 ; X = Temp value holder variable.
123 ;
124 N DIC,DA,DO,DD,ORLIST,ORERR,RESULT,RCD,DFN,ALCNT,DUPCNT,X,ORRET
125 ;
126 ; Assign clinic variable:
127 S CLINIC=$P(CLINIC,"^",2)
128 S CLINIC=$P(CLINIC,";")
129 ;
130 ; Keep user informed:
131 W !
132 W !," [Patient enrollments linked to "
133 W !," ",LNAME
134 W !," will now automatically add patients to this list.]"
135 W !
136 W !," Adding patients enrolled in ",LNAME,"..."
137 W !
138 ;
139 ; Process the Autolink entries:
140 K ^TMP("SC TMP LIST") ; Clean up potential leftover data.
141 S ORRET=1
142 S RESULT=$$PTCL^SCAPMC(CLINIC,,.ORLIST,.ORERR)
143 I $L($G(RESULT)) D ; Make sure something was returned.
144 .I RESULT>0 S ORRET=0 ; Was return value 1 or more?
145 I ORRET W !," Error in processing - patients will not be added." Q ; Abort if there's a problem.
146 ; Clinic patients should now be in ^TMP("SC TMP LIST",$J file.
147 ;
148 ; Write the patients to the OE/RR LIST file:
149 S ALCNT=0 ; Initialize autolink counter.
150 S DUPCNT=0 ; Initialize duplicate counter.
151 S RCD=0 ; Initialize to start with first data record.
152 F S RCD=$O(^TMP("SC TMP LIST",$J,RCD)) Q:'RCD D ; Each record.
153 .S DFN=$P(^TMP("SC TMP LIST",$J,RCD),"^") ; Patient IEN.
154 .S X=DFN_";DPT(" ; Add ";DPT(" to patient string.
155 .I $D(^OR(100.21,+TEAM,10,"B",X)) S DUPCNT=DUPCNT+1 Q ; This patient already on list - increment dupe counter.
156 .S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^"
157 .K DIC,DA,DO,DD
158 .S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L"
159 .D FILE^DICN
160 .I +X S ALCNT=ALCNT+1 ; Increment counter.
161 .Q ; Loop for each record in ^TMP file.
162 ;
163 ; Give user the results:
164 I ALCNT>0 W !," "_ALCNT_" patient(s) added to list."
165 I ALCNT=0 W !," No linked patients found."
166 I DUPCNT>0 W !," "_DUPCNT_" patient(s) already on list."
167 W !
168 K ^TMP("SC TMP LIST",$J) ; Clean up ^TMP file entries.
169 ;
170 Q
171 ;
172LOOPTS(REF,DEX) ;
173 S ORLPT=0 F S ORLPT=$O(^DPT(REF,DEX,ORLPT)) Q:ORLPT'>0 S X=ORLPT_";DPT(" D ADDLOOP
174 I $D(LVPT),LVPT["B"!(LVPT']"") Q:REF="APR"
175 I +X W !,$S(+CNT:" "_(+$G(CNTAPR)+(+CNT))_" patient(s) added.",1:" Linked patients already on list.")
176 E W " No linked patients found."
177 W !
178 K DEX,FILE,MSG,REF,X,Y
179 Q
180 ;
181ASKUSER ; From ASKLIST - ask for providers/users.
182 Q:$D(DTOUT)!($D(DUOUT))
183 W !
184 S:'$D(^OR(100.21,+TEAM,1,0)) ^(0)="^100.212PA^^"
185 K DIC,DA
186 S DLAYGO=100.212,DA(1)=+TEAM
187 S DIC("P")="100.212PA",DIC="^OR(100.21,"_DA(1)_",1,",DIC(0)="AELMQ"
188 S DIC("A")=" Enter team provider/user: "
189 ; SLC/PKS - Next line added on 4/11/2000:
190 S DIC("S")="I $D(X),$D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)"
191 F D Q:Y<1
192 .D ^DIC
193 .I '(Y<1) W !
194 K DIC,DA,DLAYGO
195 Q
196 ;
197ASKDEV ; From ASKLIST - ask for device.
198 ;
199 ; New, by PKS - 7/29/99:
200 Q:$D(DTOUT)!($D(DUOUT)) ; Previous interaction fail?
201 W !
202 N DIE,DR
203 S DIE="^OR(100.21,"
204 S DA=+TEAM
205 S DR="1.5 Enter device: "
206 D ^DIE ; Writes to DEVICE field.
207 K DIE
208 Q
209 ;
210ASKSUB ; From ASKLIST - Ask re: subscription status.
211 ; (PKS - 8/1999)
212 ;
213 Q:$D(DTOUT)!($D(DUOUT)) ; Previous interaction fail?
214 W !
215 N DIE,DR
216 S DIE="^OR(100.21,"
217 S DA=+TEAM
218 S DR="1.7 Enter subscription status: "
219 D ^DIE ; Writes to SUBSCRIBE field.
220 K DIE
221 ;
222 Q
223 ;
224STOR ; From SEQ^ORLP0 - store list in 100.21.
225 Q:'$D(DUZ)!('ORCNT)
226 I '$D(TEAM),($D(Y)#2) S TEAM=Y
227 S DLAYGO=100.21
228 L +^OR(100.21,+TEAM)
229 S (CNT,ORLI)=0 F ORLJ=1:1 S ORLI=$O(^XUTL("OR",$J,"ORLP",ORLI)) Q:ORLI<1 I $D(^(ORLI,0)) S X=^(0),X=$P(X,U,3) D ADDLOOP
230 I $G(X)>0 S MSG=$S(CNT=0:" Patient(s) already on list.",1:" "_CNT_" patient(s) added.") W !?5,MSG
231 E W !?5," No patients found."
232 I CNT>0 W !?5," Storing list " W:$D(TEAM) $P(TEAM,U,2)," " W "for future reference..."
233 L -^OR(100.12,+TEAM)
234 Q
235 ;
236ADDLOOP ; From STOR, LOOPTS - add patients.
237 Q:$D(^OR(100.21,+TEAM,10,"B",X)) ; Quit if on list.
238 S:'$D(^OR(100.21,+TEAM,10,0)) ^(0)="^100.2101AV^^"
239 K DIC,DA,DO,DD
240 S DA(1)=+TEAM,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L"
241 D FILE^DICN I Y>0 S:$D(CNT) CNT=CNT+1
242 Q
243 ;
244CHKNAM(X) ; Check for duplicate entry.
245 N DIC
246 S X=$G(X)
247 S DIC="^OR(100.21,"
248 D ^DIC
249 S X=+Y
250 Q X
251 ;
252END ;
253 I $G(TEAM) L -^OR(100.21,+TEAM)
254 ;
255END1 K %,CNT,DA,DD,DIC,DO,DIE,DIK,DIR,DR,LINK,ORCNT,ORLI,ORLJ,ORLPT,SEL,TEAM,X,Y,ORBSTG,ORBROOT,DTOUT
256 Q
257 ;
Note: See TracBrowser for help on using the repository browser.