Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORBPRCHK

ORBPRCHK.m

Go to the documentation of this file. 
  1. 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
  1. CHECK(ORPERS,ORNUM,ORN,ORBDFN) ; returns 1 if ORPERS should get the alert
  1.  N ORRET,ORY
  1.  D START(.ORRET,ORNUM,ORN,ORBDFN)
  1.  S ORY=$S($D(ORRET(ORPERS)):1,1:0)
  1.  Q ORY
  1. START(ORRET,ORNUM,ORN,ORBDFN) ;
  1.  Q:$G(ORN)=""!($G(ORBDFN)="")
  1.  Q:'$L($G(^ORD(100.9,ORN,0)))
  1.  N ORBNOW,ORBID,ORBLOCK,ORBDESC
  1.  S ORBNOW=$$NOW^XLFDT
  1.  N ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT
  1.  N XQA,VAIN,VADM,DIC,ORBPDATA,ORBPMSG,VA,VA200,VAERR,X,Y
  1.  N ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY
  1.  S ORBUI=1,ORBADT=0
  1.  S:'$L($G(ORBPMSG)) ORBPMSG=""
  1.  S ORBPDATA=+$G(ORNUM)_"@"
  1.  S ORBN=^ORD(100.9,ORN,0)
  1.  ;
  1.  S ORBENT=$$ENTITY^ORB31(ORNUM)
  1.  D REGULAR^ORB3REG(ORN,.XQA,.ORBU,.ORBUI,.ORBDEV,ORBDFN)
  1.  D SPECIAL^ORB3SPEC(ORN,.ORBASPEC,.ORBU,.ORBUI,$G(ORNUM),ORBDFN,$G(ORBPDATA),.ORBSMSG,$G(ORBPMSG),.ORBSDEV,$G(ORBPRIM),$G(ORBATTD))
  1.  I $D(ORBASPEC)>1 D SPECDUZS ;special recips
  1.  I $D(ORBADUZ)>1 D PKGDUZS ;pkg-supplied recips
  1.  D TITLE ;provider recips
  1.  M ORRET=XQA
  1.  Q
  1. PKGDUZS ;get DUZs from pkg-passed ORBADUZ() array
  1.  N ORBPDUZ
  1.  S ORBPDUZ=""
  1.  F  S ORBPDUZ=$O(ORBADUZ(ORBPDUZ)) Q:ORBPDUZ=""  S ORBDUZ=ORBPDUZ D USER
  1.  Q
  1. SPECDUZS ;get DUZs rtn by SPECIAL^ORB3SPEC
  1.  N ORBSDUZ
  1.  S ORBSDUZ=""
  1.  F  S ORBSDUZ=$O(ORBASPEC(ORBSDUZ)) Q:ORBSDUZ=""  S ORBDUZ=ORBSDUZ D USER
  1.  Q
  1. TITLE ;get provider recips
  1.  N TITLES
  1.  S TITLES=$$GET^XPAR(ORBENT,"ORB PROVIDER RECIPIENTS",ORN,"I")
  1.  I TITLES["P" D PRIMARY
  1.  I TITLES["A" D ATTEND
  1.  I TITLES["T" D TEAMS
  1.  I TITLES["O" D ORDERER
  1.  I TITLES["E" D ENTERBY
  1.  I TITLES["R" D PCMMPRIM
  1.  I TITLES["S" D PCMMASSC
  1.  I TITLES["M" D PCMMTEAM
  1.  Q
  1. PRIMARY ;
  1.  I +$G(ORBPRIM)>0 S ORBDUZ=ORBPRIM D USER
  1.  Q
  1. ATTEND ;
  1.  I +$G(ORBATTD)>0 S ORBDUZ=ORBATTD D USER
  1.  Q
  1. TEAMS ;
  1.  N ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD
  1.  D TMSPT^ORQPTQ1(.ORBLST,ORBDFN)
  1.  Q:+$G(ORBLST(1))<1
  1.  S ORBI="" F  S ORBI=$O(ORBLST(ORBI)) Q:ORBI=""  D
  1.  .S ORBTM=$P(ORBLST(ORBI),U),ORBTNAME=$P(ORBLST(ORBI),U,2)
  1.  .S ORBTTYPE=$P(ORBLST(ORBI),U,3)
  1.  .I $D(ORBU) D
  1.  ..S ORBU(ORBUI)="  Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:",ORBUI=ORBUI+1
  1.  .N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)
  1.  .Q:+$G(ORBLST2(1))<1
  1.  .S ORBJ="" F  S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ=""  D
  1.  ..S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBTM I +$G(ORBDUZ)>0 D USER
  1.  .;
  1.  .S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2)  ;Team's device
  1.  .I $L(ORBTD) D
  1.  ..S ORBTDEV(ORBTD)=""
  1.  ..I $D(ORBU) D
  1.  ...S ORBU(ORBUI)="   Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
  1.  Q
  1. ORDERER ;
  1.  Q:+$G(ORNUM)<1
  1.  I $D(ORBU) S ORBU(ORBUI)=" Ordering provider:",ORBUI=ORBUI+1
  1.  N ORBLST,ORBI,ORBTM,ORBJ,ORBTNAME,ORBPLST,ORBPI,ORBPTM,ORBTTYPE
  1.  S ORBDUZ=$S(ORN=12:+$$UNSIGNOR^ORQOR2(ORNUM),1:$$ORDERER^ORQOR2(ORNUM))
  1.  I +$G(ORBDUZ)>0 D
  1.  .D USER
  1.  .;if notif = Order Req E/S (#12) or Order Req Co-sign (#37) and
  1.  .;user doesn't have ES authority, send to fellow team members w/ES:
  1.  .I ((ORN=12)!(ORN=37)),('$D(^XUSEC("ORES",ORBDUZ))) D
  1.  ..I $D(ORBU) S ORBU(ORBUI)=" Orderer can't elec sign, getting teams orderer belongs to:",ORBUI=ORBUI+1
  1.  ..D TEAMPR^ORQPTQ1(.ORBLST,ORBDUZ)  ;get orderer's tms
  1.  ..Q:+$G(ORBLST(1))<1
  1.  ..D TMSPT^ORQPTQ1(.ORBPLST,ORBDFN)  ;get pt's tms
  1.  ..Q:+$G(ORBPLST(1))<1
  1.  ..S ORBI="" F  S ORBI=$O(ORBLST(ORBI)) Q:ORBI=""  D
  1.  ...S ORBPI="" F  S ORBPI=$O(ORBPLST(ORBPI)) Q:ORBPI=""  D
  1.  ....S ORBTM=$P(ORBLST(ORBI),U),ORBPTM=$P(ORBPLST(ORBPI),U)
  1.  ....I ORBTM=ORBPTM D  ;if pt is on provider's team
  1.  .....I +$G(ORBPTM)>0 D
  1.  ......S ORBTNAME=$P(ORBPLST(ORBPI),U,2)
  1.  ......S ORBTTYPE=$P(ORBPLST(ORBPI),U,3)
  1.  ......I $D(ORBU) S ORBU(ORBUI)="  Orderer's pt list "_ORBTNAME_" ["_ORBTTYPE_"] recipients: ",ORBUI=ORBUI+1
  1.  ......N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBPTM)
  1.  ......Q:+$G(ORBLST2(1))<1
  1.  ......S ORBJ="" F  S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ=""  D
  1.  .......S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBPTM I +$G(ORBDUZ)>0,($D(^XUSEC("ORES",+ORBDUZ))) D USER
  1.  Q
  1. ENTERBY ;
  1.  I $D(ORBU) S ORBU(ORBUI)=" User entering order's most recent activity:",ORBUI=ORBUI+1
  1.  Q:+$G(ORNUM)<1
  1.  I $D(^OR(100,ORNUM,8,0)) D
  1.  .S ORBDUZ=$P(^OR(100,ORNUM,8,$P(^OR(100,ORNUM,8,0),U,3),0),U,13)
  1.  I +$G(ORBDUZ)>0 D USER
  1.  Q
  1. PCMMPRIM ;
  1.  I $D(ORBU) S ORBU(ORBUI)=" PCMM Primary Care Practitioner:",ORBUI=ORBUI+1
  1.  S ORBDUZ=+$$OUTPTPR^SDUTL3(ORBDFN,$$NOW^XLFDT,1)  ;DBIA #1252
  1.  I +$G(ORBDUZ)>0 D USER
  1.  Q
  1. PCMMASSC ;
  1.  I $D(ORBU) S ORBU(ORBUI)=" PCMM Associate Provider:",ORBUI=ORBUI+1
  1.  S ORBDUZ=+$$OUTPTAP^SDUTL3(ORBDFN,$$NOW^XLFDT)  ;DBIA #1252
  1.  I +$G(ORBDUZ)>0 D USER
  1.  Q
  1. PCMMTEAM ;
  1.  N ORPCMM,ORPCMMDZ
  1.  I $D(ORBU) S ORBU(ORBUI)=" PCMM Team Position Assignments:",ORBUI=ORBUI+1
  1.  S ORPCMM=$$PRPT^SCAPMC(ORBDFN,,,,,,"^TMP(""ORPCMM"",$J)",)  ;DBIA #1916
  1.  S ORPCMMDZ=0
  1.  F  S ORPCMMDZ=$O(^TMP("ORPCMM",$J,"SCPR",ORPCMMDZ)) Q:'ORPCMMDZ  D
  1.  .S ORBDUZ=ORPCMMDZ D USER
  1.  K ^TMP("ORPCMM",$J)
  1.  Q
  1. USER ;should USER (ORBDUZ) be a recip
  1.  I $P($$ONOFF^ORB3USER(ORN,+ORBDUZ,ORBDFN,,ORNUM),U)="ON" S XQA(+ORBDUZ)=""
  1.  Q