ORB3.m

ORB3 ; slc/CLA,WAT - Main routine for OE/RR 3 notifications ;23-Nov-2011 11:43;PLS

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,74,91,105,139,190,1002,1004,220,253,265,296,1010**;Dec 17, 1997;Build 47

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 ;This routine invokes to following ICR(s):

 ;ICR 4156     ;REGISTRATION, COMBAT VETERAN STATUS

 ;Modified - IHS/CIA/MGH - 5/14/2010 - Line TITLE+15, IHSPRIM, IHSTEAM and IHSDP

EN(ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA) ;

 ;

 N ORBENT

 S ORBENT=$$ENTITY^ORB31(ORNUM)

 ;

 Q:$$GET^XPAR(ORBENT,"ORB SYSTEM ENABLE/DISABLE",1,"I")="D"

 Q:'$L($G(^ORD(100.9,ORN,0)))

 Q:+$$ONOFF^ORB3FN(ORN)=0

 ;

 S ORBPMSG=$E($G(ORBPMSG),1,51)

 ;

 ;if msg from notif file or oc notif (#54), quit if dup w/in past 1 min:

 N ORBDUP,ORBN

 S ORBN=^ORD(100.9,ORN,0)

 I ($P(ORBN,"^",4)="NOT")!(ORN=54) D

 .S ORBDUP=$$DUP^ORB31(ORN,ORBDFN,ORBPMSG,ORNUM)

 Q:+$G(ORBDUP)=1

 ;

 N ORBDESC

 S ORBDESC=" Send Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_"  "

 ;

 D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$H,ORBDESC,$G(DGPMA))

 Q

ZTSK ;

 D START

 S ZTREQ="@"

 Q

UTL(ORBU,ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA) ;

 Q:$G(ORBU)'=1

START Q:$G(ORN)=""!($G(ORBDFN)="")

 Q:'$L($G(^ORD(100.9,ORN,0)))

 N ORBNOW,ORBID,ORBLOCK,ORBDESC

 S ORBNOW=$$NOW^XLFDT

 S ORBLOCK=0

 ;

 ;lock to prevent concurrent processing by other resource slots:

 I '$D(ORBU) D

 .S ^XTMP("ORBLOCK",0)=$$FMADD^XLFDT(ORBNOW,1,"","","")_"^"_ORBNOW

 .S ORBID=$P($P($G(ORBPDATA),"|",2),"@")  ;get unique data id

 .I $L(ORBID) D

 ..LOCK +^XTMP("ORBLOCK",ORBDFN,ORN,ORBID):60 E  D  Q

 ...S ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_"  "

 ...D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$$HADD^XLFDT($H,"","",5,""),ORBDESC,$G(DGPMA)) ;requeue in 5 min.

 ...S ORBLOCK=1

 .;

 .I '$L(ORBID) D

 ..LOCK +^XTMP("ORBLOCK",ORBDFN,ORN):60 E  D  Q

 ...S ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_"  "

 ...D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$$HADD^XLFDT($H,"","",5,""),ORBDESC,$G(DGPMA)) ;requeue in 5 min.

 ...S ORBLOCK=1

 .;

 I ORBLOCK=1 D QUIT Q

 ;

DOALERT ; Entry point for alert logic outside of TaskMan

 N ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT

 N ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY

 S ORBUI=1,ORBADT=0

 S:'$L($G(ORBPMSG)) ORBPMSG=""

 I '$L(ORBPDATA),(+$G(ORNUM)>0) S ORBPDATA=+$G(ORNUM)_"@"

 S ORBN=^ORD(100.9,ORN,0)

 ;

 S ORBENT=$$ENTITY^ORB31(ORNUM)

 ;

 N DFN S DFN=ORBDFN,VA200="" D OERR^VADPT

 I ('$L($G(VA("BID"))))!('$L($G(VADM(1)))) D QUIT Q

 I (ORN=18)!(ORN=20)!(ORN=35) S ORBADT=1 ;A/D/T notif

 ;if not an A/D/T notif, get primary & attending from OERR^VADPT:

 I ORBADT=0 S ORBPRIM=+$P(VAIN(2),U),ORBATTD=+$P(VAIN(11),U)

 I ORBADT=1 D ADT^ORB31(ORN,ORBDFN,.ORBPRIM,.ORBATTD,$G(ORDGPMA)) ;A/D/T notif

 I $D(ORBU) D  ;create debug msg

 .S ORBU(ORBUI)="Processing notification: "_$P(ORBN,U),ORBUI=ORBUI+1

 .S ORBU(ORBUI)="            for patient: "_VADM(1),ORBUI=ORBUI+1

 .I $G(ORNUM)>0 S ORBU(ORBUI)="              for order: "_ORNUM,ORBUI=ORBUI+1

 D REGULAR^ORB3REG(ORN,.XQA,.ORBU,.ORBUI,.ORBDEV,ORBDFN)

 D SPECIAL^ORB3SPEC(ORN,.ORBASPEC,.ORBU,.ORBUI,$G(ORNUM),ORBDFN,$G(ORBPDATA),.ORBSMSG,$G(ORBPMSG),.ORBSDEV,$G(ORBPRIM),$G(ORBATTD))

 I $L($G(ORBSMSG)) S ORBPMSG=$E(ORBSMSG,1,51)

 I $D(ORBASPEC)>1 D SPECDUZS ;special recips

 I $D(ORBADUZ)>1 D PKGDUZS ;pkg-supplied recips

 D TITLE ;provider recips

 S ORBXQAID=$P(ORBN,"^",2)_","_ORBDFN_","_ORN

 ;

 I ($D(XQA)>1)!($D(ORBDEV)>1)!($D(ORBSDEV)>1) D  ;recips found

 .S XQAFLG=$P(ORBN,"^",5)

 .S XQADFN=ORBDFN

 .I XQAFLG="R" S XQAROU=$P(ORBN,"^",6)_"^"_$P(ORBN,"^",7)

 .I $G(ORBPDATA)'="" S XQADATA=ORBPDATA

 .S ORPTNAM=$E(VADM(1)_"         ",1,9)

 .I $G(ORN)=27 N CVMRKR,RSLT S RSLT=$$CVEDT^DGCV(DFN) I $P($G(RSLT),U)&($P($G(RSLT),U,3)) S CVMRKR=" CV "_$$FMTE^XLFDT($P($G(RSLT),U,2),"5DZ") ;WAT

 .S XQAMSG=ORPTNAM_" "_"("_$E(ORPTNAM)_$E(VA("BID"),1,4)_")"_$G(CVMRKR)_": " ;WAT

 .S XQAMSG=XQAMSG_$S(ORBPMSG'="":ORBPMSG,1:$P(ORBN,"^",3))

 .S XQAARCH=$$GET^XPAR(ORBENT,"ORB ARCHIVE PERIOD",ORN,"I")

 .S XQASUPV=$$GET^XPAR(ORBENT,"ORB FORWARD SUPERVISOR",ORN,"I")

 .S XQASURO=$$GET^XPAR(ORBENT,"ORB FORWARD SURROGATES",ORN,"I")

 .S XQAREVUE=$$GET^XPAR(ORBENT,"ORB FORWARD BACKUP REVIEWER",ORN,"I")

 .S XQACNDEL=$$GET^XPAR(ORBENT,"ORB REMOVE",ORN,"I")

 .S XQACNDEL=$S(XQACNDEL=1:1,1:"")

 .I $D(ORBDEV)>1 D REGDEV^ORB31(.ORBDEV)

 .I $D(ORBSDEV)>1 D REGDEV^ORB31(.ORBSDEV)

 .I $D(ORBTDEV)>1 D REGDEV^ORB31(.ORBTDEV)

 .S XQAID=ORBXQAID

 .I $D(XQA) D SETUP^XQALERT  ;if no [new] recips don't send alert

QUIT ;

 K VA,VA200,VADM,VAERR,VAIN,XQA,XQADATA,XQAID,XQAFLG,XQAMSG,XQAROU,XQAARCH,XQASUPV,XQASURO,XQADFN

 K ^XTMP("ORBUSER",$J)

 I '$D(ORBU),$D(ORBLOCK) D

 .I $G(ORBID)]"" LOCK -^XTMP("ORBLOCK",ORBDFN,ORN,ORBID)

 .E  LOCK -^XTMP("ORBLOCK",ORBDFN,ORN)

 Q

PKGDUZS ;get DUZs from pkg-passed ORBADUZ() array

 N ORBPDUZ

 I $D(ORBU) D

 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1

 .I ORN=68 S ORBU(ORBUI)="Recipients with Lab Threshold Exceeded:",ORBUI=ORBUI+1

 .E  S ORBU(ORBUI)="Recipients defined when notif was triggered:",ORBUI=ORBUI+1

 S ORBPDUZ=""

 F  S ORBPDUZ=$O(ORBADUZ(ORBPDUZ)) Q:ORBPDUZ=""  S ORBDUZ=ORBPDUZ D USER

 Q

SPECDUZS ;get DUZs rtn by SPECIAL^ORB3SPEC

 N ORBSDUZ

 I $D(ORBU) D

 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1

 .S ORBU(ORBUI)="Special recipients associated with the notification:",ORBUI=ORBUI+1

 S ORBSDUZ=""

 F  S ORBSDUZ=$O(ORBASPEC(ORBSDUZ)) Q:ORBSDUZ=""  S ORBDUZ=ORBSDUZ D USER

 Q

TITLE ;get provider recips

 N TITLES

 I $D(ORBU) D

 .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1

 .S ORBU(ORBUI)="Recipients determined by Provider Recipient parameter:",ORBUI=ORBUI+1

 ;

 S TITLES=$$GET^XPAR(ORBENT,"ORB PROVIDER RECIPIENTS",ORN,"I")

 I TITLES["P" D PRIMARY

 I TITLES["A" D ATTEND

 I TITLES["T" D TEAMS

 I TITLES["O" D ORDERER

 I TITLES["E" D ENTERBY

 I TITLES["R" D PCMMPRIM

 I TITLES["S" D PCMMASSC

 I TITLES["M" D PCMMTEAM

 ;IHS/CIA/MGH Next 3 choices were for provider recipients

 I TITLES["D" D IHSPRIM

 I TITLES["I" D IHSTEAM

 I TITLES["G" D IHSDP

 Q

PRIMARY ;

 I $D(ORBU),ORBADT=0 S ORBU(ORBUI)=" Inpt primary provider:",ORBUI=ORBUI+1

 I $D(ORBU),ORBADT=1 S ORBU(ORBUI)=" Inpt primary provider: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1

 I +$G(ORBPRIM)>0 S ORBDUZ=ORBPRIM D USER

 Q

ATTEND ;

 I $D(ORBU),ORBADT=0 S ORBU(ORBUI)=" Attending physician:",ORBUI=ORBUI+1

 I $D(ORBU),ORBADT=1 S ORBU(ORBUI)=" Attending physician: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1

 I +$G(ORBATTD)>0 S ORBDUZ=ORBATTD D USER

 Q

TEAMS ;

 I $D(ORBU) S ORBU(ORBUI)=" Teams/Personal Lists related to patient:",ORBUI=ORBUI+1

 N ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD

 D TMSPT^ORQPTQ1(.ORBLST,ORBDFN)

 Q:+$G(ORBLST(1))<1

 S ORBI="" F  S ORBI=$O(ORBLST(ORBI)) Q:ORBI=""  D

 .S ORBTM=$P(ORBLST(ORBI),U),ORBTNAME=$P(ORBLST(ORBI),U,2)

 .S ORBTTYPE=$P(ORBLST(ORBI),U,3)

 .I $D(ORBU) D

 ..S ORBU(ORBUI)="  Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:",ORBUI=ORBUI+1

 .N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)

 .Q:+$G(ORBLST2(1))<1

 .S ORBJ="" F  S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ=""  D

 ..S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBTM I +$G(ORBDUZ)>0 D USER

 .;

 .S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2)  ;Team's device

 .I $L(ORBTD) D

 ..S ORBTDEV(ORBTD)=""

 ..I $D(ORBU) D

 ...S ORBU(ORBUI)="   Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1

 Q

ORDERER ;

 Q:+$G(ORNUM)<1

 I $D(ORBU) S ORBU(ORBUI)=" Ordering provider:",ORBUI=ORBUI+1

 N ORBLST,ORBI,ORBTM,ORBJ,ORBTNAME,ORBPLST,ORBPI,ORBPTM,ORBTTYPE

 S ORBDUZ=$S(ORN=12:+$$UNSIGNOR^ORQOR2(ORNUM),1:$$ORDERER^ORQOR2(ORNUM))

 I +$G(ORBDUZ)>0 D

 .D USER

 .;if notif = Order Req E/S (#12) or Order Req Co-sign (#37) and

 .;user doesn't have ES authority, send to fellow team members w/ES:

 .I ((ORN=12)!(ORN=37)),('$D(^XUSEC("ORES",ORBDUZ))) D

 ..I $D(ORBU) S ORBU(ORBUI)=" Orderer can't elec sign, getting teams orderer belongs to:",ORBUI=ORBUI+1

 ..D TEAMPR^ORQPTQ1(.ORBLST,ORBDUZ)  ;get orderer's tms

 ..Q:+$G(ORBLST(1))<1

 ..D TMSPT^ORQPTQ1(.ORBPLST,ORBDFN)  ;get pt's tms

 ..Q:+$G(ORBPLST(1))<1

 ..S ORBI="" F  S ORBI=$O(ORBLST(ORBI)) Q:ORBI=""  D

 ...S ORBPI="" F  S ORBPI=$O(ORBPLST(ORBPI)) Q:ORBPI=""  D

 ....S ORBTM=$P(ORBLST(ORBI),U),ORBPTM=$P(ORBPLST(ORBPI),U)

 ....I ORBTM=ORBPTM D  ;if pt is on provider's team

 .....I +$G(ORBPTM)>0 D

 ......S ORBTNAME=$P(ORBPLST(ORBPI),U,2)

 ......S ORBTTYPE=$P(ORBPLST(ORBPI),U,3)

 ......I $D(ORBU) S ORBU(ORBUI)="  Orderer's pt list "_ORBTNAME_" ["_ORBTTYPE_"] recipients: ",ORBUI=ORBUI+1

 ......N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBPTM)

 ......Q:+$G(ORBLST2(1))<1

 ......S ORBJ="" F  S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ=""  D

 .......S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBPTM I +$G(ORBDUZ)>0,($D(^XUSEC("ORES",+ORBDUZ))) D USER

 Q

ENTERBY ;

 I $D(ORBU) S ORBU(ORBUI)=" User entering order's most recent activity:",ORBUI=ORBUI+1

 Q:+$G(ORNUM)<1

 I $D(^OR(100,ORNUM,8,0)) D

 .S ORBDUZ=$P(^OR(100,ORNUM,8,$P(^OR(100,ORNUM,8,0),U,3),0),U,13)

 I +$G(ORBDUZ)>0 D USER

 Q

PCMMPRIM ;

 I $D(ORBU) S ORBU(ORBUI)=" PCMM Primary Care Practitioner:",ORBUI=ORBUI+1

 S ORBDUZ=+$$OUTPTPR^SDUTL3(ORBDFN,$$NOW^XLFDT,1)  ;DBIA #1252

 I +$G(ORBDUZ)>0 D USER

 Q

PCMMASSC ;

 I $D(ORBU) S ORBU(ORBUI)=" PCMM Associate Provider:",ORBUI=ORBUI+1

 S ORBDUZ=+$$OUTPTAP^SDUTL3(ORBDFN,$$NOW^XLFDT)  ;DBIA #1252

 I +$G(ORBDUZ)>0 D USER

 Q

PCMMTEAM ;

 N ORPCMM,ORPCMMDZ

 I $D(ORBU) S ORBU(ORBUI)=" PCMM Team Position Assignments:",ORBUI=ORBUI+1

 S ORPCMM=$$PRPT^SCAPMC(ORBDFN,,,,,,"^TMP(""ORPCMM"",$J)",)  ;DBIA #1916

 S ORPCMMDZ=0

 F  S ORPCMMDZ=$O(^TMP("ORPCMM",$J,"SCPR",ORPCMMDZ)) Q:'ORPCMMDZ  D

 .S ORBDUZ=ORPCMMDZ D USER

 K ^TMP("ORPCMM",$J)

 Q

 ;IHS/CIA/MGH

IHSPRIM ;Send alert to designated provider

 I $D(ORBU) S ORBU(ORBUI)=" IHS Primary Care Provider:",ORBUI=ORBUI+1

 S ORBDUZ=$$GET1^DIQ(9000001,ORBDFN,.14,"I")  ;pcp ien

 I +$G(ORBDUZ)>0 D USER

 Q

IHSTEAM ;IHS/CIA/MGH

 ;Send alert to primary team

 N ORIHS,ORIHDUZ

 I $D(ORBU) S ORBU(ORBUI)=" IHS Primary Care Team:",ORBUI=ORBUI+1

 S ORBDUZ=$$GET1^DIQ(9000001,ORBDFN,.14,"I")

 I +$G(ORBDUZ)>0 D TEAM^BEHOPTPC(ORBDUZ)

 S ORIHDUZ=""

 F  S ORIHDUZ=$O(^TMP("ORIHS",$J,ORIHDUZ)) Q:ORIHDUZ=""  D

 .S ORBDUZ=ORIHDUZ D USER

 K ^TMP("ORIHS",$J)

 Q

 ;IHS/CIA/MGH - Send alert to all designated providers

IHSDP N I,X,BDPQ,BEHOTYPE,BEHOCT,BEHOPR,BDPCPRV,BEHORIEN

 Q:'$D(^BDPRECN("AA",ORBDFN))

 I $D(ORBU) S ORBU(ORBUI)=" IHS Designated Providers:",ORBUI=ORBUI+1

 S I=0,BDPQ=0,BEHOTYPE="",BEHOCT=0

 F  S BEHOTYPE=$O(^BDPRECN("AA",ORBDFN,BEHOTYPE)) Q:BEHOTYPE=""  D

 .S BEHOPR=0

 .F  S BEHOPR=$O(^BDPRECN("AA",ORBDFN,BEHOTYPE,BEHOPR)) Q:BEHOPR=""  D

 ..S ORBDUZ=$P($G(^BDPRECN(BEHOPR,0)),U,3)                           ;Current Provider IEN

 ..D USER

 Q

USER ;should USER (ORBDUZ) be a recip

 D USER^ORB3USER(.XQA,ORBDUZ,ORN,.ORBU,.ORBUI,ORBDFN,+$G(ORNUM))

 Q

ORB3      ; slc/CLA,WAT - Main routine for OE/RR 3 notifications ;23-Nov-2011 11:43;PLS

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,74,91,105,139,190,1002,1004,220,253,265,296,1010**;Dec 17, 1997;Build 47

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ;This routine invokes to following ICR(s):

 +5       ;ICR 4156     ;REGISTRATION, COMBAT VETERAN STATUS

 +6       ;Modified - IHS/CIA/MGH - 5/14/2010 - Line TITLE+15, IHSPRIM, IHSTEAM and IHSDP

EN(ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA) ;

 +1       ;

 +2        NEW ORBENT

 +3        SET ORBENT=$$ENTITY^ORB31(ORNUM)

 +4       ;

 +5        IF $$GET^XPAR(ORBENT,"ORB SYSTEM ENABLE/DISABLE",1,"I")="D"

               QUIT 

 +6        IF '$LENGTH($GET(^ORD(100.9,ORN,0)))

               QUIT 

 +7        IF +$$ONOFF^ORB3FN(ORN)=0

               QUIT 

 +8       ;

 +9        SET ORBPMSG=$EXTRACT($GET(ORBPMSG),1,51)

 +10      ;

 +11      ;if msg from notif file or oc notif (#54), quit if dup w/in past 1 min:

 +12       NEW ORBDUP,ORBN

 +13       SET ORBN=^ORD(100.9,ORN,0)

 +14       IF ($PIECE(ORBN,"^",4)="NOT")!(ORN=54)

               Begin DoDot:1

 +15               SET ORBDUP=$$DUP^ORB31(ORN,ORBDFN,ORBPMSG,ORNUM)

               End DoDot:1

 +16       IF +$GET(ORBDUP)=1

               QUIT 

 +17      ;

 +18       NEW ORBDESC

 +19       SET ORBDESC=" Send Alert Notification ("_(+ORN)_") "_$PIECE($GET(^ORD(100.9,+ORN,0)),U,1)_"  "

 +20      ;

 +21       DO QUEUE^ORB31(ORN,ORBDFN,$GET(ORNUM),.ORBADUZ,$GET(ORBPMSG),$GET(ORBPDATA),$HOROLOG,ORBDESC,$GET(DGPMA))

 +22       QUIT 

ZTSK      ;

 +1        DO START

 +2        SET ZTREQ="@"

 +3        QUIT 

UTL(ORBU,ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA) ;

 +1        IF $GET(ORBU)'=1

               QUIT 

START      IF $GET(ORN)=""!($GET(ORBDFN)="")

               QUIT 

 +1        IF '$LENGTH($GET(^ORD(100.9,ORN,0)))

               QUIT 

 +2        NEW ORBNOW,ORBID,ORBLOCK,ORBDESC

 +3        SET ORBNOW=$$NOW^XLFDT

 +4        SET ORBLOCK=0

 +5       ;

 +6       ;lock to prevent concurrent processing by other resource slots:

 +7        IF '$DATA(ORBU)

               Begin DoDot:1

 +8                SET ^XTMP("ORBLOCK",0)=$$FMADD^XLFDT(ORBNOW,1,"","","")_"^"_ORBNOW

 +9       ;get unique data id

                   SET ORBID=$PIECE($PIECE($GET(ORBPDATA),"|",2),"@")

 +10               IF $LENGTH(ORBID)

                       Begin DoDot:2

 +11                       LOCK +^XTMP("ORBLOCK",ORBDFN,ORN,ORBID):60

                          IF '$TEST

                               Begin DoDot:3

 +12                               SET ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$PIECE($GET(^ORD(100.9,+ORN,0)),U,1)_"  "

 +13      ;requeue in 5 min.

                                   DO QUEUE^ORB31(ORN,ORBDFN,$GET(ORNUM),.ORBADUZ,$GET(ORBPMSG),$GET(ORBPDATA),$$HADD^XLFDT($HOROLOG,"","",5,""),ORBDESC,$GET(DGPMA))

 +14                               SET ORBLOCK=1

                               End DoDot:3

                               QUIT 

                       End DoDot:2

 +15      ;

 +16               IF '$LENGTH(ORBID)

                       Begin DoDot:2

 +17                       LOCK +^XTMP("ORBLOCK",ORBDFN,ORN):60

                          IF '$TEST

                               Begin DoDot:3

 +18                               SET ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$PIECE($GET(^ORD(100.9,+ORN,0)),U,1)_"  "

 +19      ;requeue in 5 min.

                                   DO QUEUE^ORB31(ORN,ORBDFN,$GET(ORNUM),.ORBADUZ,$GET(ORBPMSG),$GET(ORBPDATA),$$HADD^XLFDT($HOROLOG,"","",5,""),ORBDESC,$GET(DGPMA))

 +20                               SET ORBLOCK=1

                               End DoDot:3

                               QUIT 

                       End DoDot:2

 +21      ;

               End DoDot:1

 +22       IF ORBLOCK=1

               DO QUIT

               QUIT 

 +23      ;

DOALERT   ; Entry point for alert logic outside of TaskMan

 +1        NEW ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT

 +2        NEW ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY

 +3        SET ORBUI=1

           SET ORBADT=0

 +4        IF '$LENGTH($GET(ORBPMSG))

               SET ORBPMSG=""

 +5        IF '$LENGTH(ORBPDATA)

               IF (+$GET(ORNUM)>0)

                   SET ORBPDATA=+$GET(ORNUM)_"@"

 +6        SET ORBN=^ORD(100.9,ORN,0)

 +7       ;

 +8        SET ORBENT=$$ENTITY^ORB31(ORNUM)

 +9       ;

 +10       NEW DFN

           SET DFN=ORBDFN

           SET VA200=""

           DO OERR^VADPT

 +11       IF ('$LENGTH($GET(VA("BID"))))!('$LENGTH($GET(VADM(1))))

               DO QUIT

               QUIT 

 +12      ;A/D/T notif

           IF (ORN=18)!(ORN=20)!(ORN=35)

               SET ORBADT=1

 +13      ;if not an A/D/T notif, get primary & attending from OERR^VADPT:

 +14       IF ORBADT=0

               SET ORBPRIM=+$PIECE(VAIN(2),U)

               SET ORBATTD=+$PIECE(VAIN(11),U)

 +15      ;A/D/T notif

           IF ORBADT=1

               DO ADT^ORB31(ORN,ORBDFN,.ORBPRIM,.ORBATTD,$GET(ORDGPMA))

 +16      ;create debug msg

           IF $DATA(ORBU)

               Begin DoDot:1

 +17               SET ORBU(ORBUI)="Processing notification: "_$PIECE(ORBN,U)

                   SET ORBUI=ORBUI+1

 +18               SET ORBU(ORBUI)="            for patient: "_VADM(1)

                   SET ORBUI=ORBUI+1

 +19               IF $GET(ORNUM)>0

                       SET ORBU(ORBUI)="              for order: "_ORNUM

                       SET ORBUI=ORBUI+1

               End DoDot:1

 +20       DO REGULAR^ORB3REG(ORN,.XQA,.ORBU,.ORBUI,.ORBDEV,ORBDFN)

 +21       DO SPECIAL^ORB3SPEC(ORN,.ORBASPEC,.ORBU,.ORBUI,$GET(ORNUM),ORBDFN,$GET(ORBPDATA),.ORBSMSG,$GET(ORBPMSG),.ORBSDEV,$GET(ORBPRIM),$GET(ORBATTD))

 +22       IF $LENGTH($GET(ORBSMSG))

               SET ORBPMSG=$EXTRACT(ORBSMSG,1,51)

 +23      ;special recips

           IF $DATA(ORBASPEC)>1

               DO SPECDUZS

 +24      ;pkg-supplied recips

           IF $DATA(ORBADUZ)>1

               DO PKGDUZS

 +25      ;provider recips

           DO TITLE

 +26       SET ORBXQAID=$PIECE(ORBN,"^",2)_","_ORBDFN_","_ORN

 +27      ;

 +28      ;recips found

           IF ($DATA(XQA)>1)!($DATA(ORBDEV)>1)!($DATA(ORBSDEV)>1)

               Begin DoDot:1

 +29               SET XQAFLG=$PIECE(ORBN,"^",5)

 +30               SET XQADFN=ORBDFN

 +31               IF XQAFLG="R"

                       SET XQAROU=$PIECE(ORBN,"^",6)_"^"_$PIECE(ORBN,"^",7)

 +32               IF $GET(ORBPDATA)'=""

                       SET XQADATA=ORBPDATA

 +33               SET ORPTNAM=$EXTRACT(VADM(1)_"         ",1,9)

 +34      ;WAT

                   IF $GET(ORN)=27

                       NEW CVMRKR,RSLT

                       SET RSLT=$$CVEDT^DGCV(DFN)

                       IF $PIECE($GET(RSLT),U)&($PIECE($GET(RSLT),U,3))

                           SET CVMRKR=" CV "_$$FMTE^XLFDT($PIECE($GET(RSLT),U,2),"5DZ")

 +35      ;WAT

                   SET XQAMSG=ORPTNAM_" "_"("_$EXTRACT(ORPTNAM)_$EXTRACT(VA("BID"),1,4)_")"_$GET(CVMRKR)_": "

 +36               SET XQAMSG=XQAMSG_$SELECT(ORBPMSG'="":ORBPMSG,1:$PIECE(ORBN,"^",3))

 +37               SET XQAARCH=$$GET^XPAR(ORBENT,"ORB ARCHIVE PERIOD",ORN,"I")

 +38               SET XQASUPV=$$GET^XPAR(ORBENT,"ORB FORWARD SUPERVISOR",ORN,"I")

 +39               SET XQASURO=$$GET^XPAR(ORBENT,"ORB FORWARD SURROGATES",ORN,"I")

 +40               SET XQAREVUE=$$GET^XPAR(ORBENT,"ORB FORWARD BACKUP REVIEWER",ORN,"I")

 +41               SET XQACNDEL=$$GET^XPAR(ORBENT,"ORB REMOVE",ORN,"I")

 +42               SET XQACNDEL=$SELECT(XQACNDEL=1:1,1:"")

 +43               IF $DATA(ORBDEV)>1

                       DO REGDEV^ORB31(.ORBDEV)

 +44               IF $DATA(ORBSDEV)>1

                       DO REGDEV^ORB31(.ORBSDEV)

 +45               IF $DATA(ORBTDEV)>1

                       DO REGDEV^ORB31(.ORBTDEV)

 +46               SET XQAID=ORBXQAID

 +47      ;if no [new] recips don't send alert

                   IF $DATA(XQA)

                       DO SETUP^XQALERT

               End DoDot:1

QUIT      ;

 +1        KILL VA,VA200,VADM,VAERR,VAIN,XQA,XQADATA,XQAID,XQAFLG,XQAMSG,XQAROU,XQAARCH,XQASUPV,XQASURO,XQADFN

 +2        KILL ^XTMP("ORBUSER",$JOB)

 +3        IF '$DATA(ORBU)

               IF $DATA(ORBLOCK)

                   Begin DoDot:1

 +4                    IF $GET(ORBID)]""

                           LOCK -^XTMP("ORBLOCK",ORBDFN,ORN,ORBID)

 +5                   IF '$TEST

                           LOCK -^XTMP("ORBLOCK",ORBDFN,ORN)

                   End DoDot:1

 +6        QUIT 

PKGDUZS   ;get DUZs from pkg-passed ORBADUZ() array

 +1        NEW ORBPDUZ

 +2        IF $DATA(ORBU)

               Begin DoDot:1

 +3                SET ORBU(ORBUI)=" "

                   SET ORBUI=ORBUI+1

 +4                IF ORN=68

                       SET ORBU(ORBUI)="Recipients with Lab Threshold Exceeded:"

                       SET ORBUI=ORBUI+1

 +5               IF '$TEST

                       SET ORBU(ORBUI)="Recipients defined when notif was triggered:"

                       SET ORBUI=ORBUI+1

               End DoDot:1

 +6        SET ORBPDUZ=""

 +7        FOR 

               SET ORBPDUZ=$ORDER(ORBADUZ(ORBPDUZ))

               IF ORBPDUZ=""

                   QUIT 

               SET ORBDUZ=ORBPDUZ

               DO USER

 +8        QUIT 

SPECDUZS  ;get DUZs rtn by SPECIAL^ORB3SPEC

 +1        NEW ORBSDUZ

 +2        IF $DATA(ORBU)

               Begin DoDot:1

 +3                SET ORBU(ORBUI)=" "

                   SET ORBUI=ORBUI+1

 +4                SET ORBU(ORBUI)="Special recipients associated with the notification:"

                   SET ORBUI=ORBUI+1

               End DoDot:1

 +5        SET ORBSDUZ=""

 +6        FOR 

               SET ORBSDUZ=$ORDER(ORBASPEC(ORBSDUZ))

               IF ORBSDUZ=""

                   QUIT 

               SET ORBDUZ=ORBSDUZ

               DO USER

 +7        QUIT 

TITLE     ;get provider recips

 +1        NEW TITLES

 +2        IF $DATA(ORBU)

               Begin DoDot:1

 +3                SET ORBU(ORBUI)=" "

                   SET ORBUI=ORBUI+1

 +4                SET ORBU(ORBUI)="Recipients determined by Provider Recipient parameter:"

                   SET ORBUI=ORBUI+1

               End DoDot:1

 +5       ;

 +6        SET TITLES=$$GET^XPAR(ORBENT,"ORB PROVIDER RECIPIENTS",ORN,"I")

 +7        IF TITLES["P"

               DO PRIMARY

 +8        IF TITLES["A"

               DO ATTEND

 +9        IF TITLES["T"

               DO TEAMS

 +10       IF TITLES["O"

               DO ORDERER

 +11       IF TITLES["E"

               DO ENTERBY

 +12       IF TITLES["R"

               DO PCMMPRIM

 +13       IF TITLES["S"

               DO PCMMASSC

 +14       IF TITLES["M"

               DO PCMMTEAM

 +15      ;IHS/CIA/MGH Next 3 choices were for provider recipients

 +16       IF TITLES["D"

               DO IHSPRIM

 +17       IF TITLES["I"

               DO IHSTEAM

 +18       IF TITLES["G"

               DO IHSDP

 +19       QUIT 

PRIMARY   ;

 +1        IF $DATA(ORBU)

               IF ORBADT=0

                   SET ORBU(ORBUI)=" Inpt primary provider:"

                   SET ORBUI=ORBUI+1

 +2        IF $DATA(ORBU)

               IF ORBADT=1

                   SET ORBU(ORBUI)=" Inpt primary provider: option cannot determine without A/D/T event data."

                   SET ORBUI=ORBUI+1

 +3        IF +$GET(ORBPRIM)>0

               SET ORBDUZ=ORBPRIM

               DO USER

 +4        QUIT 

ATTEND    ;

 +1        IF $DATA(ORBU)

               IF ORBADT=0

                   SET ORBU(ORBUI)=" Attending physician:"

                   SET ORBUI=ORBUI+1

 +2        IF $DATA(ORBU)

               IF ORBADT=1

                   SET ORBU(ORBUI)=" Attending physician: option cannot determine without A/D/T event data."

                   SET ORBUI=ORBUI+1

 +3        IF +$GET(ORBATTD)>0

               SET ORBDUZ=ORBATTD

               DO USER

 +4        QUIT 

TEAMS     ;

 +1        IF $DATA(ORBU)

               SET ORBU(ORBUI)=" Teams/Personal Lists related to patient:"

               SET ORBUI=ORBUI+1

 +2        NEW ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD

 +3        DO TMSPT^ORQPTQ1(.ORBLST,ORBDFN)

 +4        IF +$GET(ORBLST(1))<1

               QUIT 

 +5        SET ORBI=""

           FOR 

               SET ORBI=$ORDER(ORBLST(ORBI))

               IF ORBI=""

                   QUIT 

               Begin DoDot:1

 +6                SET ORBTM=$PIECE(ORBLST(ORBI),U)

                   SET ORBTNAME=$PIECE(ORBLST(ORBI),U,2)

 +7                SET ORBTTYPE=$PIECE(ORBLST(ORBI),U,3)

 +8                IF $DATA(ORBU)

                       Begin DoDot:2

 +9                        SET ORBU(ORBUI)="  Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:"

                           SET ORBUI=ORBUI+1

                       End DoDot:2

 +10               NEW ORBLST2

                   DO TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)

 +11               IF +$GET(ORBLST2(1))<1

                       QUIT 

 +12               SET ORBJ=""

                   FOR 

                       SET ORBJ=$ORDER(ORBLST2(ORBJ))

                       IF ORBJ=""

                           QUIT 

                       Begin DoDot:2

 +13                       SET ORBDUZ=$PIECE(ORBLST2(ORBJ),U)_U_ORBTM

                           IF +$GET(ORBDUZ)>0

                               DO USER

                       End DoDot:2

 +14      ;

 +15      ;Team's device

                   SET ORBTD=$PIECE($$TMDEV^ORB31(ORBTM),U,2)