ORB3REG ; slc/CLA - Support routine for ORB3 ;6/28/00 12:00 [ 04/02/97 2:16 PM ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,74,88,105,139,200**;Dec 17, 1997
REGULAR(ORN,XQA,ORBU,ORBUI,ORBDEV,ORBDFN) ;get recips who always get notif
; ORN: notif ien
; XQA: DUZ array
; ORBU: recip debug array
; ORBUI: ORBU cntr
; ORBDEV: device recips array
; ORBDFN: patient ien
;
N ORBX,ORLST,ORERR,ORBZ,ORBE,ORBDUZ,ORBDIV,ORBDIVX,ORBSUR
I $D(ORBU) D
.S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
.S ORBU(ORBUI)="Default recipient users and teams:",ORBUI=ORBUI+1
S ORBE=0,ORBX=0
;
;process default recip users & teams:
D ENVAL^XPAR(.ORLST,"ORB DEFAULT RECIPIENTS",ORN,.ORERR)
I 'ORERR,$G(ORLST)>0 D
.F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) I ORLST(ORBE,ORN)=1 D
..S ORBZ=$P(ORBE,";",2)
..I ORBZ="VA(200," S ORBDUZ=$P(ORBE,";") I $L($G(ORBDUZ)) D
...;
...I '$D(ORBU) D
....D PREALERT^ORB3USER(ORBDUZ,ORN,ORBDFN)
....S XQA(ORBDUZ)=""
...;
...I $D(ORBU) N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L($G(NODE)) D
....S ORBU(ORBUI)=" "_$P(NODE,U)_": ON because",ORBUI=ORBUI+1
....S ORBU(ORBUI)=" Default Recipient (USER) parameter set to Yes.",ORBUI=ORBUI+1
....;
....S ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ) ;DBIA #2790
....I +$G(ORBSUR)>0 D
.....S ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]",ORBUI=ORBUI+1
..;
..I ORBZ="OR(100.21," D REGTEAM(ORBE)
;
;process SYSTEM default devices:
S ORBZ=$$GET^XPAR("SYS","ORB DEFAULT RECIPIENT DEVICES",ORN,"E")
I $L($G(ORBZ)) D
.I '$D(ORBU) S ORBDEV(ORBZ)=""
.I $D(ORBU) D
..S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
..S ORBU(ORBUI)="Default device: "_ORBZ_" because",ORBUI=ORBUI+1
..S ORBU(ORBUI)=" Default System Device parameter set to Yes.",ORBUI=ORBUI+1
;
;process DIVISION default devices:
I +$G(DUZ)>1,($L($G(DUZ(2)))) S ORBDIV($G(DUZ(2)))=$G(DUZ(2))
E D DIVS(.ORBDIV)
S ORBDIVX="" F S ORBDIVX=$O(ORBDIV(ORBDIVX)) Q:'ORBDIVX D
.S ORBZ=$$GET^XPAR("DIV.`"_ORBDIVX,"ORB DEFAULT RECIPIENT DEVICES",ORN,"E")
.I $L($G(ORBZ)) D
..I '$D(ORBU) S ORBDEV(ORBZ)=""
..I $D(ORBU) D
...S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
...S ORBU(ORBUI)="Default device: "_ORBZ_" because",ORBUI=ORBUI+1
...S ORBU(ORBUI)=" Default Division Device parameter set to Yes.",ORBUI=ORBUI+1
Q
REGTEAM(ORBE) ;get team recips
N ORBLST,IJ,ORBTD,ORBSUR
D TEAMPROV^ORQPTQ1(.ORBLST,$P(ORBE,";"))
I $D(ORBU) N TNODE S TNODE=$G(^OR(100.21,$P(ORBE,";"),0)) I $L($G(TNODE)) D
.S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
.S ORBU(ORBUI)=" Default team recipients from team "_$P(TNODE,U)_":",ORBUI=ORBUI+1
I +$G(ORBLST(1))>0 S IJ="" F S IJ=$O(ORBLST(IJ)) Q:IJ="" D
.S ORBDUZ=$P(ORBLST(IJ),U) I $L($G(ORBDUZ)) D
..I '$D(ORBU) D
...D PREALERT^ORB3USER(ORBDUZ,ORN,ORBDFN)
...S XQA(ORBDUZ)=""
..I $D(ORBU) N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L($G(NODE)) D
...S ORBU(ORBUI)=" "_$P(NODE,U)_": ON because",ORBUI=ORBUI+1
...S ORBU(ORBUI)=" Default Recipient (TEAM) parameter set to Yes.",ORBUI=ORBUI+1
...S ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ) ;DBIA #2790
...I +$G(ORBSUR)>0 D
....S ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]",ORBUI=ORBUI+1
;
S ORBTD=$P($$TMDEV^ORB31($P(ORBE,";")),U,2) ;tm device
I $L(ORBTD) D
.S ORBDEV(ORBTD)=""
.I $D(ORBU) D
..S ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
;
I $D(ORBU) S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
Q
DIVS(DIVS) ;get all possible divisions
; DIVS - rtn array in format:
; DIVS(div #)=div #
;
N DIV
S DIV=0 F S DIV=$O(^DG(40.8,"AD",DIV)) Q:'DIV D
.S DIVS(DIV)=DIV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3REG 3657 printed Dec 13, 2024@02:27:28 Page 2
ORB3REG ; slc/CLA - Support routine for ORB3 ;6/28/00 12:00 [ 04/02/97 2:16 PM ]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,74,88,105,139,200**;Dec 17, 1997
REGULAR(ORN,XQA,ORBU,ORBUI,ORBDEV,ORBDFN) ;get recips who always get notif
+1 ; ORN: notif ien
+2 ; XQA: DUZ array
+3 ; ORBU: recip debug array
+4 ; ORBUI: ORBU cntr
+5 ; ORBDEV: device recips array
+6 ; ORBDFN: patient ien
+7 ;
+8 NEW ORBX,ORLST,ORERR,ORBZ,ORBE,ORBDUZ,ORBDIV,ORBDIVX,ORBSUR
+9 IF $DATA(ORBU)
Begin DoDot:1
+10 SET ORBU(ORBUI)=" "
SET ORBUI=ORBUI+1
+11 SET ORBU(ORBUI)="Default recipient users and teams:"
SET ORBUI=ORBUI+1
End DoDot:1
+12 SET ORBE=0
SET ORBX=0
+13 ;
+14 ;process default recip users & teams:
+15 DO ENVAL^XPAR(.ORLST,"ORB DEFAULT RECIPIENTS",ORN,.ORERR)
+16 IF 'ORERR
IF $GET(ORLST)>0
Begin DoDot:1
+17 FOR ORBX=1:1:ORLST
SET ORBE=$ORDER(ORLST(ORBE))
IF ORLST(ORBE,ORN)=1
Begin DoDot:2
+18 SET ORBZ=$PIECE(ORBE,";",2)
+19 IF ORBZ="VA(200,"
SET ORBDUZ=$PIECE(ORBE,";")
IF $LENGTH($GET(ORBDUZ))
Begin DoDot:3
+20 ;
+21 IF '$DATA(ORBU)
Begin DoDot:4
+22 DO PREALERT^ORB3USER(ORBDUZ,ORN,ORBDFN)
+23 SET XQA(ORBDUZ)=""
End DoDot:4
+24 ;
+25 IF $DATA(ORBU)
NEW NODE
SET NODE=$GET(^VA(200,ORBDUZ,0))
IF $LENGTH($GET(NODE))
Begin DoDot:4
+26 SET ORBU(ORBUI)=" "_$PIECE(NODE,U)_": ON because"
SET ORBUI=ORBUI+1
+27 SET ORBU(ORBUI)=" Default Recipient (USER) parameter set to Yes."
SET ORBUI=ORBUI+1
+28 ;
+29 ;DBIA #2790
SET ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ)
+30 IF +$GET(ORBSUR)>0
Begin DoDot:5
+31 SET ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]"
SET ORBUI=ORBUI+1
End DoDot:5
End DoDot:4
End DoDot:3
+32 ;
+33 IF ORBZ="OR(100.21,"
DO REGTEAM(ORBE)
End DoDot:2
End DoDot:1
+34 ;
+35 ;process SYSTEM default devices:
+36 SET ORBZ=$$GET^XPAR("SYS","ORB DEFAULT RECIPIENT DEVICES",ORN,"E")
+37 IF $LENGTH($GET(ORBZ))
Begin DoDot:1
+38 IF '$DATA(ORBU)
SET ORBDEV(ORBZ)=""
+39 IF $DATA(ORBU)
Begin DoDot:2
+40 SET ORBU(ORBUI)=" "
SET ORBUI=ORBUI+1
+41 SET ORBU(ORBUI)="Default device: "_ORBZ_" because"
SET ORBUI=ORBUI+1
+42 SET ORBU(ORBUI)=" Default System Device parameter set to Yes."
SET ORBUI=ORBUI+1
End DoDot:2
End DoDot:1
+43 ;
+44 ;process DIVISION default devices:
+45 IF +$GET(DUZ)>1
IF ($LENGTH($GET(DUZ(2))))
SET ORBDIV($GET(DUZ(2)))=$GET(DUZ(2))
+46 IF '$TEST
DO DIVS(.ORBDIV)
+47 SET ORBDIVX=""
FOR
SET ORBDIVX=$ORDER(ORBDIV(ORBDIVX))
if 'ORBDIVX
QUIT
Begin DoDot:1
+48 SET ORBZ=$$GET^XPAR("DIV.`"_ORBDIVX,"ORB DEFAULT RECIPIENT DEVICES",ORN,"E")
+49 IF $LENGTH($GET(ORBZ))
Begin DoDot:2
+50 IF '$DATA(ORBU)
SET ORBDEV(ORBZ)=""
+51 IF $DATA(ORBU)
Begin DoDot:3
+52 SET ORBU(ORBUI)=" "
SET ORBUI=ORBUI+1
+53 SET ORBU(ORBUI)="Default device: "_ORBZ_" because"
SET ORBUI=ORBUI+1
+54 SET ORBU(ORBUI)=" Default Division Device parameter set to Yes."
SET ORBUI=ORBUI+1
End DoDot:3
End DoDot:2
End DoDot:1
+55 QUIT
REGTEAM(ORBE) ;get team recips
+1 NEW ORBLST,IJ,ORBTD,ORBSUR
+2 DO TEAMPROV^ORQPTQ1(.ORBLST,$PIECE(ORBE,";"))
+3 IF $DATA(ORBU)
NEW TNODE
SET TNODE=$GET(^OR(100.21,$PIECE(ORBE,";"),0))
IF $LENGTH($GET(TNODE))
Begin DoDot:1
+4 SET ORBU(ORBUI)=" "
SET ORBUI=ORBUI+1
+5 SET ORBU(ORBUI)=" Default team recipients from team "_$PIECE(TNODE,U)_":"
SET ORBUI=ORBUI+1
End DoDot:1
+6 IF +$GET(ORBLST(1))>0
SET IJ=""
FOR
SET IJ=$ORDER(ORBLST(IJ))
if IJ=""
QUIT
Begin DoDot:1
+7 SET ORBDUZ=$PIECE(ORBLST(IJ),U)
IF $LENGTH($GET(ORBDUZ))
Begin DoDot:2
+8 IF '$DATA(ORBU)
Begin DoDot:3
+9 DO PREALERT^ORB3USER(ORBDUZ,ORN,ORBDFN)
+10 SET XQA(ORBDUZ)=""
End DoDot:3
+11 IF $DATA(ORBU)
NEW NODE
SET NODE=$GET(^VA(200,ORBDUZ,0))
IF $LENGTH($GET(NODE))
Begin DoDot:3
+12 SET ORBU(ORBUI)=" "_$PIECE(NODE,U)_": ON because"
SET ORBUI=ORBUI+1
+13 SET ORBU(ORBUI)=" Default Recipient (TEAM) parameter set to Yes."
SET ORBUI=ORBUI+1
+14 ;DBIA #2790
SET ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ)
+15 IF +$GET(ORBSUR)>0
Begin DoDot:4
+16 SET ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]"
SET ORBUI=ORBUI+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 ;tm device
SET ORBTD=$PIECE($$TMDEV^ORB31($PIECE(ORBE,";")),U,2)
+19 IF $LENGTH(ORBTD)
Begin DoDot:1
+20 SET ORBDEV(ORBTD)=""
+21 IF $DATA(ORBU)
Begin DoDot:2
+22 SET ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient"
SET ORBUI=ORBUI+1
End DoDot:2
End DoDot:1
+23 ;
+24 IF $DATA(ORBU)
SET ORBU(ORBUI)=" "
SET ORBUI=ORBUI+1
+25 QUIT
DIVS(DIVS) ;get all possible divisions
+1 ; DIVS - rtn array in format:
+2 ; DIVS(div #)=div #
+3 ;
+4 NEW DIV
+5 SET DIV=0
FOR
SET DIV=$ORDER(^DG(40.8,"AD",DIV))
if 'DIV
QUIT
Begin DoDot:1
+6 SET DIVS(DIV)=DIV
End DoDot:1
+7 QUIT
