source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3REG.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1ORB3REG ; slc/CLA - Support routine for ORB3 ;6/28/00 12:00 [ 04/02/97 2:16 PM ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,74,88,105,139,200**;Dec 17, 1997
3REGULAR(ORN,XQA,ORBU,ORBUI,ORBDEV,ORBDFN) ;get recips who always get notif
4 ; ORN: notif ien
5 ; XQA: DUZ array
6 ; ORBU: recip debug array
7 ; ORBUI: ORBU cntr
8 ; ORBDEV: device recips array
9 ; ORBDFN: patient ien
10 ;
11 N ORBX,ORLST,ORERR,ORBZ,ORBE,ORBDUZ,ORBDIV,ORBDIVX,ORBSUR
12 I $D(ORBU) D
13 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
14 .S ORBU(ORBUI)="Default recipient users and teams:",ORBUI=ORBUI+1
15 S ORBE=0,ORBX=0
16 ;
17 ;process default recip users & teams:
18 D ENVAL^XPAR(.ORLST,"ORB DEFAULT RECIPIENTS",ORN,.ORERR)
19 I 'ORERR,$G(ORLST)>0 D
20 .F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) I ORLST(ORBE,ORN)=1 D
21 ..S ORBZ=$P(ORBE,";",2)
22 ..I ORBZ="VA(200," S ORBDUZ=$P(ORBE,";") I $L($G(ORBDUZ)) D
23 ...;
24 ...I '$D(ORBU) D
25 ....D PREALERT^ORB3USER(ORBDUZ,ORN,ORBDFN)
26 ....S XQA(ORBDUZ)=""
27 ...;
28 ...I $D(ORBU) N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L($G(NODE)) D
29 ....S ORBU(ORBUI)=" "_$P(NODE,U)_": ON because",ORBUI=ORBUI+1
30 ....S ORBU(ORBUI)=" Default Recipient (USER) parameter set to Yes.",ORBUI=ORBUI+1
31 ....;
32 ....S ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ) ;DBIA #2790
33 ....I +$G(ORBSUR)>0 D
34 .....S ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]",ORBUI=ORBUI+1
35 ..;
36 ..I ORBZ="OR(100.21," D REGTEAM(ORBE)
37 ;
38 ;process SYSTEM default devices:
39 S ORBZ=$$GET^XPAR("SYS","ORB DEFAULT RECIPIENT DEVICES",ORN,"E")
40 I $L($G(ORBZ)) D
41 .I '$D(ORBU) S ORBDEV(ORBZ)=""
42 .I $D(ORBU) D
43 ..S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
44 ..S ORBU(ORBUI)="Default device: "_ORBZ_" because",ORBUI=ORBUI+1
45 ..S ORBU(ORBUI)=" Default System Device parameter set to Yes.",ORBUI=ORBUI+1
46 ;
47 ;process DIVISION default devices:
48 I +$G(DUZ)>1,($L($G(DUZ(2)))) S ORBDIV($G(DUZ(2)))=$G(DUZ(2))
49 E D DIVS(.ORBDIV)
50 S ORBDIVX="" F S ORBDIVX=$O(ORBDIV(ORBDIVX)) Q:'ORBDIVX D
51 .S ORBZ=$$GET^XPAR("DIV.`"_ORBDIVX,"ORB DEFAULT RECIPIENT DEVICES",ORN,"E")
52 .I $L($G(ORBZ)) D
53 ..I '$D(ORBU) S ORBDEV(ORBZ)=""
54 ..I $D(ORBU) D
55 ...S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
56 ...S ORBU(ORBUI)="Default device: "_ORBZ_" because",ORBUI=ORBUI+1
57 ...S ORBU(ORBUI)=" Default Division Device parameter set to Yes.",ORBUI=ORBUI+1
58 Q
59REGTEAM(ORBE) ;get team recips
60 N ORBLST,IJ,ORBTD,ORBSUR
61 D TEAMPROV^ORQPTQ1(.ORBLST,$P(ORBE,";"))
62 I $D(ORBU) N TNODE S TNODE=$G(^OR(100.21,$P(ORBE,";"),0)) I $L($G(TNODE)) D
63 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
64 .S ORBU(ORBUI)=" Default team recipients from team "_$P(TNODE,U)_":",ORBUI=ORBUI+1
65 I +$G(ORBLST(1))>0 S IJ="" F S IJ=$O(ORBLST(IJ)) Q:IJ="" D
66 .S ORBDUZ=$P(ORBLST(IJ),U) I $L($G(ORBDUZ)) D
67 ..I '$D(ORBU) D
68 ...D PREALERT^ORB3USER(ORBDUZ,ORN,ORBDFN)
69 ...S XQA(ORBDUZ)=""
70 ..I $D(ORBU) N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L($G(NODE)) D
71 ...S ORBU(ORBUI)=" "_$P(NODE,U)_": ON because",ORBUI=ORBUI+1
72 ...S ORBU(ORBUI)=" Default Recipient (TEAM) parameter set to Yes.",ORBUI=ORBUI+1
73 ...S ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ) ;DBIA #2790
74 ...I +$G(ORBSUR)>0 D
75 ....S ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]",ORBUI=ORBUI+1
76 ;
77 S ORBTD=$P($$TMDEV^ORB31($P(ORBE,";")),U,2) ;tm device
78 I $L(ORBTD) D
79 .S ORBDEV(ORBTD)=""
80 .I $D(ORBU) D
81 ..S ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
82 ;
83 I $D(ORBU) S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
84 Q
85DIVS(DIVS) ;get all possible divisions
86 ; DIVS - rtn array in format:
87 ; DIVS(div #)=div #
88 ;
89 N DIV
90 S DIV=0 F S DIV=$O(^DG(40.8,"AD",DIV)) Q:'DIV D
91 .S DIVS(DIV)=DIV
92 Q
Note: See TracBrowser for help on using the repository browser.