source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP3U1.m@ 949

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

initial load of WorldVistAEHR
File size: 5.6 KB
RevLine 
[613]1ORLP3U1 ; SLC/CLA - Utilities which support OE/RR 3 Team/Patient Lists ; [1/3/01 1:38pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,63,98**;Dec 17, 1997
3 ;
4 ; SLC/PKS: Changes made - 8/99.
5 ;
6 Q
7 ;
8WINACT(ORWARD) ; returns "1" if ward (^DIC(42,) is inactive
9 N D0
10 Q:'$L($G(ORWARD)) 0
11 S D0=ORWARD
12 D WIN^DGPMDDCF
13 Q X
14 ;
15USRTMS ; display a user's teams
16 ; Modified by PKS.
17 N ORUSR,ORUSRN,ORY,ORI,ORCNT,ORTM,ORTMN,ORTYPE
18 S ORI="",ORCNT=0
19 W ! K DIC S DIC="^VA(200,",DIC(0)="AEQN",DIC("B")=DUZ
20 S DIC("A")="Find teams linked to user: "
21 D ^DIC Q:Y<1 S ORUSR=+Y,ORUSRN=$P(Y,U,2) K DIC,Y,DUOUT,DTOUT
22 ; Call to TEAMPR changed to TEAMPR2 by PKS/slc - 8/1999:
23 D TEAMPR2^ORQPTQ1(.ORY,ORUSR)
24 D OUTTMS
25 Q
26 ;
27DUZTMS ; display current user's teams
28 ; Modified by PKS.
29 N ORUSRN,ORY,ORI,ORCNT,ORTM,ORTMN,ORTYPE
30 S ORI="",ORCNT=0
31 ; Call to TEAMPR changed to TEAMPR2 by PKS:
32 D TEAMPR2^ORQPTQ1(.ORY,DUZ)
33 S ORUSRN=$P(^VA(200,DUZ,0),U)
34 D OUTTMS
35 Q
36 ;
37USRTMPTS ; display patients linked to a user via teams
38 ; Modified by PKS.
39 ;
40 ; Notes: The TPROVPT^ORQPTQ1 call in USRTMPTS and DUZTMPTS tags
41 ; writes ^TMP("ORLPUPT",$J). Returning, code in OUTPTS4
42 ; here writes a new global, ^XUTL("OR",$J,"ORLP") including
43 ; a "B" index. Modifications by PKS in 8/1999 left this
44 ; functionality unchanged for backwards compatibility. But
45 ; a new "C" index was written to sort for new functionality
46 ; and a new global, ^XUTL("OR",$J,"ORLPTL"), is written in
47 ; order for new output functionality for the display of
48 ; patients sorted alphabetically by teams.
49 ;
50 ; The length of the displayed Team Name is set by the
51 ; variable ORTMNLEN.
52 ;
53 N ORUSR,ORUSRN,ORI,ORCNT,ORBCNT,ORCCNT,ORPT,ORPTN,ORTMN,ORTMNSTR,ORDATA,ORTMNLEN
54 S ORTMN="",ORCNT=0,ORBCNT=0,ORCCNT=0,ORTMNLEN=10
55 W ! K DIC S DIC="^VA(200,",DIC(0)="AEQN",DIC("B")=DUZ
56 S DIC("A")="Find patients linked via teams to user: "
57 D ^DIC Q:Y<1 S ORUSR=+Y,ORUSRN=$P(Y,U,2) K DIC,Y,DUOUT,DTOUT
58 K ^TMP("ORLPUPT",$J)
59 D TPROVPT^ORQPTQ1(ORUSR)
60 D OUTPTS
61 Q
62 ;
63DUZTMPTS ; display patients linked to current user via teams
64 ; Modified by PKS.
65 ;
66 N ORUSR,ORUSRN,ORI,ORCNT,ORBCNT,ORCCNT,ORPT,ORPTN,ORTMN,ORTMNSTR,ORDATA,ORTMNLEN
67 S ORTMN="",ORCNT=0,ORBCNT=0,ORCCNT=0,ORTMNLEN=10
68 S ORUSRN=$P(^VA(200,DUZ,0),U)
69 K ^TMP("ORLPUPT",$J)
70 D TPROVPT^ORQPTQ1(DUZ)
71 D OUTPTS
72 Q
73 ;
74OUTTMS ; Output teams.
75 ; Code moved and modified by PKS.
76 ;
77 K ^XUTL("OR",$J) ; Just in case.
78 ;
79 F S ORI=$O(ORY(ORI)) Q:ORI="" D
80 .; Next line changed by PKS:
81 .S ORTM=$P(ORY(ORI),U),ORTMN=$P(ORY(ORI),U,2),ORTYPE=$P(ORY(ORI),U,3)
82 .S ORTM=$S($L(ORTM):ORTM,1:1)
83 .; Next 2 lines new or modified by PKS:
84 .D TYPESTR ; Assign descriptive type string.
85 .S ^XUTL("OR",$J,"ORLP",ORTM,0)=ORTMN_U_ORTYPE,ORCNT=ORCNT+1
86 .S ^XUTL("OR",$J,"ORLP","B",ORTMN,ORTM)=""
87 S ^XUTL("OR",$J,"ORLP",0)=U_U_ORCNT
88 ;
89 N COL,HDR,PIE,ROOT
90 ; Next line modified by PKS:
91 S ROOT="^XUTL(""OR"",$J,""ORLP"",",PIE="1^2",COL=2
92 S HDR=ORUSRN_" is on the following teams:"
93 D EN^ORULG(ROOT,PIE,HDR,COL)
94 K ^XUTL("OR",$J)
95 Q
96 ;
97OUTPTS ; Output patients alphabetically by teams.
98 ; Code moved and modified by PKS.
99 ;
100 K ^XUTL("OR",$J) ; Just in case.
101 ;
102 ; Order through for each team:
103 F S ORTMN=$O(^TMP("ORLPUPT",$J,"B",ORTMN)) Q:ORTMN="" D
104 .S ORTMNSTR=ORTMN ; Check name string (here), length (next line).
105 .I $L(ORTMN)>ORTMNLEN SET ORTMNSTR=$E(ORTMN,1,ORTMNLEN)_".."
106 .S ORTMNSTR="("_ORTMNSTR_")" ; Add parenthesis.
107 .;
108 .; Order through again for each patient:
109 .S ORI=""
110 .F S ORI=$O(^TMP("ORLPUPT",$J,"B",ORTMN,ORI)) Q:ORI="" D
111 ..S ORCNT=ORCNT+1 ; Top-level counter.
112 ..S ORBCNT=ORBCNT+1 ; This node's counter.
113 ..S ORPT=$P(ORI,U,2) ; DFN
114 ..S ORPT=$S($L(ORPT):ORPT,1:1) ; A default of 1.
115 ..S ORPTN=$P(ORI,U) ; Patient name.
116 ..S ^XUTL("OR",$J,"ORLP",ORPT,0)=ORPTN ; Write to ^XUTL.
117 ..S ^XUTL("OR",$J,"ORLP","B",ORPTN,ORPT)="" ; "B" index of ^XUTL.
118 ..;
119 ..; Write new "C" index of ^XUTL:
120 ..S ^XUTL("OR",$J,"ORLP","C",ORTMN_U_ORPTN_U_ORPT)=ORPTN_U_ORTMNSTR
121 ..;
122 ; Write new ^XUTL file entries:
123 S ORDATA=""
124 F S ORDATA=$O(^XUTL("OR",$J,"ORLP","C",ORDATA)) Q:ORDATA="" D
125 .S ORCNT=ORCNT+1 ; Top-level counter.
126 .S ORCCNT=ORCCNT+1 ; This node's counter.
127 .S ^XUTL("OR",$J,"ORLPTL",ORCCNT,0)=$G(^XUTL("OR",$J,"ORLP","C",ORDATA))
128 K ^TMP("ORLPUPT",$J) ; Finished with ^TMP.
129 ;
130 ; Make required FM entries before proceeding:
131 S ^XUTL("OR",$J,0)=U_U_ORCNT ; Top-level 0-node.
132 S ^XUTL("OR",$J,"ORLP",0)=U_U_ORBCNT ; Next level 0-node.
133 S ^XUTL("OR",$J,"ORLPTL",0)=U_U_ORCCNT ; Other level, same.
134 ;
135 ; Check for no entries (in ^XUTL):
136 I ORCNT=0,ORBCNT=0,ORCCNT=0 D
137 .K ^XUTL("OR",$J) ; Clean house now.
138 .S ^XUTL("OR",$J,"ORLPTL",0)=U_U_1 ; Set 0-node.
139 .;
140 .; Prepare user message:
141 .S ^XUTL("OR",$J,"ORLPTL",1,0)="No linked patients found."_U
142 .; Assign corresponding "B" x-ref:
143 .S ^XUTL("OR",$J,"ORLPTL","B","No linke patients found.",1)=""
144 .Q
145 ;
146 ; Call routine for output:
147 N COL,HDR,PIE,ROOT
148 S ROOT="^XUTL(""OR"",$J,""ORLPTL"",",PIE="1^2",COL=2
149 S HDR=ORUSRN_" is linked to the following patients via teams:"
150 D EN^ORULG(ROOT,PIE,HDR,COL)
151 K ^XUTL("OR",$J)
152 Q
153 ;
154TYPESTR ; Assign description strings to ORTYPE (Team List type) variables.
155 ; New tag by PKS.
156 ;
157 I ORTYPE="P" S ORTYPE="(PERSONAL)"
158 I ORTYPE="TA" S ORTYPE="(AUTOLINK)"
159 I ORTYPE="TM" S ORTYPE="(MANUAL)"
160 I ORTYPE="MRAL" S ORTYPE="(MRAL)"
161 Q
162 ;
Note: See TracBrowser for help on using the repository browser.