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

ORB31.m

Go to the documentation of this file. 
  1. ORB31 ; slc/CLA - Routine to support OE/RR 3 notifications ;6/28/00  12:00 [ 04/02/97  11:12 AM ]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,31,88,105,139,173,220,215**;Dec 17, 1997
  1. QUEUE(ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA,ORBH,ORBD,ORDGPMA) ;
  1.  ;queue up notif for Taskman processing
  1.  ;ORN       notification ien from file 100.9
  1.  ;ORBDFN    patient dfn from file 2
  1.  ;ORNUM     order number from file 100
  1.  ;ORBADUZ   array of potential user recipients (iens from file 100)
  1.  ;ORBPMSG   alert message from triggering process
  1.  ;ORBPDATA  data potentially used in alert follow-up action
  1.  ;ORBH      $H formatted time to begin Taskman process
  1.  ;ORBD      process description for Taskman
  1.  ;ORDGPMA   DGPMA if alert triggered by A/D/T event
  1.  ;
  1.  N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTREQ,ZTRTN,ZTSAVE,ZTSK,ZTUCI,X,Y,DIC
  1.  ;
  1.  S DIC="3.5",X="ORB NOTIFICATION RESOURCE",DIC(0)="X" D ^DIC
  1.  I (Y) S ZTIO=$P(Y,U,2)
  1.  E  S ZTIO=""
  1.  S ZTDTH=ORBH,ZTRTN="ZTSK^ORB3"
  1.  S ZTDESC=ORBD
  1.  S ZTDESC=ZTDESC_"for ("_ORBDFN_") "_$P($G(^DPT(+ORBDFN,0)),U,1)
  1.  K ZTSAVE,ZTCPU,ZTUCI,ZTPRI,ZTPAR,ZTPRE,DIC,Y,DTOUT,DUOUT
  1.  ;
  1.  S ZTSAVE("ORN")=""
  1.  S ZTSAVE("ORBDFN")=""
  1.  S ZTSAVE("ORNUM")=""
  1.  S ZTSAVE("ORBADUZ(")=""
  1.  S ZTSAVE("ORBPMSG")=""
  1.  S ZTSAVE("ORBPDATA")=""
  1.  S ZTSAVE("ORDGPMA")=""
  1.  D ^%ZTLOAD
  1.  Q
  1. DUP(ORN,ORBDFN,ORBPMSG,ORNUM) ;ext funct return "1" if a duplicate notif w/in 1 min.
  1.  N ORBDUP,ORBNOW,ORBLAST,ORLNUM,ORSAMEP
  1.  S ORBDUP=0
  1.  S ORSAMEP=0
  1.  S ORBNOW=$$NOW^XLFDT
  1.  S ^XTMP("ORBDUP",0)=$$FMADD^XLFDT(ORBNOW,1,"","","")_"^"_ORBNOW
  1.  I '$L($G(^XTMP("ORBDUP",ORBDFN_";"_ORN_";"_ORBPMSG))) S ^XTMP("ORBDUP",ORBDFN_";"_ORN_";"_ORBPMSG)=ORBNOW_"^"_$G(ORNUM)
  1.  E  D
  1.  .S ORBLAST=$G(^XTMP("ORBDUP",ORBDFN_";"_ORN_";"_ORBPMSG))
  1.  .S ORLNUM=$P(ORBLAST,"^",2)
  1.  .S ORBLAST=$P(ORBLAST,"^")
  1.  .I $L($G(ORNUM)),$L($G(ORLNUM)),($$ORDERER^ORQOR2(ORNUM)=$$ORDERER^ORQOR2(ORLNUM)) S ORSAMEP=1 ;same provider as last order that triggered this notif
  1.  .;if last occurrence of this "NOT" notif was w/in past 1 min, its a dup
  1.  .I ORBNOW<$$FMADD^XLFDT(ORBLAST,"","",1,""),ORSAMEP=1 S ORBDUP=1  ;dup
  1.  .E  S ^XTMP("ORBDUP",ORBDFN_";"_ORN_";"_ORBPMSG)=ORBNOW_"^"_ORNUM  ;refresh last pt/noti occ.
  1.  D DUPCLN(ORBNOW)  ;clean up old ^XTMP("ORBUP") entries
  1.  Q ORBDUP
  1. REGDEV(ORBDA) ;send to regular recipient devices
  1.  N ORBDT,ORBD
  1.  S ORBD=""
  1.  S ORBDT=$$NOW^XLFDT
  1.  F   S ORBD=$O(ORBDA(ORBD)) Q:ORBD=""  D
  1.  .S ZTRTN="PRINTD^ORB31",ZTDESC="Print Notification to Device",ZTDTH=$H
  1.  .S ZTIO=ORBD,ZTSAVE("XQAMSG")="",ZTSAVE("ORBDT")=""
  1.  .D ^%ZTLOAD
  1.  Q
  1. PRINTD ;print queued notification to device - setup via REGDEV^ORB3
  1.  I $G(ZTSK) D KILL^%ZTLOAD
  1.  I IOT="HFS" W XQAMSG Q  ;write msg to a file then quit
  1.  W !!!,"          ***** NOTIFICATION PROCESSED *****",!!
  1.  W $$FMTE^XLFDT(ORBDT),"   "
  1.  W XQAMSG
  1.  I $E(IOST,1,2)'="C-" W @IOF
  1.  Q
  1. FWD(ORY,ORBLST,ORBRECIP,ORBTYPE,ORBCOMNT) ; forward a notification
  1.  I ORBLST="" S ORY=0 Q
  1.  S ORBLST(1)=ORBLST
  1.  D FORWARD^XQALFWD(.ORBLST,.ORBRECIP,ORBTYPE,ORBCOMNT)
  1.  S ORY=1
  1.  Q
  1. RENEW(ORY,XQAID) ; renew/restore an alert/notification
  1.  Q:$L($G(XQAID))<1
  1.  K XQAKILL
  1.  I '$D(^XTV(8992,"AXQA",XQAID,DUZ)) D RESTORE^XQALERT1 ;DBIA #4100
  1.  S ORY=1
  1.  Q
  1. TERMLKUP(OCXARR,OCXTERM) ; extrinsic function returns the local terms
  1.  ; linked to the nat'l OCX term in an array and the file where those
  1.  ; array terms can be found. The value of the extrinsic function is the
  1.  ; file pointed to for the local terms.
  1.  ;
  1.  ; OCXARR  - Array of local terms
  1.  ; OCXTERM - OCX nat'l term from file ^OCXS(860.9
  1.  ;
  1.  N OCXI,OCXJ,FILE,I
  1.  S OCXI="",OCXJ=0,FILE="",I=1
  1.  S OCXI=$O(^OCXS(860.9,"B",OCXTERM,OCXI))
  1.  I +$G(OCXI)>0 D
  1.  .S FILE=$P(^OCXS(860.9,OCXI,0),U,2)
  1.  .F  S OCXJ=$O(^OCXS(860.9,OCXI,1,OCXJ)) Q:+OCXJ<1  D
  1.  ..S OCXARR(I)=$P(^OCXS(860.9,OCXI,1,OCXJ,0),U,2)_U_$P(^(0),U)
  1.  ..S OCXARR=I,I=I+1
  1.  Q FILE
  1. DUPCLN(ORBNOW) ;clean up old entires in ^XTMP("ORBDUP")
  1.  N ORBX,ORBDT,ORNDT
  1.  S ORNDT=$$FMADD^XLFDT(ORBNOW,"","",-5,"")  ;entries older than 5 minutes
  1.  S ORBX=0
  1.  F  S ORBX=$O(^XTMP("ORBDUP",ORBX)) Q:ORBX=""  D
  1.  .S ORBDT=+$G(^XTMP("ORBDUP",ORBX))
  1.  .I $L(ORBDT),(ORBDT<ORNDT) K ^XTMP("ORBDUP",ORBX)
  1.  Q
  1. TMDEV(ORBTM) ;returns Device for a team in format device ien^device name
  1.  N ORBTDEV,ORBTDEVN
  1.  S ORBTDEVN=""
  1.  Q:'$L($G(ORBTM)) ""
  1.  Q:'$D(^OR(100.21,ORBTM,0)) ""
  1.  S ORBTDEV=$P(^OR(100.21,ORBTM,0),U,4)  ;get Team's device
  1.  Q:+$G(ORBTDEV)<1 ""
  1.  S X="`"_ORBTDEV,DIC=3.5,DIC(0)="" D ^DIC  ;DBIA #10114
  1.  Q:+Y<1 ""
  1.  S ORBTDEVN=$P(Y,U,2)
  1.  K DIC,Y,X
  1.  Q ORBTDEV_U_ORBTDEVN
  1. ENTITY(ORNUM) ;ext funct. rtns entity for parameter use
  1.  N ORBENT
  1.  S ORBENT="DIV^SYS^PKG"
  1.  I $L($G(ORNUM)) D  ;if order number use pt's location division
  1.  .N ORDIV
  1.  .S ORDIV=0,ORDIV=$$ORDIV(ORNUM)
  1.  .I +$G(ORDIV)>0 S ORBENT=ORDIV_";DIC(4,^SYS^PKG"
  1.  Q ORBENT
  1.  ;
  1. ADT(ORN,ORBDFN,ORBPRIM,ORBATTD,ORDGPMA) ;get inpt primary and attending for ADT notifs
  1.  N ORBADTDT,VAINDT
  1.  ;if notif is deceased or discharge use prev visit d/t:
  1.  I (ORN=20)!(ORN=35) D
  1.  .S ORBADTDT=$S($D(ORDGPMA):$P(ORDGPMA,U),1:$P($G(^DPT(ORBDFN,.35)),U))
  1.  .I $L(ORBADTDT) S VAINDT=$$FMADD^XLFDT(ORBADTDT,"","","","-1")
  1.  ;
  1.  I ORN=18 S VAINDT=$P($G(ORDGPMA),U)  ;if admission use this visit d/t
  1.  ;
  1.  I $L($G(VAINDT)) D
  1.  .D INP^VADPT  ;get new VAIN array for appropriate visit
  1.  .S ORBPRIM=+$P(VAIN(2),U),ORBATTD=+$P(VAIN(11),U)
  1.  Q
  1.  ;
  1. DEFDIV(ORDUZ) ; Return user's default division, if specified.
  1.  ;
  1.  N ORDD,ORDIV,ORGOOD,ORZ,ORZERR
  1.  ;
  1.  S ORDIV=""
  1.  S Y=0,(ORDD,ORGOOD)=0             ; Initialize variables.
  1.  ;
  1.  ; Get list of divisions from NEW PERSON file multiple:
  1.  D LIST^DIC(200.02,","_ORDUZ_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
  1.  I $P(ORZ("DILIST",0),U)=0 Q       ; No Divisions listed.
  1.  ;
  1.  F  S ORDD=$O(ORZ("DILIST",ORDD)) Q:+ORDD=0!'($L(ORDD))  D  Q:ORGOOD
  1.  .; See if current entry being processed is "Default" (done if so):
  1.  .I $P(ORZ("DILIST",ORDD,0),U,3)["Y" S ORDIV=$P(ORZ("DILIST",ORDD,0),U,1,2),ORGOOD=1
  1.  Q ORDIV
  1.  ;
  1. ORDIV(ORNUM) ; Return order's division based upon patient's location when order was placed
  1.  ;
  1.  Q:+$G(ORNUM)<1 ""
  1.  Q:'$D(^OR(100,ORNUM,0)) ""
  1.  N ORDIV,PTLOC
  1.  S ORDIV=""
  1.  S PTLOC=+$P(^OR(100,ORNUM,0),U,10)
  1.  Q:$G(PTLOC)<1 ""
  1.  S ORDIV=$P(^SC(PTLOC,0),U,4)  ;DBIA #10040
  1.  Q ORDIV