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

ORB3FUP1.m

Go to the documentation of this file. 
  1. ORB3FUP1 ; slc/CLA - Routine to support notification follow-up actions ; 4/8/08 9:32am
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139,243**;Dec 17, 1997;Build 242
  1.  Q
  1. TYPE(ORBY,ORXQAID) ; return notif follow-up action type
  1.  N NIEN
  1.  S NIEN=$P($P(ORXQAID,";"),",",3)
  1.  S ORBY=$G(^ORD(100.9,NIEN,3))
  1.  I ORBY="" S ORBY="INFO^"
  1.  E  S ORBY=$P(ORBY,U,2)
  1.  Q
  1. GUI(ORBY,ORXQAID) ; Notification follow-up for GUI called via API: ORB FOLLOW-UP
  1.  ; called by ORB FOLLOW-UP api:
  1.  S ORENVIR="GUI"
  1.  D PROCESS
  1.  Q
  1. PROCESS ; main process for notification follow-up
  1.  ;ORXQAID = OR,dfn,nien;
  1.  ;XQADATA = placer num^placer id;filler num^filler id
  1.  ;XQAKILL = value of parameter ORB DELETE MECHANISM for notif in 100.9
  1.  N ORPDIEN,ORN,ORDFN,ORSITE,ORFID,ORFIEN,ORKILL
  1.  D GETACT^XQALERT(ORXQAID)  ;return follow-up action info
  1.  ;Q:'($D(XQADATA))  Q:'($D(XQAID))
  1.  ;Q:($P(XQAID,",")'="OR")
  1.  ;call function rpc stored in xqarou with params from xqadata
  1.  D @XQAROU
  1.  K ORENVIR
  1.  Q
  1. MSG ; display msg re: alert being processed for non-GUI follow-up actions
  1.  I $G(ORENVIR)'="GUI" D
  1.  .I $L($G(XQX)) W !!,"Processing alert: ",$P(XQX,U,3) H 1.5
  1.  Q
  1. DEL(ORBY,XQAID,ORKILL) ; delete an alert
  1.  N ORN
  1.  S ORN=$P($P(XQAID,";"),",",3)
  1.  I $G(ORKILL)=1!($G(ORKILL)=0) S XQAKILL=ORKILL
  1.  I $G(XQAKILL)="" S XQAKILL=$$XQAKILL^ORB3F1(ORN)
  1.  I $G(XQAKILL)="" S XQAKILL=1
  1.  S ORBY="FALSE"
  1.  I $L($G(XQAID)) D DELETE^XQALERT S ORBY="TRUE"
  1.  K XQAKILL
  1.  Q
  1. CSORD ;co-sign order(s) follow-up
  1.  K XQAKILL
  1.  N ORPT,ORDG,ORBXQAID,ORY S ORBXQAID=XQAID
  1.  S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
  1.  ;the FLG code for orders requiring CO-SIGNATURE in ORQ1 is 'to be determined when ASU is available'
  1.  D DEL(.ORY,XQAID)  ;until ASU is implemented, delete the alert and quit
  1.  Q  ;quit until ASU is implemented
  1.  ;I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",???,"","")
  1.  ;I $G(ORENVIR)'="GUI" D 
  1.  ;.D MSG
  1.  ;.S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
  1.  ;.D EN^ORCB(ORPT,???,ORDG,???)
  1.  ;.K ^TMP("ORR",$J)
  1.  ;.D EN^ORQ1(ORPT_";DPT(",ORDG,???,"","","",0,0)
  1.  ;.S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
  1.  ;..D DEL(.ORY,ORBXQAID)  ;if no more orders req. co-sign, delete the alert
  1.  ;.K ^TMP("ORR",$J)
  1.  Q
  1. EXDNR ;expiring dnr follow-up
  1.  K XQAKILL
  1.  N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
  1.  S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
  1.  N DNRORD,DNRY S DNRORD=$P(XQADATA,"@")
  1.  I $G(ORENVIR)="GUI" D
  1.  .S ORBY(1)=DNRY
  1.  I $G(ORENVIR)'="GUI" D
  1.  .D MSG
  1.  .D EN1^ORCB(DNRORD,"RENEW")  ;display order, allow renewing, then delete
  1.  .D DEL(.ORY,ORBXQAID)
  1.  Q
  1. UNLINKED ;unlinked provider follow-up
  1.  K XQAKILL
  1.  N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
  1.  S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
  1.  N ORNUM,ORUNY S ORNUM=$P(XQADATA,"@")
  1.  I $G(ORENVIR)="GUI" D 
  1.  .S ORBY(1)=ORUNY
  1.  I $G(ORENVIR)'="GUI" D
  1.  .D MSG
  1.  .D EN1^ORCB(ORNUM,"REPLACE")  ;display order, allow replace, then delete
  1.  .D DEL(.ORY,ORBXQAID)
  1.  Q
  1. FLORD ;flagged order(s) follow-up
  1.  K XQAKILL
  1.  N ORPT,ORDG,X,ORBXQAID,ORY,ORBLMDEL
  1.  S ORBXQAID=XQAID
  1.  S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
  1.  ;the FLG code for "FLAGGED" in ORQ1 is '12'
  1.  I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",12,"","")
  1.  I $G(ORENVIR)'="GUI" D 
  1.  .D MSG
  1.  .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
  1.  .D EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
  1.  .K ^TMP("ORR",$J)
  1.  .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
  1.  .D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
  1.  .S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
  1.  ..D DEL(.ORY,ORBXQAID)  ;if no more flagged orders found, delete alert
  1.  .K ^TMP("ORR",$J)
  1.  Q
  1. NEWORD ;new order(s) follow-up
  1.  K XQAKILL
  1.  N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
  1.  S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
  1.  S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
  1.  ;the FLG code for NEW orders since last reviewed orders in ORQ1 is '6'
  1.  I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
  1.  I $G(ORENVIR)'="GUI" D 
  1.  .D MSG
  1.  .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
  1.  .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
  1.  .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
  1.  .D DEL(.ORY,ORBXQAID) ;delete the alert
  1.  Q
  1. DCORD ;DC order(s) follow-up
  1.  K XQAKILL
  1.  N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
  1.  S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
  1.  S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
  1.  ;the FLG code for DC orders is '3'
  1.  I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
  1.  I $G(ORENVIR)'="GUI" D 
  1.  .D MSG
  1.  .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
  1.  .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
  1.  .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
  1.  .D DEL(.ORY,ORBXQAID) ;delete the alert
  1.  Q
  1. NUMORD ;detailed order display follow-up - return order number
  1.  K XQAKILL
  1.  N ORBXQAID,ORY S ORBXQAID=XQAID
  1.  S ORNUM=$P(XQADATA,"@")
  1.  I $G(ORENVIR)="GUI" D
  1.  .Q
  1.  I $G(ORENVIR)'="GUI" D
  1.  .D MSG
  1.  .D EN1^ORCB(+ORNUM,"NEW")  ;display order, allow new order then delete
  1.  .D DEL(.ORY,ORBXQAID)
  1.  Q
  1. ESORD ;order(s) requiring electronic signature follow-up
  1.  K XQAKILL
  1.  N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
  1.  S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
  1.  S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
  1.  ;the FLG code for UNSIGNED orders in ORQ1 is '11'
  1.  I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",11,"","")
  1.  I $G(ORENVIR)'="GUI" D 
  1.  .D MSG
  1.  .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
  1.  .D EN^ORCB(ORPT,11,ORDG,.ORBLMDEL)
  1.  .K ^TMP("ORR",$J)  ;clean up array
  1.  .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
  1.  .I $L($G(XQAID)) D  ;EN^ORCB may kill XQAID in its follow-up
  1.  ..;
  1.  ..;get unsigned orders - if none exist, delete alert then quit:
  1.  ..D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
  1.  ..S ORX="",ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""  I +$G(^TMP("ORR",$J,ORX,"TOT"))<1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
  1.  ..;
  1.  ..;user does not have ORES key, delete user's alert:
  1.  ..I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
  1.  ..;
  1.  ..;if prov is NOT linked to pt via attending, primary, teams or PCMM:
  1.  ..I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
  1.  ...S ORX="" F  S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1)  D
  1.  ....S ORZ="" F  S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:ORZ=""!(ORDERS=1)  D
  1.  .....S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
  1.  .....;quit if this unsigned order's last action was made by the user
  1.  .....I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
  1.  ...I ORDERS'=1 D  ;provider has no outstanding unsiged orders for pt
  1.  ....S XQAKILL=1 D DEL(.ORY,ORBXQAID) ;delete alert for this user
  1.  ..K ^TMP("ORR",$J)
  1.  Q
  1. UNFLAG(ORPT) ;order unflagged - delete alert if no more flagged orders
  1.  N ORDG,ORDOIT,ORQUIT,X,XQAID,XQAKILL,XQAUSER
  1.  S ORDOIT=1,ORQUIT=0
  1.  S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
  1.  K ^TMP("ORR",$J)
  1.  D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
  1.  ;========DELETE ALERT (FOR ALL USERS) IF NO FLAGGED ORDERS AT ALL=====
  1.  S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
  1.  .;if no more flagged orders found, delete alert:
  1.  .S XQAKILL=$$XQAKILL^ORB3F1(6)
  1.  .I $G(XQAKILL)="" S XQAKILL=1
  1.  .S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL S ORQUIT=1
  1.  Q:ORQUIT
  1.  ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT IS UNFLAGGING=====
  1.  S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  D
  1.  .N Y S Y="" F  S Y=$O(^TMP("ORR",$J,X,Y)) Q:'Y  D
  1.  ..N ORDER S ORDER=$G(^TMP("ORR",$J,X,Y))
  1.  ..I $$FLAGRULE^ORWORR1(+ORDER)=0 S ORDOIT=0 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
  1.  I ORDOIT D
  1.  .;if no more flagged orders found for this user, delete alert only for this user:
  1.  .S XQAKILL=1
  1.  .S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL
  1.  ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT WAS THE ALERTED PROVIDER OF THE CURRENT ORDER=====
  1.  S ORDOIT=1
  1.  ;get the alerted provider
  1.  I $G(ORIFN) D
  1.  .N ORD,ORACT S ORD=+$G(ORIFN),ORACT=$P($G(ORIFN),";",2)
  1.  .N ORUSR S ORUSR=$P($G(^OR(100,ORD,8,ORACT,3)),U,9)
  1.  .I ORUSR D
  1.  ..S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  D
  1.  ...N Y S Y="" F  S Y=$O(^TMP("ORR",$J,X,Y)) Q:'Y  D
  1.  ....N ORDER S ORDER=$G(^TMP("ORR",$J,X,Y))
  1.  ....I $$FLAGRULE^ORWORR1(+ORDER,ORUSR)=0 S ORDOIT=0 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
  1.  ..I ORDOIT D
  1.  ...;if no more flagged orders found for this user, delete alert only for this user:
  1.  ...S XQAKILL=1,XQAUSER=ORUSR
  1.  ...S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL,XQAUSER
  1.  K ^TMP("ORR",$J)
  1.  Q