- ORB3USER ;SLC/CLA - Alert Recipient Algorithms for OE/RR 3 Notifications;Apr 21, 2021@11:13:50
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**74,91,105,139,200,220,458,377,498**;Dec 17, 1997;Build 38
- USER(XQA,ORBDUZ,ORN,ORBU,ORBUI,ORBDFN,ORNUM,ORWHY) ;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]
- ;ORWHY reason why user is a recipient [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 $G(ORWHY)'="" S ORBU(ORBUI)=" Reason: "_ORWHY,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,6)="SMART" ;quit if a SMART alert
- 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)
- .S ORBDIVN=$$GET1^DIQ(4,+ORBDIV_",",.01)
- ;
- ;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:
- ;458 if ORMNDFLG exists and notification is M set flag to 1 for mandatory
- I $G(ORBUSRF)="M" S:$D(ORMNDFLG) ORMNDFLG=1 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" S:$D(ORMNDFLG) ORMNDFLG=1 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" S:$D(ORMNDFLG) ORMNDFLG=1 Q "ON^User's service "_ORBSRVN_" is Mandatory.^User's service "_ORBSRVN_" value is Mandatory"
- I $G(ORBLOCF)="M" S:$D(ORMNDFLG) ORMNDFLG=1 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)="") S:$D(ORMNDFLG) ORMNDFLG=1 Q "ON^Division "_ORBDIVN_" is Mandatory, no Pt Location value.^Division "_ORBDIVN_" value is Mandatory"
- I $G(ORBSYSF)="M",($G(ORBDIVF)=""),($G(ORBLOCF)="") S:$D(ORMNDFLG) ORMNDFLG=1 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)="") S:$D(ORMNDFLG) ORMNDFLG=1 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 ""
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3USER 9711 printed Jan 18, 2025@03:28:44 Page 2
- ORB3USER ;SLC/CLA - Alert Recipient Algorithms for OE/RR 3 Notifications;Apr 21, 2021@11:13:50
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**74,91,105,139,200,220,458,377,498**;Dec 17, 1997;Build 38
- USER(XQA,ORBDUZ,ORN,ORBU,ORBUI,ORBDFN,ORNUM,ORWHY) ;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 ;ORWHY reason why user is a recipient [optional]
- +10 ;
- +11 NEW ORBNODE,ORBSUR,ORBTM,ORBTMF,ORBTEAM,ORBON,ORBDUP
- +12 IF $GET(ORBDUZ)["G."
- SET XQA(ORBDUZ)=""
- QUIT
- +13 if +$GET(ORBDUZ)<.5
- QUIT
- +14 ;
- +15 ;if user recip via team
- SET ORBTM=$PIECE(ORBDUZ,U,2)
- IF $LENGTH(ORBTM)
- Begin DoDot:1
- +16 SET ORBTMF=$$GET^XPAR(ORBTM_";OR(100.21,","ORB PROCESSING FLAG",ORN,"I")
- +17 SET ORBTEAM=ORBTMF_U_$PIECE(^OR(100.21,ORBTM,0),U)
- +18 IF $DATA(ORBU)
- Begin DoDot:2
- +19 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
- +20 ;
- +21 IF '$DATA(ORBU)
- Begin DoDot:1
- +22 IF $LENGTH($GET(ORBTMF))=0
- Begin DoDot:2
- +23 if $DATA(^XTMP("ORBUSER",$JOB,+ORBDUZ))
- SET ORBDUP=1
- +24 SET ^XTMP("ORBUSER",$JOB,+ORBDUZ)=""
- End DoDot:2
- End DoDot:1
- +25 ;quit if user already processed and no team param value
- if $GET(ORBDUP)=1
- QUIT
- +26 ;
- +27 SET ORBDUZ=$PIECE(ORBDUZ,U)
- +28 ;
- +29 if $GET(ORBTEAM)=""
- SET ORBTEAM="^"
- +30 SET ORBON=$$ONOFF(ORN,ORBDUZ,ORBDFN,ORBTEAM,$GET(ORNUM))
- +31 IF $DATA(ORBU)
- Begin DoDot:1
- +32 SET ORBNODE=$GET(^VA(200,ORBDUZ,0))
- IF $LENGTH($GET(ORBNODE))
- Begin DoDot:2
- +33 SET ORBU(ORBUI)=" "_$PIECE(ORBNODE,U)_": "_$PIECE(ORBON,U)_" because "
- SET ORBUI=ORBUI+1
- +34 SET ORBU(ORBUI)=" "_$PIECE(ORBON,U,2)
- SET ORBUI=ORBUI+1
- +35 IF $GET(ORWHY)'=""
- SET ORBU(ORBUI)=" Reason: "_ORWHY
- SET ORBUI=ORBUI+1
- End DoDot:2
- End DoDot:1
- +36 IF $DATA(ORBU)
- IF ($PIECE(ORBON,U)="ON")
- IF ($GET(ORBDUZ)'["G.")
- Begin DoDot:1
- +37 ;DBIA 2790 Alert surrogate
- SET ORBSUR=$$ACTVSURO^XQALSURO(ORBDUZ)
- +38 IF +$GET(ORBSUR)>0
- Begin DoDot:2
- +39 SET ORBU(ORBUI)=" [Surrogate "_$$GET1^DIQ(200,ORBSUR_",",.01)_" will receive alert for user]"
- SET ORBUI=ORBUI+1
- End DoDot:2
- End DoDot:1
- +40 ;quit if user is disabled for this notif
- if $PIECE(ORBON,U)="OFF"
- QUIT
- +41 ;quit if entered rtn via UTL (do not sent alert)
- if $DATA(ORBU)
- QUIT
- +42 ;if user has undel prev alert, delete it
- DO PREALERT(ORBDUZ,ORN,ORBDFN)
- +43 ;send alert to the user
- SET XQA(ORBDUZ)=""
- +44 QUIT
- +45 ;
- 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 a SMART alert
- if $PIECE(^ORD(100.9,ORN,0),U,6)="SMART"
- QUIT
- +4 ;quit if not a "NOT" notif/alert
- if $PIECE(^ORD(100.9,ORN,0),U,4)'="NOT"
- QUIT
- +5 NEW XQAID,XQAKILL,XQAUSER,ORBDT
- +6 SET XQAID="OR,"_ORBDFN_","_ORN
- +7 ;DBIA# 2689
- IF $DATA(^XTV(8992,"AXQAN",XQAID,ORBDUZ))
- Begin DoDot:1
- +8 SET ORBDT=0
- SET ORBDT=$ORDER(^XTV(8992,"AXQAN",XQAID,ORBDUZ,ORBDT))
- +9 IF $GET(ORBDT)>0
- Begin DoDot:2
- +10 SET XQAUSER=ORBDUZ
- +11 SET XQAKILL=1
- +12 DO DELETEA^XQALERT
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- 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)
- +30 SET ORBDIVN=$$GET1^DIQ(4,+ORBDIV_",",.01)
- 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 ;458 if ORMNDFLG exists and notification is M set flag to 1 for mandatory
- +65 IF $GET(ORBUSRF)="M"
- if $DATA(ORMNDFLG)
- SET ORMNDFLG=1
- QUIT "ON^User "_ORBUSRN_" is Mandatory.^User value is Mandatory"
- +66 IF $GET(ORBUSRF)="E"
- QUIT "ON^User "_ORBUSRN_" is Enabled.^User value is Enabled"
- +67 ;I $G(ORBCLSF)="M" Q "ON^User's class "_ORBCLSN_" is Mandatory.^User's class "_ORBCLSN_" value is Mandatory"
- +68 IF $GET(ORBTEAF)="M"
- if $DATA(ORMNDFLG)
- SET ORMNDFLG=1
- QUIT "ON^User's team "_ORBTEAN_" is Mandatory.^User's team "_ORBTEAN_" value is Mandatory"
- +69 IF $GET(ORBTEAF)="D"
- QUIT "OFF^User's team "_ORBTEAN_" is Disabled.^User's team "_ORBTEAN_" value is Disabled"
- +70 IF $GET(ORBSRVF)="M"
- if $DATA(ORMNDFLG)
- SET ORMNDFLG=1
- QUIT "ON^User's service "_ORBSRVN_" is Mandatory.^User's service "_ORBSRVN_" value is Mandatory"
- +71 IF $GET(ORBLOCF)="M"
- if $DATA(ORMNDFLG)
- SET ORMNDFLG=1
- QUIT "ON^Patient's location "_ORBLOCN_" is Mandatory.^Pt's location "_ORBLOCN_" value is Mandatory"
- +72 IF $GET(ORBLOCF)="D"
- QUIT "OFF^Patient's location "_ORBLOCN_" is Disabled.^Pt's location "_ORBLOCN_" value is Disabled"
- +73 IF $GET(ORBDIVF)="M"
- IF ($GET(ORBLOCF)="")
- if $DATA(ORMNDFLG)
- SET ORMNDFLG=1
- QUIT "ON^Division "_ORBDIVN_" is Mandatory, no Pt Location value.^Division "_ORBDIVN_" value is Mandatory"
- +74 IF $GET(ORBSYSF)="M"
- IF ($GET(ORBDIVF)="")
- IF ($GET(ORBLOCF)="")
- if $DATA(ORMNDFLG)
- SET ORMNDFLG=1
- QUIT "ON^System default is Mandatory, no Division or Pt Location values.^System value is Mandatory"
- +75 IF $GET(ORBPKGF)="M"
- IF ($GET(ORBSYSF)="")
- IF ($GET(ORBDIVF)="")
- IF ($GET(ORBLOCF)="")
- if $DATA(ORMNDFLG)
- SET ORMNDFLG=1
- QUIT "ON^OERR default is Mandatory, no Division, System, or Pt Location values.^OERR value is Mandatory"
- +76 IF $GET(ORBUSRF)="D"
- QUIT "OFF^User "_ORBUSRN_" is Disabled - no Mandatory values found.^User value is Disabled"
- +77 ;I $G(ORBCLSF)="D" Q "OFF^User's class "_ORBCLSN_" is Disabled - no Mandatory values found.^User's class "_ORBCLSN_" value is Disabled""
- +78 IF $GET(ORBTEAF)="E"
- QUIT "ON^User's team "_ORBTEAN_" is Enabled.^User's team "_ORBTEAN_" value is Enabled"
- +79 IF $GET(ORBSRVF)="D"
- QUIT "OFF^User's service "_ORBSRVN_" is Disabled.^User's service "_ORBSRVN_" value is Disabled"
- +80 IF $GET(ORBSRVF)="E"
- QUIT "ON^User's service "_ORBSRVN_" is Enabled.^User's service "_ORBSRVN_" value is Enabled"
- +81 IF $GET(ORBLOCF)="E"
- QUIT "ON^Patient's location "_ORBLOCN_" is Enabled.^Pt's location "_ORBLOCN_" value is Enabled"
- +82 IF $GET(ORBDIVF)="D"
- QUIT "OFF^Division "_ORBDIVN_" is Disabled.^Division "_ORBDIVN_" value is Disabled"
- +83 IF $GET(ORBDIVF)="E"
- QUIT "ON^Division "_ORBDIVN_" is Enabled.^Division "_ORBDIVN_" value is Enabled"
- +84 IF $GET(ORBSYSF)="D"
- QUIT "OFF^System default is Disabled.^System value is Disabled"
- +85 IF $GET(ORBSYSF)="E"
- QUIT "ON^System default is Enabled.^System value is Enabled"
- +86 IF $GET(ORBPKGF)="D"
- QUIT "OFF^OERR default is Disabled.^OERR value is Disabled"
- +87 IF $GET(ORBPKGF)="E"
- QUIT "ON^OERR default is Enabled.^OERR value is Enabled"
- +88 QUIT "OFF^No Mandatory, Disabled or Enabled values found.^No Mandatory/Disabled/Enabled values"
- +89 ;
- 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 ""