ORB3USER ; slc/CLA - Alert recipient algorithms for OE/RR 3 notifications; 1/19/00 14:45 [8/16/05 9:53am]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**74,91,105,139,200,220**;Dec 17, 1997
USER(XQA,ORBDUZ,ORN,ORBU,ORBUI,ORBDFN,ORNUM) ;called from ORB3
;check to see if potential recip (ORBDUZ) should be an alert recip
;XQA array of alert recips passed to Kernel Alert Utility
;ORBDUZ duz of current potential alert recipient
;ORN notif ien from file 100.9
;ORBU array of info for utility displaying recip who and why
;ORBUI counter for utility array
;ORBDFN patient ien from Patient file [#2]
;ORNUM order number to base division params on[optional]
;
N ORBNODE,ORBSUR,ORBTM,ORBTMF,ORBTEAM,ORBON,ORBDUP
I $G(ORBDUZ)["G." S XQA(ORBDUZ)="" Q
Q:+$G(ORBDUZ)<.5
;
S ORBTM=$P(ORBDUZ,U,2) I $L(ORBTM) D ;if user recip via team
.S ORBTMF=$$GET^XPAR(ORBTM_";OR(100.21,","ORB PROCESSING FLAG",ORN,"I")
.S ORBTEAM=ORBTMF_U_$P(^OR(100.21,ORBTM,0),U)
.I $D(ORBU) D
..S ORBU(ORBUI)=" User "_$P(^VA(200,+ORBDUZ,0),U)_" is a potential recipient via team "_$P(ORBTEAM,U,2),ORBUI=ORBUI+1
;
I '$D(ORBU) D
.I $L($G(ORBTMF))=0 D
..S:$D(^XTMP("ORBUSER",$J,+ORBDUZ)) ORBDUP=1
..S ^XTMP("ORBUSER",$J,+ORBDUZ)=""
Q:$G(ORBDUP)=1 ;quit if user already processed and no team param value
;
S ORBDUZ=$P(ORBDUZ,U)
;
S:$G(ORBTEAM)="" ORBTEAM="^"
S ORBON=$$ONOFF(ORN,ORBDUZ,ORBDFN,ORBTEAM,$G(ORNUM))
I $D(ORBU) D
.S ORBNODE=$G(^VA(200,ORBDUZ,0)) I $L($G(ORBNODE)) D
..S ORBU(ORBUI)=" "_$P(ORBNODE,U)_": "_$P(ORBON,U)_" because ",ORBUI=ORBUI+1
..S ORBU(ORBUI)=" "_$P(ORBON,U,2),ORBUI=ORBUI+1
I $D(ORBU),($P(ORBON,U)="ON"),($G(ORBDUZ)'["G.") D
.S ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ) ;DBIA 2790 Alert surrogate
.I +$G(ORBSUR)>0 D
..S ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]",ORBUI=ORBUI+1
Q:$P(ORBON,U)="OFF" ;quit if user is disabled for this notif
Q:$D(ORBU) ;quit if entered rtn via UTL (do not sent alert)
D PREALERT(ORBDUZ,ORN,ORBDFN) ;if user has undel prev alert, delete it
S XQA(ORBDUZ)="" ;send alert to the user
Q
;
PREALERT(ORBDUZ,ORN,ORBDFN) ;if user (ORBDUZ) has an undeleted previous
;version of this alert (ORN) for patient (ORBDFN), delete it
;
Q:$P(^ORD(100.9,ORN,0),U,4)'="NOT" ;quit if not a "NOT" notif/alert
N XQAID,XQAKILL,XQAUSER,ORBDT
S XQAID="OR,"_ORBDFN_","_ORN
I $D(^XTV(8992,"AXQAN",XQAID,ORBDUZ)) D ;DBIA# 2689
.S ORBDT=0,ORBDT=$O(^XTV(8992,"AXQAN",XQAID,ORBDUZ,ORBDT))
.I $G(ORBDT)>0 D
..S XQAUSER=ORBDUZ
..S XQAKILL=1
..D DELETEA^XQALERT
Q
;
ONOFF(ORN,ORBUSR,ORBPT,ORBTEAM,ORNUM) ;Extrinsic function to check param file
;determines if user ORBUSR should receive notification ORN for patient
;patient ORBPT. If ORBUSR was derived via teams, ORBTEAM may be used.
;ORN notification ien from file 100.9 (req'd)
;ORBUSR user ien from file 200 (req'd)
;ORBPT patient ien from file 2 (not req'd)
;ORBTEAM processing flag^name for team assoc. w/ORBUSR (not req'd)
;ORNUM order number to base division params on (not req'd)
N NODE,ORBPTN,ORBNOTN,ORBUSRF,ORBUSRN,ORBLOC,ORBLOCF,ORBLOCN
S (ORBPTN,ORBNOTN,ORBUSRF,ORBUSRN,ORBLOC,ORBLOCF,ORBLOCN)=""
N ORBSRV,ORBSRVF,ORBSRVN,ORBTEA,ORBTEAF,ORBTEAN,ORBTEAD,ORBTEAE
S (ORBSRV,ORBSRVF,ORBSRVN,ORBTEA,ORBTEAF,ORBTEAN,ORBTEAD,ORBTEAE)=""
N ORBCLS,ORBCLSF,ORBCLSN,ORBLST,ORBI
S (ORBCLS,ORBCLSF,ORBCLSN)=""
N ORBDIV,ORBDIVF,ORBDIVN,ORBSYSF,ORBPKGF
S (ORBDIV,ORBDIVF,ORBDIVN,ORBSYSF,ORBPKGF)=""
;
;get notification name:
S NODE=$G(^ORD(100.9,ORN,0)) S:$L($G(NODE)) ORBNOTN=$P(NODE,U)
;
;get user name:
S NODE=$G(^VA(200,ORBUSR,0)) S:$L($G(NODE)) ORBUSRN=$P(NODE,U)
;
;get patient name:
S:$L($G(ORBPT)) NODE=$G(^DPT(ORBPT,0)) S:$L($G(NODE)) ORBPTN=$P(NODE,U)
;
;get division flag and name:
S ORBDIV=$$DIVF(ORBUSR,ORN,$G(ORNUM))
I $L(ORBDIV) D
.S ORBDIVF=$P(ORBDIV,U,2),ORBDIV=$P(ORBDIV,U),NODE=$G(^DIC(4,ORBDIV,0))
.S:$L($G(NODE)) ORBDIVN=$P(NODE,U)
;
;get system flag:
S ORBSYSF=$$GET^XPAR("SYS","ORB PROCESSING FLAG",ORN,"I")
;
;get OE/RR package-export flag:
S ORBPKGF=$$GET^XPAR("PKG","ORB PROCESSING FLAG",ORN,"I")
;
;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
;reliably determined, and many simultaneous outpt locations can occur):
I +$G(ORBPT)>0 D
.N DFN S DFN=ORBPT,VA200="" D OERR^VADPT
.S ORBLOC=+$G(^DIC(42,+VAIN(4),44)) I +$G(ORBLOC)>0 D
..S ORBLOCN=$P(^SC(+ORBLOC,0),U)
..S ORBLOCF=$$GET^XPAR(+$G(ORBLOC)_";SC(","ORB PROCESSING FLAG",ORN,"I")
K VA200,VAIN
;
;get user's service/section flag:
S ORBSRV=$G(^VA(200,ORBUSR,5)) I +ORBSRV>0 S ORBSRV=$P(ORBSRV,U) D
.S NODE=$G(^DIC(49,ORBSRV,0)) S:$L($G(NODE)) ORBSRVN=$P(NODE,U)
.S:+$G(ORBSRV)>0 ORBSRVF=$$GET^XPAR(ORBSRV_";DIC(49,","ORB PROCESSING FLAG",ORN,"I")
;
;get user's team flag:
I $L($G(ORBTEAM)) S ORBTEAF=$P(ORBTEAM,U),ORBTEAN=$P(ORBTEAM,U,2)
;
;get class flag for the user's most recently active ASU class
;S ORBCLS=$$RECENT(ORBUSR) I $L($G(ORBCLS))>0 D
;.S ORBCLSN=$P(ORBCLS,U,2),ORBCLS=$P(ORBCLS,U)
;.S:+$G(ORBCLS)>0 ORBCLSF=$$GET^XPAR(ORBCLS_";USR(8930,","ORB PROCESSING FLAG",ORN,"I")
;
;get user's flag:
S ORBUSRF=$$GET^XPAR(ORBUSR_";VA(200,","ORB PROCESSING FLAG",ORN,"I")
;
;determine overall flag:
I $G(ORBUSRF)="M" Q "ON^User "_ORBUSRN_" is Mandatory.^User value is Mandatory"
I $G(ORBUSRF)="E" Q "ON^User "_ORBUSRN_" is Enabled.^User value is Enabled"
;I $G(ORBCLSF)="M" Q "ON^User's class "_ORBCLSN_" is Mandatory.^User's class "_ORBCLSN_" value is Mandatory"
I $G(ORBTEAF)="M" Q "ON^User's team "_ORBTEAN_" is Mandatory.^User's team "_ORBTEAN_" value is Mandatory"
I $G(ORBTEAF)="D" Q "OFF^User's team "_ORBTEAN_" is Disabled.^User's team "_ORBTEAN_" value is Disabled"
I $G(ORBSRVF)="M" Q "ON^User's service "_ORBSRVN_" is Mandatory.^User's service "_ORBSRVN_" value is Mandatory"
I $G(ORBLOCF)="M" Q "ON^Patient's location "_ORBLOCN_" is Mandatory.^Pt's location "_ORBLOCN_" value is Mandatory"
I $G(ORBLOCF)="D" Q "OFF^Patient's location "_ORBLOCN_" is Disabled.^Pt's location "_ORBLOCN_" value is Disabled"
I $G(ORBDIVF)="M",($G(ORBLOCF)="") Q "ON^Division "_ORBDIVN_" is Mandatory, no Pt Location value.^Division "_ORBDIVN_" value is Mandatory"
I $G(ORBSYSF)="M",($G(ORBDIVF)=""),($G(ORBLOCF)="") Q "ON^System default is Mandatory, no Division or Pt Location values.^System value is Mandatory"
I $G(ORBPKGF)="M",($G(ORBSYSF)=""),($G(ORBDIVF)=""),($G(ORBLOCF)="") Q "ON^OERR default is Mandatory, no Division, System, or Pt Location values.^OERR value is Mandatory"
I $G(ORBUSRF)="D" Q "OFF^User "_ORBUSRN_" is Disabled - no Mandatory values found.^User value is Disabled"
;I $G(ORBCLSF)="D" Q "OFF^User's class "_ORBCLSN_" is Disabled - no Mandatory values found.^User's class "_ORBCLSN_" value is Disabled""
I $G(ORBTEAF)="E" Q "ON^User's team "_ORBTEAN_" is Enabled.^User's team "_ORBTEAN_" value is Enabled"
I $G(ORBSRVF)="D" Q "OFF^User's service "_ORBSRVN_" is Disabled.^User's service "_ORBSRVN_" value is Disabled"
I $G(ORBSRVF)="E" Q "ON^User's service "_ORBSRVN_" is Enabled.^User's service "_ORBSRVN_" value is Enabled"
I $G(ORBLOCF)="E" Q "ON^Patient's location "_ORBLOCN_" is Enabled.^Pt's location "_ORBLOCN_" value is Enabled"
I $G(ORBDIVF)="D" Q "OFF^Division "_ORBDIVN_" is Disabled.^Division "_ORBDIVN_" value is Disabled"
I $G(ORBDIVF)="E" Q "ON^Division "_ORBDIVN_" is Enabled.^Division "_ORBDIVN_" value is Enabled"
I $G(ORBSYSF)="D" Q "OFF^System default is Disabled.^System value is Disabled"
I $G(ORBSYSF)="E" Q "ON^System default is Enabled.^System value is Enabled"
I $G(ORBPKGF)="D" Q "OFF^OERR default is Disabled.^OERR value is Disabled"
I $G(ORBPKGF)="E" Q "ON^OERR default is Enabled.^OERR value is Enabled"
Q "OFF^No Mandatory, Disabled or Enabled values found.^No Mandatory/Disabled/Enabled values"
;
RECENT(USER) ;ext funct rtns a user's most recent, active user class
Q:+$G(USER)<1 "^Error: User not identified."
N CLS,CLASS,INACT,ACT,ORX,INVDT,RESULT
;call api to determine user's class(es)
Q:'$L($G(CLS(0))) "^No user classes found."
D NOW^%DTC
S CLASS="" F S CLASS=$O(CLS(CLASS)) Q:CLASS="" D
.S INACT=$P(CLS(CLASS),U,5),ACT=$P(CLS(CLASS),U,4)
.I INACT,(INACT<%) Q ;quit if class has an inactive date before now
.Q:'ACT ;quit if class has no active date
.S ORX("DT",9999999-ACT)=$P(CLS(CLASS),U)_U_CLASS
S INVDT="",INVDT=$O(ORX("DT",INVDT))
I INVDT S RESULT=ORX("DT",INVDT)
E S RESULT="^No user classes found."
K %
Q RESULT
DIVF(USER,ORN,ORNUM) ;ext funct rtns user's division value for ORB PROCESSING FLAG
N DIV,DIVF,MDIVF,EDIVF,DDIVF
I +$G(ORNUM) D Q DIVF
.S DIVF=""
.S DIV=$$ORDIV^ORB31(ORNUM)
.I +$G(DIV)'>0 Q
.S DIVF=$$GET^XPAR(DIV_";DIC(4,","ORB PROCESSING FLAG",ORN,"I")
.I $L(DIVF) S DIVF=DIV_U_DIVF
S DIV=0,(DIVF,MDIVF,EDIVF,DDIVF)=""
F S DIV=$O(^VA(200,USER,2,"B",DIV)) Q:+$G(DIV)<1!(DIVF="M") D
.S DIVF=$$GET^XPAR(DIV_";DIC(4,","ORB PROCESSING FLAG",ORN,"I")
.I DIVF="M" S MDIVF=DIV_U_DIVF
.I DIVF="E" S EDIVF=DIV_U_DIVF
.I DIVF="D" S DDIVF=DIV_U_DIVF
Q:$L(MDIVF) MDIVF
Q:$L(EDIVF) EDIVF
Q:$L(DDIVF) DDIVF
Q ""
ORB3USER ; slc/CLA - Alert recipient algorithms for OE/RR 3 notifications; 1/19/00 14:45 [8/16/05 9:53am]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**74,91,105,139,200,220**;Dec 17, 1997
USER(XQA,ORBDUZ,ORN,ORBU,ORBUI,ORBDFN,ORNUM) ;called from ORB3
+1 ;check to see if potential recip (ORBDUZ) should be an alert recip
+2 ;XQA array of alert recips passed to Kernel Alert Utility
+3 ;ORBDUZ duz of current potential alert recipient
+4 ;ORN notif ien from file 100.9
+5 ;ORBU array of info for utility displaying recip who and why
+6 ;ORBUI counter for utility array
+7 ;ORBDFN patient ien from Patient file [#2]
+8 ;ORNUM order number to base division params on[optional]
+9 ;
+10 NEW ORBNODE,ORBSUR,ORBTM,ORBTMF,ORBTEAM,ORBON,ORBDUP
+11 IF $GET(ORBDUZ)["G."
SET XQA(ORBDUZ)=""
QUIT
+12 IF +$GET(ORBDUZ)<.5
QUIT
+13 ;
+14 ;if user recip via team
SET ORBTM=$PIECE(ORBDUZ,U,2)
IF $LENGTH(ORBTM)
Begin DoDot:1
+15 SET ORBTMF=$$GET^XPAR(ORBTM_";OR(100.21,","ORB PROCESSING FLAG",ORN,"I")
+16 SET ORBTEAM=ORBTMF_U_$PIECE(^OR(100.21,ORBTM,0),U)
+17 IF $DATA(ORBU)
Begin DoDot:2
+18 SET ORBU(ORBUI)=" User "_$PIECE(^VA(200,+ORBDUZ,0),U)_" is a potential recipient via team "_$PIECE(ORBTEAM,U,2)
SET ORBUI=ORBUI+1
End DoDot:2
End DoDot:1
+19 ;
+20 IF '$DATA(ORBU)
Begin DoDot:1
+21 IF $LENGTH($GET(ORBTMF))=0
Begin DoDot:2
+22 IF $DATA(^XTMP("ORBUSER",$JOB,+ORBDUZ))
SET ORBDUP=1
+23 SET ^XTMP("ORBUSER",$JOB,+ORBDUZ)=""
End DoDot:2
End DoDot:1
+24 ;quit if user already processed and no team param value
IF $GET(ORBDUP)=1
QUIT
+25 ;
+26 SET ORBDUZ=$PIECE(ORBDUZ,U)
+27 ;
+28 IF $GET(ORBTEAM)=""
SET ORBTEAM="^"
+29 SET ORBON=$$ONOFF(ORN,ORBDUZ,ORBDFN,ORBTEAM,$GET(ORNUM))
+30 IF $DATA(ORBU)
Begin DoDot:1
+31 SET ORBNODE=$GET(^VA(200,ORBDUZ,0))
IF $LENGTH($GET(ORBNODE))
Begin DoDot:2
+32 SET ORBU(ORBUI)=" "_$PIECE(ORBNODE,U)_": "_$PIECE(ORBON,U)_" because "
SET ORBUI=ORBUI+1
+33 SET ORBU(ORBUI)=" "_$PIECE(ORBON,U,2)
SET ORBUI=ORBUI+1
End DoDot:2
End DoDot:1
+34 IF $DATA(ORBU)
IF ($PIECE(ORBON,U)="ON")
IF ($GET(ORBDUZ)'["G.")
Begin DoDot:1
+35 ;DBIA 2790 Alert surrogate
SET ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ)
+36 IF +$GET(ORBSUR)>0
Begin DoDot:2
+37 SET ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]"
SET ORBUI=ORBUI+1
End DoDot:2
End DoDot:1
+38 ;quit if user is disabled for this notif
IF $PIECE(ORBON,U)="OFF"
QUIT
+39 ;quit if entered rtn via UTL (do not sent alert)
IF $DATA(ORBU)
QUIT
+40 ;if user has undel prev alert, delete it
DO PREALERT(ORBDUZ,ORN,ORBDFN)
+41 ;send alert to the user
SET XQA(ORBDUZ)=""
+42 QUIT
+43 ;
PREALERT(ORBDUZ,ORN,ORBDFN) ;if user (ORBDUZ) has an undeleted previous
+1 ;version of this alert (ORN) for patient (ORBDFN), delete it
+2 ;
+3 ;quit if not a "NOT" notif/alert
IF $PIECE(^ORD(100.9,ORN,0),U,4)'="NOT"
QUIT
+4 NEW XQAID,XQAKILL,XQAUSER,ORBDT
+5 SET XQAID="OR,"_ORBDFN_","_ORN
+6 ;DBIA# 2689
IF $DATA(^XTV(8992,"AXQAN",XQAID,ORBDUZ))
Begin DoDot:1
+7 SET ORBDT=0
SET ORBDT=$ORDER(^XTV(8992,"AXQAN",XQAID,ORBDUZ,ORBDT))
+8 IF $GET(ORBDT)>0
Begin DoDot:2
+9 SET XQAUSER=ORBDUZ
+10 SET XQAKILL=1
+11 DO DELETEA^XQALERT
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
ONOFF(ORN,ORBUSR,ORBPT,ORBTEAM,ORNUM) ;Extrinsic function to check param file
+1 ;determines if user ORBUSR should receive notification ORN for patient
+2 ;patient ORBPT. If ORBUSR was derived via teams, ORBTEAM may be used.
+3 ;ORN notification ien from file 100.9 (req'd)
+4 ;ORBUSR user ien from file 200 (req'd)
+5 ;ORBPT patient ien from file 2 (not req'd)
+6 ;ORBTEAM processing flag^name for team assoc. w/ORBUSR (not req'd)
+7 ;ORNUM order number to base division params on (not req'd)
+8 NEW NODE,ORBPTN,ORBNOTN,ORBUSRF,ORBUSRN,ORBLOC,ORBLOCF,ORBLOCN
+9 SET (ORBPTN,ORBNOTN,ORBUSRF,ORBUSRN,ORBLOC,ORBLOCF,ORBLOCN)=""
+10 NEW ORBSRV,ORBSRVF,ORBSRVN,ORBTEA,ORBTEAF,ORBTEAN,ORBTEAD,ORBTEAE
+11 SET (ORBSRV,ORBSRVF,ORBSRVN,ORBTEA,ORBTEAF,ORBTEAN,ORBTEAD,ORBTEAE)=""
+12 NEW ORBCLS,ORBCLSF,ORBCLSN,ORBLST,ORBI
+13 SET (ORBCLS,ORBCLSF,ORBCLSN)=""
+14 NEW ORBDIV,ORBDIVF,ORBDIVN,ORBSYSF,ORBPKGF
+15 SET (ORBDIV,ORBDIVF,ORBDIVN,ORBSYSF,ORBPKGF)=""
+16 ;
+17 ;get notification name:
+18 SET NODE=$GET(^ORD(100.9,ORN,0))
IF $LENGTH($GET(NODE))
SET ORBNOTN=$PIECE(NODE,U)
+19 ;
+20 ;get user name:
+21 SET NODE=$GET(^VA(200,ORBUSR,0))
IF $LENGTH($GET(NODE))
SET ORBUSRN=$PIECE(NODE,U)
+22 ;
+23 ;get patient name:
+24 IF $LENGTH($GET(ORBPT))
SET NODE=$GET(^DPT(ORBPT,0))
IF $LENGTH($GET(NODE))
SET ORBPTN=$PIECE(NODE,U)
+25 ;
+26 ;get division flag and name:
+27 SET ORBDIV=$$DIVF(ORBUSR,ORN,$GET(ORNUM))
+28 IF $LENGTH(ORBDIV)
Begin DoDot:1
+29 SET ORBDIVF=$PIECE(ORBDIV,U,2)
SET ORBDIV=$PIECE(ORBDIV,U)
SET NODE=$GET(^DIC(4,ORBDIV,0))
+30 IF $LENGTH($GET(NODE))
SET ORBDIVN=$PIECE(NODE,U)
End DoDot:1
+31 ;
+32 ;get system flag:
+33 SET ORBSYSF=$$GET^XPAR("SYS","ORB PROCESSING FLAG",ORN,"I")
+34 ;
+35 ;get OE/RR package-export flag:
+36 SET ORBPKGF=$$GET^XPAR("PKG","ORB PROCESSING FLAG",ORN,"I")
+37 ;
+38 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
+39 ;reliably determined, and many simultaneous outpt locations can occur):
+40 IF +$GET(ORBPT)>0
Begin DoDot:1
+41 NEW DFN
SET DFN=ORBPT
SET VA200=""
DO OERR^VADPT
+42 SET ORBLOC=+$GET(^DIC(42,+VAIN(4),44))
IF +$GET(ORBLOC)>0
Begin DoDot:2
+43 SET ORBLOCN=$PIECE(^SC(+ORBLOC,0),U)
+44 SET ORBLOCF=$$GET^XPAR(+$GET(ORBLOC)_";SC(","ORB PROCESSING FLAG",ORN,"I")
End DoDot:2
End DoDot:1
+45 KILL VA200,VAIN
+46 ;
+47 ;get user's service/section flag:
+48 SET ORBSRV=$GET(^VA(200,ORBUSR,5))
IF +ORBSRV>0
SET ORBSRV=$PIECE(ORBSRV,U)
Begin DoDot:1
+49 SET NODE=$GET(^DIC(49,ORBSRV,0))
IF $LENGTH($GET(NODE))
SET ORBSRVN=$PIECE(NODE,U)
+50 IF +$GET(ORBSRV)>0
SET ORBSRVF=$$GET^XPAR(ORBSRV_";DIC(49,","ORB PROCESSING FLAG",ORN,"I")
End DoDot:1
+51 ;
+52 ;get user's team flag:
+53 IF $LENGTH($GET(ORBTEAM))
SET ORBTEAF=$PIECE(ORBTEAM,U)
SET ORBTEAN=$PIECE(ORBTEAM,U,2)
+54 ;
+55 ;get class flag for the user's most recently active ASU class
+56 ;S ORBCLS=$$RECENT(ORBUSR) I $L($G(ORBCLS))>0 D
+57 ;.S ORBCLSN=$P(ORBCLS,U,2),ORBCLS=$P(ORBCLS,U)
+58 ;.S:+$G(ORBCLS)>0 ORBCLSF=$$GET^XPAR(ORBCLS_";USR(8930,","ORB PROCESSING FLAG",ORN,"I")
+59 ;
+60 ;get user's flag:
+61 SET ORBUSRF=$$GET^XPAR(ORBUSR_";VA(200,","ORB PROCESSING FLAG",ORN,"I")
+62 ;
+63 ;determine overall flag:
+64 IF $GET(ORBUSRF)="M"
QUIT "ON^User "_ORBUSRN_" is Mandatory.^User value is Mandatory"
+65 IF $GET(ORBUSRF)="E"
QUIT "ON^User "_ORBUSRN_" is Enabled.^User value is Enabled"
+66 ;I $G(ORBCLSF)="M" Q "ON^User's class "_ORBCLSN_" is Mandatory.^User's class "_ORBCLSN_" value is Mandatory"
+67 IF $GET(ORBTEAF)="M"
QUIT "ON^User's team "_ORBTEAN_" is Mandatory.^User's team "_ORBTEAN_" value is Mandatory"
+68 IF $GET(ORBTEAF)="D"
QUIT "OFF^User's team "_ORBTEAN_" is Disabled.^User's team "_ORBTEAN_" value is Disabled"
+69 IF $GET(ORBSRVF)="M"
QUIT "ON^User's service "_ORBSRVN_" is Mandatory.^User's service "_ORBSRVN_" value is Mandatory"
+70 IF $GET(ORBLOCF)="M"
QUIT "ON^Patient's location "_ORBLOCN_" is Mandatory.^Pt's location "_ORBLOCN_" value is Mandatory"
+71 IF $GET(ORBLOCF)="D"
QUIT "OFF^Patient's location "_ORBLOCN_" is Disabled.^Pt's location "_ORBLOCN_" value is Disabled"
+72 IF $GET(ORBDIVF)="M"
IF ($GET(ORBLOCF)="")
QUIT "ON^Division "_ORBDIVN_" is Mandatory, no Pt Location value.^Division "_ORBDIVN_" value is Mandatory"
+73 IF $GET(ORBSYSF)="M"
IF ($GET(ORBDIVF)="")
IF ($GET(ORBLOCF)="")
QUIT "ON^System default is Mandatory, no Division or Pt Location values.^System value is Mandatory"
+74 IF $GET(ORBPKGF)="M"
IF ($GET(ORBSYSF)="")
IF ($GET(ORBDIVF)="")
IF ($GET(ORBLOCF)="")
QUIT "ON^OERR default is Mandatory, no Division, System, or Pt Location values.^OERR value is Mandatory"
+75 IF $GET(ORBUSRF)="D"
QUIT "OFF^User "_ORBUSRN_" is Disabled - no Mandatory values found.^User value is Disabled"
+76 ;I $G(ORBCLSF)="D" Q "OFF^User's class "_ORBCLSN_" is Disabled - no Mandatory values found.^User's class "_ORBCLSN_" value is Disabled""
+77 IF $GET(ORBTEAF)="E"
QUIT "ON^User's team "_ORBTEAN_" is Enabled.^User's team "_ORBTEAN_" value is Enabled"
+78 IF $GET(ORBSRVF)="D"
QUIT "OFF^User's service "_ORBSRVN_" is Disabled.^User's service "_ORBSRVN_" value is Disabled"
+79 IF $GET(ORBSRVF)="E"
QUIT "ON^User's service "_ORBSRVN_" is Enabled.^User's service "_ORBSRVN_" value is Enabled"
+80 IF $GET(ORBLOCF)="E"
QUIT "ON^Patient's location "_ORBLOCN_" is Enabled.^Pt's location "_ORBLOCN_" value is Enabled"
+81 IF $GET(ORBDIVF)="D"
QUIT "OFF^Division "_ORBDIVN_" is Disabled.^Division "_ORBDIVN_" value is Disabled"
+82 IF $GET(ORBDIVF)="E"
QUIT "ON^Division "_ORBDIVN_" is Enabled.^Division "_ORBDIVN_" value is Enabled"
+83 IF $GET(ORBSYSF)="D"
QUIT "OFF^System default is Disabled.^System value is Disabled"
+84 IF $GET(ORBSYSF)="E"
QUIT "ON^System default is Enabled.^System value is Enabled"
+85 IF $GET(ORBPKGF)="D"
QUIT "OFF^OERR default is Disabled.^OERR value is Disabled"
+86 IF $GET(ORBPKGF)="E"
QUIT "ON^OERR default is Enabled.^OERR value is Enabled"
+87 QUIT "OFF^No Mandatory, Disabled or Enabled values found.^No Mandatory/Disabled/Enabled values"
+88 ;
RECENT(USER) ;ext funct rtns a user's most recent, active user class
+1 IF +$GET(USER)<1
QUIT "^Error: User not identified."
+2 NEW CLS,CLASS,INACT,ACT,ORX,INVDT,RESULT
+3 ;call api to determine user's class(es)
+4 IF '$LENGTH($GET(CLS(0)))
QUIT "^No user classes found."
+5 DO NOW^%DTC
+6 SET CLASS=""
FOR
SET CLASS=$ORDER(CLS(CLASS))
IF CLASS=""
QUIT
Begin DoDot:1
+7 SET INACT=$PIECE(CLS(CLASS),U,5)
SET ACT=$PIECE(CLS(CLASS),U,4)
+8 ;quit if class has an inactive date before now
IF INACT
IF (INACT<%)
QUIT
+9 ;quit if class has no active date
IF 'ACT
QUIT
+10 SET ORX("DT",9999999-ACT)=$PIECE(CLS(CLASS),U)_U_CLASS
End DoDot:1
+11 SET INVDT=""
SET INVDT=$ORDER(ORX("DT",INVDT))
+12 IF INVDT
SET RESULT=ORX("DT",INVDT)
+13 IF '$TEST
SET RESULT="^No user classes found."
+14 KILL %
+15 QUIT RESULT
DIVF(USER,ORN,ORNUM) ;ext funct rtns user's division value for ORB PROCESSING FLAG
+1 NEW DIV,DIVF,MDIVF,EDIVF,DDIVF
+2 IF +$GET(ORNUM)
Begin DoDot:1
+3 SET DIVF=""
+4 SET DIV=$$ORDIV^ORB31(ORNUM)
+5 IF +$GET(DIV)'>0
QUIT
+6 SET DIVF=$$GET^XPAR(DIV_";DIC(4,","ORB PROCESSING FLAG",ORN,"I")
+7 IF $LENGTH(DIVF)
SET DIVF=DIV_U_DIVF
End DoDot:1
QUIT DIVF
+8 SET DIV=0
SET (DIVF,MDIVF,EDIVF,DDIVF)=""
+9 FOR
SET DIV=$ORDER(^VA(200,USER,2,"B",DIV))
IF +$GET(DIV)<1!(DIVF="M")
QUIT
Begin DoDot:1
+10 SET DIVF=$$GET^XPAR(DIV_";DIC(4,","ORB PROCESSING FLAG",ORN,"I")
+11 IF DIVF="M"
SET MDIVF=DIV_U_DIVF
+12 IF DIVF="E"
SET EDIVF=DIV_U_DIVF
+13 IF DIVF="D"
SET DDIVF=DIV_U_DIVF
End DoDot:1
+14 IF $LENGTH(MDIVF)
QUIT MDIVF
+15 IF $LENGTH(EDIVF)
QUIT EDIVF
+16 IF $LENGTH(DDIVF)
QUIT DDIVF
+17 QUIT ""
