ORBPRCHK ; SLC/JMH - API to return who gets notifications TAKEN FROM ORB3;
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
CHECK(ORPERS,ORNUM,ORN,ORBDFN) ; returns 1 if ORPERS should get the alert
N ORRET,ORY
D START(.ORRET,ORNUM,ORN,ORBDFN)
S ORY=$S($D(ORRET(ORPERS)):1,1:0)
Q ORY
START(ORRET,ORNUM,ORN,ORBDFN) ;
Q:$G(ORN)=""!($G(ORBDFN)="")
Q:'$L($G(^ORD(100.9,ORN,0)))
N ORBNOW,ORBID,ORBLOCK,ORBDESC
S ORBNOW=$$NOW^XLFDT
N ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT
N XQA,VAIN,VADM,DIC,ORBPDATA,ORBPMSG,VA,VA200,VAERR,X,Y
N ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY
S ORBUI=1,ORBADT=0
S:'$L($G(ORBPMSG)) ORBPMSG=""
S ORBPDATA=+$G(ORNUM)_"@"
S ORBN=^ORD(100.9,ORN,0)
;
S ORBENT=$$ENTITY^ORB31(ORNUM)
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 $D(ORBASPEC)>1 D SPECDUZS ;special recips
I $D(ORBADUZ)>1 D PKGDUZS ;pkg-supplied recips
D TITLE ;provider recips
M ORRET=XQA
Q
PKGDUZS ;get DUZs from pkg-passed ORBADUZ() array
N ORBPDUZ
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
S ORBSDUZ=""
F S ORBSDUZ=$O(ORBASPEC(ORBSDUZ)) Q:ORBSDUZ="" S ORBDUZ=ORBSDUZ D USER
Q
TITLE ;get provider recips
N TITLES
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
Q
PRIMARY ;
I +$G(ORBPRIM)>0 S ORBDUZ=ORBPRIM D USER
Q
ATTEND ;
I +$G(ORBATTD)>0 S ORBDUZ=ORBATTD D USER
Q
TEAMS ;
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
USER ;should USER (ORBDUZ) be a recip
I $P($$ONOFF^ORB3USER(ORN,+ORBDUZ,ORBDFN,,ORNUM),U)="ON" S XQA(+ORBDUZ)=""
Q
ORBPRCHK ; SLC/JMH - API to return who gets notifications TAKEN FROM ORB3;
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
CHECK(ORPERS,ORNUM,ORN,ORBDFN) ; returns 1 if ORPERS should get the alert
+1 NEW ORRET,ORY
+2 DO START(.ORRET,ORNUM,ORN,ORBDFN)
+3 SET ORY=$SELECT($DATA(ORRET(ORPERS)):1,1:0)
+4 QUIT ORY
START(ORRET,ORNUM,ORN,ORBDFN) ;
+1 IF $GET(ORN)=""!($GET(ORBDFN)="")
QUIT
+2 IF '$LENGTH($GET(^ORD(100.9,ORN,0)))
QUIT
+3 NEW ORBNOW,ORBID,ORBLOCK,ORBDESC
+4 SET ORBNOW=$$NOW^XLFDT
+5 NEW ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT
+6 NEW XQA,VAIN,VADM,DIC,ORBPDATA,ORBPMSG,VA,VA200,VAERR,X,Y
+7 NEW ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY
+8 SET ORBUI=1
SET ORBADT=0
+9 IF '$LENGTH($GET(ORBPMSG))
SET ORBPMSG=""
+10 SET ORBPDATA=+$GET(ORNUM)_"@"
+11 SET ORBN=^ORD(100.9,ORN,0)
+12 ;
+13 SET ORBENT=$$ENTITY^ORB31(ORNUM)
+14 DO REGULAR^ORB3REG(ORN,.XQA,.ORBU,.ORBUI,.ORBDEV,ORBDFN)
+15 DO SPECIAL^ORB3SPEC(ORN,.ORBASPEC,.ORBU,.ORBUI,$GET(ORNUM),ORBDFN,$GET(ORBPDATA),.ORBSMSG,$GET(ORBPMSG),.ORBSDEV,$GET(ORBPRIM),$GET(ORBATTD))
+16 ;special recips
IF $DATA(ORBASPEC)>1
DO SPECDUZS
+17 ;pkg-supplied recips
IF $DATA(ORBADUZ)>1
DO PKGDUZS
+18 ;provider recips
DO TITLE
+19 MERGE ORRET=XQA
+20 QUIT
PKGDUZS ;get DUZs from pkg-passed ORBADUZ() array
+1 NEW ORBPDUZ
+2 SET ORBPDUZ=""
+3 FOR
SET ORBPDUZ=$ORDER(ORBADUZ(ORBPDUZ))
IF ORBPDUZ=""
QUIT
SET ORBDUZ=ORBPDUZ
DO USER
+4 QUIT
SPECDUZS ;get DUZs rtn by SPECIAL^ORB3SPEC
+1 NEW ORBSDUZ
+2 SET ORBSDUZ=""
+3 FOR
SET ORBSDUZ=$ORDER(ORBASPEC(ORBSDUZ))
IF ORBSDUZ=""
QUIT
SET ORBDUZ=ORBSDUZ
DO USER
+4 QUIT
TITLE ;get provider recips
+1 NEW TITLES
+2 SET TITLES=$$GET^XPAR(ORBENT,"ORB PROVIDER RECIPIENTS",ORN,"I")
+3 IF TITLES["P"
DO PRIMARY
+4 IF TITLES["A"
DO ATTEND
+5 IF TITLES["T"
DO TEAMS
+6 IF TITLES["O"
DO ORDERER
+7 IF TITLES["E"
DO ENTERBY
+8 IF TITLES["R"
DO PCMMPRIM
+9 IF TITLES["S"
DO PCMMASSC
+10 IF TITLES["M"
DO PCMMTEAM
+11 QUIT
PRIMARY ;
+1 IF +$GET(ORBPRIM)>0
SET ORBDUZ=ORBPRIM
DO USER
+2 QUIT
ATTEND ;
+1 IF +$GET(ORBATTD)>0
SET ORBDUZ=ORBATTD
DO USER
+2 QUIT
TEAMS ;
+1 NEW ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD
+2 DO TMSPT^ORQPTQ1(.ORBLST,ORBDFN)
+3 IF +$GET(ORBLST(1))<1
QUIT
+4 SET ORBI=""
FOR
SET ORBI=$ORDER(ORBLST(ORBI))
IF ORBI=""
QUIT
Begin DoDot:1
+5 SET ORBTM=$PIECE(ORBLST(ORBI),U)
SET ORBTNAME=$PIECE(ORBLST(ORBI),U,2)
+6 SET ORBTTYPE=$PIECE(ORBLST(ORBI),U,3)
+7 IF $DATA(ORBU)
Begin DoDot:2
+8 SET ORBU(ORBUI)=" Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:"
SET ORBUI=ORBUI+1
End DoDot:2
+9 NEW ORBLST2
DO TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)
+10 IF +$GET(ORBLST2(1))<1
QUIT
+11 SET ORBJ=""
FOR
SET ORBJ=$ORDER(ORBLST2(ORBJ))
IF ORBJ=""
QUIT
Begin DoDot:2
+12 SET ORBDUZ=$PIECE(ORBLST2(ORBJ),U)_U_ORBTM
IF +$GET(ORBDUZ)>0
DO USER
End DoDot:2
+13 ;
+14 ;Team's device
SET ORBTD=$PIECE($$TMDEV^ORB31(ORBTM),U,2)
+15 IF $LENGTH(ORBTD)
Begin DoDot:2
+16 SET ORBTDEV(ORBTD)=""
+17 IF $DATA(ORBU)
Begin DoDot:3
+18 SET ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient"
SET ORBUI=ORBUI+1
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
ORDERER ;
+1 IF +$GET(ORNUM)<1
QUIT
+2 IF $DATA(ORBU)
SET ORBU(ORBUI)=" Ordering provider:"
SET ORBUI=ORBUI+1
+3 NEW ORBLST,ORBI,ORBTM,ORBJ,ORBTNAME,ORBPLST,ORBPI,ORBPTM,ORBTTYPE
+4 SET ORBDUZ=$SELECT(ORN=12:+$$UNSIGNOR^ORQOR2(ORNUM),1:$$ORDERER^ORQOR2(ORNUM))
+5 IF +$GET(ORBDUZ)>0
Begin DoDot:1
+6 DO USER
+7 ;if notif = Order Req E/S (#12) or Order Req Co-sign (#37) and
+8 ;user doesn't have ES authority, send to fellow team members w/ES:
+9 IF ((ORN=12)!(ORN=37))
IF ('$DATA(^XUSEC("ORES",ORBDUZ)))
Begin DoDot:2
+10 IF $DATA(ORBU)
SET ORBU(ORBUI)=" Orderer can't elec sign, getting teams orderer belongs to:"
SET ORBUI=ORBUI+1
+11 ;get orderer's tms
DO TEAMPR^ORQPTQ1(.ORBLST,ORBDUZ)
+12 IF +$GET(ORBLST(1))<1
QUIT
+13 ;get pt's tms
DO TMSPT^ORQPTQ1(.ORBPLST,ORBDFN)
+14 IF +$GET(ORBPLST(1))<1
QUIT
+15 SET ORBI=""
FOR
SET ORBI=$ORDER(ORBLST(ORBI))
IF ORBI=""
QUIT
Begin DoDot:3
+16 SET ORBPI=""
FOR
SET ORBPI=$ORDER(ORBPLST(ORBPI))
IF ORBPI=""
QUIT
Begin DoDot:4
+17 SET ORBTM=$PIECE(ORBLST(ORBI),U)
SET ORBPTM=$PIECE(ORBPLST(ORBPI),U)
+18 ;if pt is on provider's team
IF ORBTM=ORBPTM
Begin DoDot:5
+19 IF +$GET(ORBPTM)>0
Begin DoDot:6
+20 SET ORBTNAME=$PIECE(ORBPLST(ORBPI),U,2)
+21 SET ORBTTYPE=$PIECE(ORBPLST(ORBPI),U,3)
+22 IF $DATA(ORBU)
SET ORBU(ORBUI)=" Orderer's pt list "_ORBTNAME_" ["_ORBTTYPE_"] recipients: "
SET ORBUI=ORBUI+1
+23 NEW ORBLST2
DO TEAMPROV^ORQPTQ1(.ORBLST2,ORBPTM)
+24 IF +$GET(ORBLST2(1))<1
QUIT
+25 SET ORBJ=""
FOR
SET ORBJ=$ORDER(ORBLST2(ORBJ))
IF ORBJ=""
QUIT
Begin DoDot:7
+26 SET ORBDUZ=$PIECE(ORBLST2(ORBJ),U)_U_ORBPTM
IF +$GET(ORBDUZ)>0
IF ($DATA(^XUSEC("ORES",+ORBDUZ)))
DO USER
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT
ENTERBY ;
+1 IF $DATA(ORBU)
SET ORBU(ORBUI)=" User entering order's most recent activity:"
SET ORBUI=ORBUI+1
+2 IF +$GET(ORNUM)<1
QUIT
+3 IF $DATA(^OR(100,ORNUM,8,0))
Begin DoDot:1
+4 SET ORBDUZ=$PIECE(^OR(100,ORNUM,8,$PIECE(^OR(100,ORNUM,8,0),U,3),0),U,13)
End DoDot:1
+5 IF +$GET(ORBDUZ)>0
DO USER
+6 QUIT
PCMMPRIM ;
+1 IF $DATA(ORBU)
SET ORBU(ORBUI)=" PCMM Primary Care Practitioner:"
SET ORBUI=ORBUI+1
+2 ;DBIA #1252
SET ORBDUZ=+$$OUTPTPR^SDUTL3(ORBDFN,$$NOW^XLFDT,1)
+3 IF +$GET(ORBDUZ)>0
DO USER
+4 QUIT
PCMMASSC ;
+1 IF $DATA(ORBU)
SET ORBU(ORBUI)=" PCMM Associate Provider:"
SET ORBUI=ORBUI+1
+2 ;DBIA #1252
SET ORBDUZ=+$$OUTPTAP^SDUTL3(ORBDFN,$$NOW^XLFDT)
+3 IF +$GET(ORBDUZ)>0
DO USER
+4 QUIT
PCMMTEAM ;
+1 NEW ORPCMM,ORPCMMDZ
+2 IF $DATA(ORBU)
SET ORBU(ORBUI)=" PCMM Team Position Assignments:"
SET ORBUI=ORBUI+1
+3 ;DBIA #1916
SET ORPCMM=$$PRPT^SCAPMC(ORBDFN,,,,,,"^TMP(""ORPCMM"",$J)",)
+4 SET ORPCMMDZ=0
+5 FOR
SET ORPCMMDZ=$ORDER(^TMP("ORPCMM",$JOB,"SCPR",ORPCMMDZ))
IF 'ORPCMMDZ
QUIT
Begin DoDot:1
+6 SET ORBDUZ=ORPCMMDZ
DO USER
End DoDot:1
+7 KILL ^TMP("ORPCMM",$JOB)
+8 QUIT
USER ;should USER (ORBDUZ) be a recip
+1 IF $PIECE($$ONOFF^ORB3USER(ORN,+ORBDUZ,ORBDFN,,ORNUM),U)="ON"
SET XQA(+ORBDUZ)=""
+2 QUIT
