source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3FUP1.m@ 623

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