- 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
- 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
