| 1 | ORB3REG ; 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
 | 
|---|
| 3 | REGULAR(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
 | 
|---|
| 59 | REGTEAM(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
 | 
|---|
| 85 | DIVS(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
 | 
|---|