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