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

ORB3U1.m

Go to the documentation of this file. 
  1. ORB3U1 ; slc/CLA - Utilities which support OE/RR 3 Notifications ;12/15/97
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,88,91,105,179,220,250**;Dec 17, 1997;Build 1
  1.  Q
  1. LIST(Y) ;return list of notifications from Notification File [#100.9]
  1.  ; RETURN IEN^NAME^URGENCY
  1.  N I,J,V
  1.  S I=1
  1.  S J=0 F  S J=$O(^ORD(100.9,"B",J)) Q:J=""  S V=0,V=$O(^ORD(100.9,"B",J,V)) S Y(I)=V_"^"_J_"^"_^ORD(100.9,V,3),I=I+1
  1.  Q
  1.  ;
  1. ALRTHX ;report the recipients for an alert, when received, action taken
  1.  N ORBDFN,ORBSDT,ORBEDT
  1.  ;prompt for patient (required):
  1.  K DIC S DIC="^DPT(",DIC("A")="PATIENT (req'd): ",DIC(0)="AEQNM" D ^DIC
  1.  I Y<1 K DIC,Y Q
  1.  S ORBDFN=+Y,ORBPT=$P(Y,U,2)
  1.  K DIC,Y,DUOUT,DTOUT
  1.  ;
  1.  S %DT="AET",%DT("A")="Start Date/Time (req'd): ",%DT("B")="T-30" D ^%DT
  1.  I Y<1 K %DT,Y Q
  1.  S ORBSDT=Y
  1.  ;
  1.  S %DT="AET",%DT("A")="End Date/Time (req'd): ",%DT("B")="NOW" D ^%DT
  1.  I Y<1 K %DT,Y Q
  1.  S ORBEDT=Y
  1.  ;
  1.  ;get alerts for this patient from the alert tracking file:
  1.  D PATIENT^XQALERT("^TMP(""ORB"",$J)",ORBDFN,ORBSDT,ORBEDT)
  1.  W !!,"Processing..."
  1.  ;
  1.  D EN^VALM("OR PATIENT ALERTS")
  1.  Q
  1. SELECT ;if one or more alerts selected, display/print recipient data:
  1.  N ORN,ORNUMS,ORI,ORJ,ORBAL,ORBAID,ORBSMSG,ORY,DESC,HDR
  1.  S ORNUMS=$P(XQORNOD(0),"=",2)
  1.  Q:'$L(ORNUMS)
  1.  D FULL^VALM1
  1.  ;
  1.  S ORJ=1
  1.  F ORI=1:1:$L(ORNUMS,",")-1 D
  1.  .S ORN=$P(ORNUMS,",",ORI)
  1.  .S ORBAL=$G(^TMP("OR",$J,"ALERTS","IDX",ORN)) I $L(ORBAL) D
  1.  ..S ORBAID=$P(ORBAL,U)
  1.  ..S ORBSMSG=$P(ORBAL,U,2)
  1.  ..S ORY(ORJ)="RECIPIENTS OF ALERT: "_ORBSMSG,ORJ=ORJ+1
  1.  ..D GETRECS(ORBAID)  ;get recipient data
  1.  ..S ORJ=ORJ+1,ORY(ORJ)="",ORJ=ORJ+1,ORY(ORJ)="",ORJ=ORJ+1
  1.  S DESC="Recipients of a Kernel Alert"
  1.  S HDR="RECIPIENTS OF ALERTS FOR PATIENT: "_ORBPT
  1.  D OUTPUT(.ORY,DESC,HDR)
  1.  S VALMBCK="R"
  1.  Q
  1. LMHDR ; header for ListMgr display
  1.  S VALMHDR(1)="Alerts for "_ORBPT
  1.  Q
  1. LMHELP ; help for List Mgr display
  1.  N X
  1.  D FULL^VALM1 S VALMBCK="R"
  1.  W !!,"Enter the display number of the alert whose recipients you wish to review in detail."
  1.  W !!,"Press <return> to continue ..."
  1.  R X:DTIME
  1.  Q
  1. LMEXIT ; exit code for List Mgr display
  1.  D CLEAR^VALM1
  1.  K ORBPT,^TMP("OR",$J,"ALERTS"),XQORM("ALT"),^TMP("ORB",$J)
  1.  Q
  1. LMALT ; alternative selection code
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  Q
  1. LMENTRY ; entry code for List Mgr display
  1.  N ORBA,ORBAID,ORBDT,ORBMSG,ORBX,ORNUM,ORDATA,ORAD,LCNT,NUM
  1.  N ORX,ORY,ORBMSGP1,ORBMSGP2
  1.  ;
  1.  D CLEAN^VALM10
  1.  ;
  1.  S ORBA="" F  S ORBA=$O(^TMP("ORB",$J,ORBA)) Q:ORBA=""  D
  1.  .S ORBX=$G(^TMP("ORB",$J,ORBA)) I $L(ORBX) D
  1.  ..S ORBAID=$P(ORBX,U,2)
  1.  ..Q:$P(ORBAID,",")'="OR"  ;quit if not "OR" (OE/RR Notifications) alert
  1.  ..W "."
  1.  ..;
  1.  ..;get alert details:
  1.  ..D ALERTDAT^XQALBUTL(ORBAID,"ORAD")
  1.  ..S ORBMSG=ORAD(1.01) I $L(ORBMSG) D
  1.  ...S ORBDT=$P(ORAD(.02),U)
  1.  ...S ORDATA=$G(ORAD(2))
  1.  ...S ORNUM=""
  1.  ...I ORDATA["@" S ORNUM=$P(ORDATA,"@")
  1.  ...S ORNUM=$S(+$G(ORNUM)>0:"["_+ORNUM_"]",1:"")
  1.  ...S ORBMSG=$P(ORBMSG,"): ",2)
  1.  ...S ORBMSGP1=$P(ORBMSG,":",1)   ;jeh
  1.  ...S ORBMSGP2=$P(ORBMSG,":",2,3)   ;jeh 
  1.  ...I $G(ORBMSGP1)="Order(s) needing clarification" D    ;jeh Shorten output to make room for OR IEN 
  1.  ....S ORBMSGP1="Order needs clarifying"  ;jeh
  1.  ....S ORBMSG=ORBMSGP1_":"_ORBMSGP2   ;jeh
  1.  ...S ORBMSG=$E(ORBMSG_$S($L(ORNUM):" "_$G(ORNUM),1:"")_U_"                                                            ",1,60)
  1.  ...S ^TMP("OR",$J,"ALERTS","B",9999999-ORBDT_ORBAID)=ORBAID_U_$P(ORBMSG,U)_U_$$FMTE^XLFDT($E(ORBDT,1,12),"2")
  1.  ;
  1.  S (LCNT,NUM)=0
  1.  S ORX="" F  S ORX=$O(^TMP("OR",$J,"ALERTS","B",ORX)) Q:ORX=""  D
  1.  .S ORY=^TMP("OR",$J,"ALERTS","B",ORX)
  1.  .S ORBMSG=$P(ORY,U,2)
  1.  .S ORBDT=$P(ORY,U,3)
  1.  .S LCNT=LCNT+1,NUM=NUM+1
  1.  .S ^TMP("OR",$J,"ALERTS","IDX",NUM)=ORY   ;alert id^text^date/time
  1.  .S ^TMP("OR",$J,"ALERTS",LCNT,0)=$$LJ^XLFSTR(NUM,4)_$$LJ^XLFSTR(ORBMSG,61)_$$LJ^XLFSTR(ORBDT,15)
  1.  .D CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
  1.  ;
  1.  S ^TMP("OR",$J,"ALERTS",0)=LCNT_U_NUM_U_"Patient Alerts"
  1.  S ^TMP("OR",$J,"ALERTS","#")=$O(^ORD(101,"B","OR SELECT ALERTS",0))_"^1:"_NUM
  1.  K VALMHDR
  1.  S VALMCNT=LCNT,VALMBG=1,VALMBCK="R"
  1.  Q
  1. GETRECS(ORBAID)  ;get recipient data for an alert
  1.  N ORX,ORBI,ORBR,ORBHX
  1.  D AHISTORY^XQALBUTL(ORBAID,"ORBHX")
  1.  S:$L($G(ORBHX(20,0))) ORX=$P(ORBHX(20,0),U,4)
  1.  F ORBI=1:1:ORX D
  1.  .S ORBR=ORBHX(20,ORBI,0)
  1.  .S ORY(ORJ)="",ORJ=ORJ+1
  1.  .S ORY(ORJ)=$P(^VA(200,$P(ORBR,U),0),U),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  1st displayed to recipient: "_$$FMTE^XLFDT($P(ORBR,U,2),"1"),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  1st selected by recipient:  "_$$FMTE^XLFDT($P(ORBR,U,3),"1"),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  Processed by recipient:     "_$$FMTE^XLFDT($P(ORBR,U,4),"1"),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  Deleted:                    "_$$FMTE^XLFDT($P(ORBR,U,5),"1"),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  Auto deleted:               "_$$FMTE^XLFDT($P(ORBR,U,6),"1"),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  Forwarded by:               "_$S($P(ORBR,U,7):$P(^VA(200,$P(ORBR,U,7),0),U),1:""),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  Forwarded to recipient:     "_$$FMTE^XLFDT($P(ORBR,U,8),"1"),ORJ=ORJ+1
  1.  .S ORY(ORJ)="  Non-process deletion by:    "_$S($P(ORBR,U,9):$P(^VA(200,$P(ORBR,U,9),0),U),1:""),ORJ=ORJ+1
  1.  Q
  1. RECIPS ;determine/report the list of recipients for a notification
  1.  N ORY,ORN,ORBDFN,ORNUM,ORBADUZ,DESC,HDR,ORBPR,ORDIV
  1.  ;prompt for patient (required):
  1.  K DIC S DIC="^DPT(",DIC("A")="PATIENT (req'd): ",DIC(0)="AEQNM" D ^DIC Q:Y<1
  1.  S ORBDFN=+Y
  1.  Q:$D(DUOUT)
  1.  K DIC,Y,DUOUT,DTOUT
  1.  ;
  1.  ;prompt for notification (required):
  1.  S DIC="^ORD(100.9,",DIC("A")="NOTIFICATION (req'd): ",DIC(0)="AEQN" D ^DIC Q:Y<1
  1.  S ORN=+Y
  1.  Q:$D(DUOUT)
  1.  K DIC,Y,DUOUT,DTOUT
  1.  ;
  1.  S ORBPR=$$GET^XPAR("DIV^SYS^PKG","ORB PROVIDER RECIPIENTS",ORN,"I")
  1.  ;
  1.  ;prompt for order num if notif processes order num or is a flagged oi:
  1.  I (ORN=32)!(ORN=41)!(ORN=60)!(ORN=61)!(ORN=64)!(ORN=65)!(ORBPR["O")!(ORBPR["E") D
  1.  .K DIR S DIR(0)="NAO^::2",DIR("A")="ORDER NUMBER: "
  1.  .S DIR("?",1)="This notification uses order number to help determine alert recipients."
  1.  .S DIR("?",2)="Enter the order number associated with the alert for most accurate results."
  1.  .S DIR("?",3)="Order number must be entered as a whole number (e.g. 458829)."
  1.  .;
  1.  .S DIR("?")=" "
  1.  .D ^DIR
  1.  .S ORNUM=+Y
  1.  .I +$G(ORNUM)>0 D
  1.  ..S ORDIV=$$ORDIV^ORB31(ORNUM)
  1.  ..S:+$G(ORDIV)>0 ORBPR=$$GET^XPAR(ORDIV_";DIV(4,^SYS^PKG","ORB PROVIDER RECIPIENTS",ORN,"I")
  1.  Q:$D(DUOUT)
  1.  K DIR,Y,X,DTOUT,DUOUT,DIRUT
  1.  ;
  1.  ; get recipients for Lab Threshold notif:
  1.  I ORN=68 D LABTHR^ORB3U2(.ORBADUZ,ORBDFN,$G(ORNUM))
  1.  ;
  1.  ;prompt for pkg-defined recips if normally occurs with notif:
  1.  I (ORN=21)!(ORN=22)!(ORN=23)!(ORN=27)!(ORN=30)!(ORN=51)!(ORN=52)!(ORN=53)!(ORN=63) D
  1.  .F  K DIC,Y S DIC="^VA(200,",DIC(0)="AEQN",DIC("A")="RECIPIENT(S) FROM PACKAGE WHEN NOTIF WAS TRIGGERED: " D ^DIC Q:Y<1  S ORBADUZ(+Y)=""
  1.  Q:$D(DUOUT)
  1.  K DIC,Y,DUOUT,DTOUT
  1.  ;
  1.  ;prompt for recips entered at special GUI recipients prompts:
  1.  I (ORN=6)!(ORN=33) D
  1.  .F  K DIC,Y S DIC="^VA(200,",DIC(0)="AEQN",DIC("A")="RECIPIENT(S) ENTERED AT GUI PROMPTS: " D ^DIC Q:Y<1  S ORBADUZ(+Y)=""
  1.  Q:$D(DUOUT)
  1.  K DIC,Y,DUOUT,DTOUT
  1.  ;
  1.  W !,"Processing, please stand by..."
  1.  ;determine recipients and why:
  1.  S ORY="1"
  1.  D UTL^ORB3(.ORY,ORN,ORBDFN,$G(ORNUM),.ORBADUZ,"","")
  1.  S DESC="Determine Notification Recipients Report"
  1.  S HDR="DETERMINE NOTIFICATION RECIPIENTS REPORT"
  1.  D OUTPUT(.ORY,DESC,HDR)
  1.  Q
  1. OUTPUT(ORY,ORBDESC,ORBHDR) ;prompt for device and send report
  1.  N POP
  1.  ;prompt for device:
  1.  S %ZIS="Q"  ;prompt for Queueing
  1.  D ^%ZIS
  1.  Q:$G(POP)>0
  1.  I $D(IO("Q")) D  ;queue the report
  1.  .S ZTRTN="PRINT^ORB3U1"
  1.  .S ZTSAVE("ORY(")="",ZTSAVE("ORBHDR")=""
  1.  .S ZTDESC=ORBDESC
  1.  .D ^%ZTLOAD
  1.  .K ZTDESC,ZTRTN,ZTSAVE
  1.  .I $D(ZTSK)[0 W !!?5,"Report canceled!"
  1.  .E  W !!?5,"Report queued."
  1.  .D HOME^%ZIS
  1.  K %ZIS
  1.  I $D(IO("Q")) K IO("Q") Q
  1. PRINT ;print body of Determine Notification Recipients Report
  1.  N END,PAGE,X
  1.  S (END,PAGE,I)=0
  1.  U IO
  1.  D @("HDR"_(2-($E(IOST,1,2)="C-")))
  1.  F  S I=$O(ORY(I)) Q:I=""!(END=1)  D
  1.  .D HDR:$Y+5>IOSL
  1.  .Q:END=1
  1.  .W !,ORY(I)
  1.  I END=1 W !!,"           - Report Interrupted -",!
  1.  E  W !!!,"           - End of Report -",!
  1.  I ($E(IOST,1,2)="C-") W !,"Press RETURN to continue: " R X:DTIME
  1.  D ^%ZISC
  1.  D:$G(ZTSK) KILL^%ZTLOAD
  1.  Q
  1. HDR ;print header of report
  1.  I PAGE,($E(IOST,1,2)="C-") D
  1.  .W !,"Press RETURN to continue or '^' to exit: "
  1.  .R X:DTIME S END='$T!(X="^")
  1.  Q:END=1
  1. HDR1 W:'($E(IOST,1,2)='"C-"&'PAGE) @IOF
  1. HDR2 S PAGE=PAGE+1 W ?20,ORBHDR
  1.  W ?(IOM-10),"Page: ",$J(PAGE,3),!!
  1.  Q