source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP3AC1.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1ORLP3AC1 ; SLC/PKS - ADD and DELETE a patient to clinic Team List Autolinks. [12/28/99 2:48pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**47**;Dec 17, 1997
3 ;
4 ; Called by: ORLP3AUC.
5 ;
6ADD ; Add patient to applicable team lists.
7 ;
8 ; Variables used -
9 ;
10 ; NEW'd and assigned by calling tag (ORLP3AUC):
11 ;
12 ; ORTL = OE/RR TEAM LIST file number (set to "100.21").
13 ; ORCL = Clinic.
14 ; ORPT = Patient number.
15 ;
16 ; NEW'd herein:
17 ;
18 ; ORTEAM = Team List.
19 ; ORAL = Team List Autolink.
20 ; ORVAL = Team List Autolink node data value.
21 ; ORTYPE = Type of Autolink.
22 ; X = Required variable for call to FILE^DICN.
23 ;
24 N ORTEAM,ORAL,ORVAL,ORTYPE,X
25 ;
26 ; Order through OE/RR TEAM LIST file looking for clinic autolinks:
27 S ORTEAM=0 ; Initialize.
28 F S ORTEAM=$O(^OR(ORTL,ORTEAM)) Q:'+ORTEAM D ; Each team.
29 .I $P(^OR(ORTL,ORTEAM,0),"^",2)["A",'$O(^OR(ORTL,ORTEAM,2,0)) Q ; If not an Autolink Team List or no Autolink records, skip.
30 .S ORAL=0 ; Initialize.
31 .F S ORAL=$O(^OR(ORTL,ORTEAM,2,ORAL)) Q:'+ORAL D ; Each Autolink.
32 ..I $D(^OR(ORTL,ORTEAM,2,ORAL,0)) S ORVAL=^OR(ORTL,ORTEAM,2,ORAL,0) ; Get data value from this clinic's record.
33 ..S ORTYPE=$P(ORVAL,";",2) ; Get Autolink type.
34 ..I ORTYPE="SC(" D ; Is the Autolink type a clinic?
35 ...I $P(ORVAL,";")=ORCL D ; Is it the clinic involved?
36 ....I $D(^OR(ORTL,ORTEAM,10,"B",ORPT_";DPT(")) Q ; Patient already there?
37 ....;
38 ....; Lock the records at the Team level:
39 ....L +^OR(ORTL,+ORTEAM):5
40 ....I '$T W !," WARNING: File locked - "_$P($G(^OR(ORTL,+ORTEAM,0)),"^")_" Team List not updated." Q ; Skip this Team if there's a locking problem.
41 ....;
42 ....; Set variables and call tag^routine that invokes DICN call:
43 ....S:'$D(^OR(ORTL,+ORTEAM,10,0)) ^(0)="^100.2101AV^^"
44 ....K DIC,DA,DO,DD,X
45 ....S X=ORPT_";DPT("
46 ....S DIC(0)="L"
47 ....S DA(1)=+ORTEAM
48 ....S DIC="^OR("_ORTL_","_DA(1)_",10,"
49 ....D FILE^DICN
50 ....L -^OR(ORTL,+ORTEAM) ; Release the lock on this Team.
51 ;
52 Q
53 ;
54DELETE ; Delete patient from team lists if appropriate. (Patient
55 ; not removed if another autolink would list him/her.)
56 ;
57 ; Variables used -
58 ;
59 ; NEW'd and assigned by calling tag (ORLP3AUC):
60 ;
61 ; ORTL = OE/RR TEAM LIST file number (set to "100.21").
62 ; ORCL = Clinic.
63 ; ORPT = Patient number.
64 ;
65 ; NEW'd herein (or in BLDDEL tag called herein):
66 ;
67 ; ORTEAM = Team List.
68 ; ORAL = Team List Autolink.
69 ; ORVAL = Team List Autolink node data value.
70 ; ORTYPE = Type of Autolink.
71 ; ORLINK = Autolink holder variable.
72 ; LNAME = Team List textual name.
73 ; VP = Array for call to PTS^ORLP2.
74 ;
75 N ORTEAM,ORAL,ORVAL,ORTYPE,ORLINK,LNAME,VP
76 ;
77 ; Order through OE/RR TEAM LIST file looking for autolinks:
78 ;
79 S ORTEAM=0 ; Initialize.
80 F S ORTEAM=$O(^OR(ORTL,ORTEAM)) Q:'+ORTEAM D ; Each team.
81 .I $P(^OR(ORTL,ORTEAM,0),"^",2)["A",'$O(^OR(ORTL,ORTEAM,2,0)) Q ; If not an Autolink Team List or no Autolink records, skip.
82 .S ORAL=0 ; Initialize.
83 .F S ORAL=$O(^OR(ORTL,ORTEAM,2,ORAL)) Q:'+ORAL D ; Each Autolink.
84 ..I $D(^OR(ORTL,ORTEAM,2,ORAL,0)) S ORVAL=^OR(ORTL,ORTEAM,2,ORAL,0) ; Get data value from this clinic's record.
85 ..S ORTYPE=$P(ORVAL,";",2) ; Get Autolink type.
86 ..I ORTYPE="SC(" D ; Is the Autolink type a clinic?
87 ...I $P(ORVAL,";")=ORCL D ; Is it the clinic involved?
88 ....I '$D(^OR(ORTL,ORTEAM,10,"B",ORPT_";DPT(")) Q ; Patient Autolinked there now? If not, forget it.
89 ....D BLDDEL ; Call tag to build list/compare/delete entry if needed.
90 ;
91 Q
92 ;
93BLDDEL ; Build ^TMP, delete patient from clinic Autolinks as appropriate.
94 ;
95 ; Build ^TMP global of all patients that would be on list
96 ; because of remaining Autolinks for this Team -
97 ;
98 K VP,^TMP("ORLP",$J) ; "Just-in-case" clean up.
99 ;
100 ; Set variables for call to DIC:
101 S DIC(0)="NZ"
102 S DA(1)=+ORTEAM
103 S DIC="^OR("_ORTL_","_DA(1)_",2,"
104 ;
105 ; Order through Autolinks of this Team for remaining Autolinks:
106 S ORLINK=0 ; Initialize.
107 F S ORLINK=$O(^OR(ORTL,+ORTEAM,2,ORLINK)) Q:'ORLINK D
108 .I $G(^OR(ORTL,+ORTEAM,2,ORLINK,0))=ORCL_";SC(" Q ; Skip clinic that triggered delete action - patient already there by default.
109 .S X="`"_ORLINK
110 .D ^DIC
111 .S VP=Y(0)
112 .S VP(1)="^"_$P($PIECE(VP,";",2),"^")
113 .S VP(2)=+VP
114 .S LNAME=Y(0,0)
115 .D PTS^ORLP2(.VP,"LINK") ; Call tag^routine to add patients to ^TMP.
116 K X,Y,DIC ; Clean up pre-DIC.
117 ;
118 ; If patient is on list because of other autolinks, leave
119 ; him/her there - otherwise delete the patient entry:
120 I '$D(^TMP("ORLP",$J,"LINK",ORPT)) D ; Patient not on list?
121 .;
122 .; Lock the records at the Team level:
123 .L +^OR(ORTL,+ORTEAM):5
124 .I '$T W !," WARNING: File locked - "_LNAME_" Team List not updated." Q ; Skip this Team if there's a locking problem.
125 .;
126 .S DA=$O(^OR(ORTL,+ORTEAM,10,"B",ORPT_";DPT(",0))
127 .I DA D
128 ..S DA(1)=+ORTEAM
129 ..S DIK="^OR("_ORTL_","_DA(1)_",10,"
130 ..D ^DIK
131 ..K DIK ; Clean up DIK.
132 .;
133 .L -^OR(ORTL,+ORTEAM) ; Release the lock on this Team.
134 ;
135 K VP,^TMP("ORLP",$J) ; Clean up before quitting.
136 Q
137 ;
Note: See TracBrowser for help on using the repository browser.