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

ORB3SPEC.m

Go to the documentation of this file. 
  1. ORB3SPEC ; slc/CLA - Support routine for ORB3 ;4/4/02  14:40
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**139,220,215**;Dec 17, 1997
  1. SPECIAL(ORN,ORBASPEC,ORBU,ORBUI,ORNUM,ORDFN,ORDATA,ORBSMSG,ORBMSG,ORBSDEV,ORBPRIM,ORBATTD) ;
  1.  ;process special notifs to get recips (users,teams,devices)
  1.  ; ORN: notif ien
  1.  ; ORBASPEC: recip DUZ array
  1.  ; ORBU: recip debug array
  1.  ; ORBUI: ORBU cntr
  1.  ; ORNUM: order no
  1.  ; ORDFN: pt id
  1.  ; ORDATA: pkg data
  1.  ; ORBSMSG: special notif msg rtn by SPECIAL
  1.  ; ORBMSG: original notif msg
  1.  ; ORBSDEV: array of recip devices
  1.  ; ORBPRIM: pt's inpt primary care provider
  1.  ; ORBATTD: pt's attending physician
  1.  ;
  1.  N ORPAR,ORPTLOC
  1.  S ORPTLOC=$S($L($G(^DPT(ORDFN,.1))):"I",1:"O")  ;DBIA #10035
  1.  ;
  1.  I ORPTLOC="I" D  ;inpt flagged OI notifs
  1.  .I ORN=32 S ORPAR="ORB OI RESULTS - INPT" D OI
  1.  .I ORN=41 S ORPAR="ORB OI ORDERED - INPT" D OI
  1.  .I ORN=64 S ORPAR="ORB OI EXPIRING - INPT" D OI
  1.  ;
  1.  I ORPTLOC="O" D  ;outpt flagged OI notifs
  1.  .I ORN=60 S ORPAR="ORB OI RESULTS - OUTPT" D OI
  1.  .I ORN=61 S ORPAR="ORB OI ORDERED - OUTPT" D OI
  1.  .I ORN=65 S ORPAR="ORB OI EXPIRING - OUTPT" D OI
  1.  ;
  1.  I ORN=3!(ORN=14)!(ORN=44)!(ORN=57) D  ;lab results notifs
  1.  .D LRALRTS(ORN,ORDFN,ORDATA,.ORBSMSG,ORBMSG)
  1.  ;
  1.  I ORN=33 D  ;requested results notif
  1.  .I $D(ORBU) D
  1.  ..S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
  1.  ..S ORBU(ORBUI)="Potential Orderer-flagged Results recipient: ",ORBUI=ORBUI+1
  1.  .N RECIP
  1.  .S RECIP=$$RSLTFLG^ORQOR2(ORNUM)
  1.  .I +$G(RECIP)>0 D
  1.  ..S ORBASPEC(+$G(RECIP))=""
  1.  ..I $D(ORBU) N NODE S NODE=$G(^VA(200,+$G(RECIP),0)) I $L(NODE) D
  1.  ...S ORBU(ORBUI)="   "_$P(NODE,U)_" is a potential recipient.",ORBUI=ORBUI+1
  1.  Q
  1. OI ;get potential recips for OI-flagged notifs
  1.  N OROI,ORLST,ORERR,ORBX,ORBZ,ORBE,ORBDUZ,ORBDEV,ORBUF
  1.  S OROI=+$G(^OR(100,+$G(ORNUM),.1,1,0))  ;get oi
  1.  Q:+$G(OROI)<0
  1.  I $D(ORBU) D
  1.  .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
  1.  .S ORBU(ORBUI)="Special potential recipients from parameter: "_ORPAR,ORBUI=ORBUI+1
  1.  S ORBE=0,ORBX=0
  1.  ;
  1.  ;process special recip users, teams and devices:
  1.  D ENVAL^XPAR(.ORLST,ORPAR,"`"_OROI,.ORERR)
  1.  I 'ORERR,$G(ORLST)>0 D
  1.  .F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)),ORBZ=$P(ORBE,";",2),ORBUF=0 D
  1.  ..;
  1.  ..; process USERS:
  1.  ..I ORBZ="VA(200," S ORBDUZ=$P(ORBE,";") I $L(ORBDUZ) D
  1.  ...I ORLST(ORBE,OROI)=1 S ORBASPEC(ORBDUZ)="",ORBUF=1
  1.  ...I ORLST(ORBE,OROI)=0,$$PPLINK^ORQPTQ1(ORBDUZ,ORDFN) S ORBASPEC(ORBDUZ)="",ORBUF=1
  1.  ...I $D(ORBU),ORBUF=1 N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L(NODE) D
  1.  ....S ORBU(ORBUI)="   "_$P(NODE,U)_" is a potential recipient.",ORBUI=ORBUI+1
  1.  ..;
  1.  ..; process DEVICES:
  1.  ..I ORBZ="%ZIS(1," S ORBDEV=$P(ORBE,";") I $L(ORBDEV),$D(^%ZIS(1,ORBDEV))>0 D
  1.  ...S ORBDEV=$G(^%ZIS(1,ORBDEV,0)) I $D(ORBDEV) D
  1.  ....I ORLST(ORBE,OROI)=1 S ORBSDEV($P(ORBDEV,U))="",ORBUF=1
  1.  ....I ORLST(ORBE,OROI)=0,$$PDLINK^ORQPTQ1(ORBDEV,ORDFN) S ORBSDEV($P(ORBDEV,U))="",ORBUF=1
  1.  ....I $D(ORBU),ORBUF=1 D
  1.  .....S ORBU(ORBUI)="   "_$P(ORBDEV,U)_" is a device recipient.",ORBUI=ORBUI+1
  1.  ..;
  1.  ..; process TEAMS:
  1.  ..I ORBZ="OR(100.21," D SPECTEAM(ORBE)
  1.  D TITLE(OROI,ORPAR)
  1.  Q
  1. SPECTEAM(ORBE) ;get special team recips
  1.  N ORBLST,IJ,ORBTM
  1.  S ORBTM=$P(ORBE,";")
  1.  D TEAMPROV^ORQPTQ1(.ORBLST,ORBTM)
  1.  I $D(ORBU) N TNODE S TNODE=$G(^OR(100.21,ORBTM,0)) I $L(TNODE) D
  1.  .S ORBU(ORBUI)="   Team potential recipients from team "_$P(TNODE,U)_":",ORBUI=ORBUI+1
  1.  I +$G(ORBLST(1))>0 S IJ="" F  S IJ=$O(ORBLST(IJ)) Q:IJ=""  D
  1.  .S ORBDUZ=$P(ORBLST(IJ),U),ORBUF=0 I $L(ORBDUZ) D
  1.  ..I ORLST(ORBE,OROI)=1 S ORBASPEC(ORBDUZ_U_ORBTM)="",ORBUF=1
  1.  ..I ORLST(ORBE,OROI)=0,$D(^OR(100.21,ORBTM,10,"B",ORDFN_";DPT(")) S ORBASPEC(ORBDUZ_U_ORBTM)="",ORBUF=1
  1.  ..I $D(ORBU),ORBUF=1 N NODE S NODE=$G(^VA(200,ORBDUZ,0)) I $L(NODE) D
  1.  ...S ORBU(ORBUI)="     "_$P(NODE,U),ORBUI=ORBUI+1
  1.  ;
  1.  S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2)  ;tm's device
  1.  I $L(ORBTD) D
  1.  .S ORBSDEV(ORBTD)=""
  1.  .I $D(ORBU) D
  1.  ..S ORBU(ORBUI)="   Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
  1.  Q
  1. LRALRTS(ORN,ORDFN,ORDATA,ORBSMSG,ORBMSG) ;find & delete matching alerts and gather recips
  1.  ; ORN: notif ien
  1.  ; ORDFN: pt id
  1.  ; ORDATA: pkg data
  1.  ; ORBSMSG: special notif msg rtn by LRALRTS
  1.  ; ORBMSG: original notif msg
  1.  ;
  1.  Q:+$G(ORN)<1
  1.  Q:+$G(ORDFN)<1
  1.  Q:+$G(ORDATA)<1
  1.  N LRID,ORY,I,J,XQAID,XQ0,XQ1,ORNE,RECIP,ORDATAE,LRIDE,STDATE
  1.  N ORTST,ORBMSGE,ORBMSGX,TXQAID,XQF,ORBHX,ORX,ORBI
  1.  ;
  1.  S LRID=$P($P(ORDATA,"|",2),"@")  ;get lab unique results id (OE IDE)
  1.  Q:+$G(LRID)<1
  1.  ;
  1.  ;get pt's alerts within 24 hours:
  1.  S STDATE=$$FMADD^XLFDT($$NOW^XLFDT,"","-24","","")
  1.  D PATIENT^XQALERT("ORY",ORDFN,STDATE,"") ;get pt's alerts
  1.  ;
  1.  ;look for pt's alerts with same notif ien and unique lab results id:
  1.  F I=1:1:ORY D
  1.  .S XQAID=$P(ORY(I),U,2)
  1.  .S ORBMSGX=$P(ORY(I),U)
  1.  .S ORNE=$P($P(XQAID,";"),",",3)  ;get notif ien
  1.  .Q:ORNE'=ORN
  1.  .;
  1.  .;find matching alert:
  1.  .D AHISTORY^XQALBUTL(XQAID,"ORBHX")
  1.  .S ORDATAE=$G(ORBHX(2))
  1.  .Q:'$L(ORDATAE)
  1.  .S LRIDE=$P($P(ORDATAE,"|",2),"@")  ;get lab rslts id from existng alert
  1.  .Q:LRIDE'=LRID
  1.  .;
  1.  .S:ORBMSG["[" ORTST=$P($P(ORBMSG,"[",2),"]")
  1.  .I ORBMSG'["[" D
  1.  ..S:ORBMSG["labs: " ORTST=$P(ORBMSG,"labs: ",2)
  1.  ..S:ORBMSG["results: " ORTST=$P(ORBMSG,"results: ",2)
  1.  .;
  1.  .S ORBMSGE=$P(ORBMSGX,"): ",2)
  1.  .;
  1.  .S ORX=0
  1.  .;if alert has recips, get recips from existing alert:
  1.  .S:$L($G(ORBHX(20,0))) ORX=$P(ORBHX(20,0),U,4)
  1.  .F ORBI=1:1:ORX D
  1.  ..S RECIP=+ORBHX(20,ORBI,0)
  1.  ..S ORBASPEC(RECIP)=""  ;add recip to new alert recip list
  1.  .;
  1.  .;delete existing alert:
  1.  .S XQAKILL=0  ;delete for all recips
  1.  .D DELETE^XQALERT
  1.  .K XQAKILL,XQAID
  1.  ;
  1.  ;if NO prev alert msg for this pt, notif, lab unique id:
  1.  I '$L($G(ORBMSGE)) S ORBSMSG=ORBMSG
  1.  ;
  1.  ;if prev alert msg for this pt, notif, lab unique id:
  1.  I $L($G(ORBMSGE)) D
  1.  .S:ORBMSGE["[" ORBSMSG=$P(ORBMSGE,"]")_", "_ORTST_"]"
  1.  .S:ORBMSGE'["[" ORBSMSG=ORBMSGE_", "_ORTST
  1.  ;
  1.  Q
  1.  ;
  1. TITLE(OROI,ORPAR) ;get provider recips
  1.  N ORTIT
  1.  I $D(ORBU) D
  1.  .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
  1.  .S ORBU(ORBUI)="Special potential recipients from parameter: "_ORPAR_" PR",ORBUI=ORBUI+1
  1.  ;
  1.  ;process special recip users, teams and devices for Provider Recipients
  1.  S ORTIT=$$GET^XPAR("ALL",ORPAR_" PR","`"_OROI,"E")
  1.  Q:'$L(ORTIT)
  1.  I ORTIT["P" D PRIMARY
  1.  I ORTIT["A" D ATTEND
  1.  I ORTIT["T" D TEAMS
  1.  I ORTIT["O" D ORDERER
  1.  I ORTIT["E" D ENTERBY
  1.  I ORTIT["R" D PCMMPRIM
  1.  I ORTIT["S" D PCMMASSC
  1.  I ORTIT["M" D PCMMTEAM
  1.  Q
  1. PRIMARY ;
  1.  I $D(ORBU),+$G(ORBPRIM)>0 S ORBU(ORBUI)=" Flagged OI Inpt primary provider:",ORBUI=ORBUI+1
  1.  I $D(ORBU),+$G(ORBPRIM)<1 S ORBU(ORBUI)=" Flagged OI Inpt primary provider: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
  1.  I +$G(ORBPRIM)>0 S ORBASPEC(ORBPRIM)=""
  1.  Q
  1. ATTEND ;
  1.  I $D(ORBU),+$G(ORBATTD)>0 S ORBU(ORBUI)=" Flagged OI Attending physician:",ORBUI=ORBUI+1
  1.  I $D(ORBU),+$G(ORBATTD)<1 S ORBU(ORBUI)=" Flagged OI Attending physician: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
  1.  I +$G(ORBATTD)>0 S ORBASPEC(ORBATTD)=""
  1.  Q
  1. TEAMS ;
  1.  N ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD
  1.  I $D(ORBU) S ORBU(ORBUI)=" Flagged OI Teams/Personal Lists related to patient:",ORBUI=ORBUI+1
  1.  D TMSPT^ORQPTQ1(.ORBLST,ORDFN)
  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 S ORBASPEC(ORBDUZ)=""
  1.  .S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2)  ;tm's device
  1.  .I $L(ORBTD) D
  1.  ..S ORBSDEV(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.  N ORBDUZ
  1.  I $D(ORBU) S ORBU(ORBUI)=" Flagged OI Ordering provider:",ORBUI=ORBUI+1
  1.  Q:+$G(ORNUM)<1
  1.  S ORBDUZ=$$ORDERER^ORQOR2(ORNUM)
  1.  I +$G(ORBDUZ)>0 D
  1.  .S ORBASPEC(ORBDUZ)=""
  1.  Q
  1. ENTERBY ;
  1.  N ORBDUZ
  1.  I $D(ORBU) S ORBU(ORBUI)=" Flagged OI 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 S ORBASPEC(ORBDUZ)=""
  1.  Q
  1. PCMMPRIM ;
  1.  N ORBDUZ
  1.  I $D(ORBU) S ORBU(ORBUI)=" Flagged OI PCMM Primary Care Practitioner:",ORBUI=ORBUI+1
  1.  S ORBDUZ=+$$OUTPTPR^SDUTL3(ORDFN,$$NOW^XLFDT,1)  ;DBIA #1252
  1.  I +$G(ORBDUZ)>0 S ORBASPEC(ORBDUZ)=""
  1.  Q
  1. PCMMASSC ;
  1.  N ORBDUZ
  1.  I $D(ORBU) S ORBU(ORBUI)=" Flagged OI PCMM Associate Provider:",ORBUI=ORBUI+1
  1.  S ORBDUZ=+$$OUTPTAP^SDUTL3(ORDFN,$$NOW^XLFDT)  ;DBIA #1252
  1.  I +$G(ORBDUZ)>0 S ORBASPEC(ORBDUZ)=""
  1.  Q
  1. PCMMTEAM ;
  1.  N ORPCMM,ORPCMMDZ,ORBDUZ
  1.  I $D(ORBU) S ORBU(ORBUI)=" Flagged OI PCMM Team Position Assignments:",ORBUI=ORBUI+1
  1.  S ORPCMM=$$PRPT^SCAPMC(ORDFN,,,,,,"^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 S ORBASPEC(ORBDUZ)=""
  1.  K ^TMP("ORPCMM",$J)
  1.  Q