Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3FUP1.m

    r613 r623  
    1 ORB3FUP1        ; slc/CLA - Routine to support notification follow-up actions ; 4/8/08 9:32am
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139,243**;Dec 17, 1997;Build 242
    3         Q
    4 TYPE(ORBY,ORXQAID)      ; return notif follow-up action type
    5         N NIEN
    6         S NIEN=$P($P(ORXQAID,";"),",",3)
    7         S ORBY=$G(^ORD(100.9,NIEN,3))
    8         I ORBY="" S ORBY="INFO^"
    9         E  S ORBY=$P(ORBY,U,2)
    10         Q
    11 GUI(ORBY,ORXQAID)       ; Notification follow-up for GUI called via API: ORB FOLLOW-UP
    12         ; called by ORB FOLLOW-UP api:
    13         S ORENVIR="GUI"
    14         D PROCESS
    15         Q
    16 PROCESS ; main process for notification follow-up
    17         ;ORXQAID = OR,dfn,nien;
    18         ;XQADATA = placer num^placer id;filler num^filler id
    19         ;XQAKILL = value of parameter ORB DELETE MECHANISM for notif in 100.9
    20         N ORPDIEN,ORN,ORDFN,ORSITE,ORFID,ORFIEN,ORKILL
    21         D GETACT^XQALERT(ORXQAID)  ;return follow-up action info
    22         ;Q:'($D(XQADATA))  Q:'($D(XQAID))
    23         ;Q:($P(XQAID,",")'="OR")
    24         ;call function rpc stored in xqarou with params from xqadata
    25         D @XQAROU
    26         K ORENVIR
    27         Q
    28 MSG     ; display msg re: alert being processed for non-GUI follow-up actions
    29         I $G(ORENVIR)'="GUI" D
    30         .I $L($G(XQX)) W !!,"Processing alert: ",$P(XQX,U,3) H 1.5
    31         Q
    32 DEL(ORBY,XQAID,ORKILL)  ; delete an alert
    33         N ORN
    34         S ORN=$P($P(XQAID,";"),",",3)
    35         I $G(ORKILL)=1!($G(ORKILL)=0) S XQAKILL=ORKILL
    36         I $G(XQAKILL)="" S XQAKILL=$$XQAKILL^ORB3F1(ORN)
    37         I $G(XQAKILL)="" S XQAKILL=1
    38         S ORBY="FALSE"
    39         I $L($G(XQAID)) D DELETE^XQALERT S ORBY="TRUE"
    40         K XQAKILL
    41         Q
    42 CSORD   ;co-sign order(s) follow-up
    43         K XQAKILL
    44         N ORPT,ORDG,ORBXQAID,ORY S ORBXQAID=XQAID
    45         S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
    46         ;the FLG code for orders requiring CO-SIGNATURE in ORQ1 is 'to be determined when ASU is available'
    47         D DEL(.ORY,XQAID)  ;until ASU is implemented, delete the alert and quit
    48         Q  ;quit until ASU is implemented
    49         ;I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",???,"","")
    50         ;I $G(ORENVIR)'="GUI" D
    51         ;.D MSG
    52         ;.S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
    53         ;.D EN^ORCB(ORPT,???,ORDG,???)
    54         ;.K ^TMP("ORR",$J)
    55         ;.D EN^ORQ1(ORPT_";DPT(",ORDG,???,"","","",0,0)
    56         ;.S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
    57         ;..D DEL(.ORY,ORBXQAID)  ;if no more orders req. co-sign, delete the alert
    58         ;.K ^TMP("ORR",$J)
    59         Q
    60 EXDNR   ;expiring dnr follow-up
    61         K XQAKILL
    62         N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
    63         S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
    64         N DNRORD,DNRY S DNRORD=$P(XQADATA,"@")
    65         I $G(ORENVIR)="GUI" D
    66         .S ORBY(1)=DNRY
    67         I $G(ORENVIR)'="GUI" D
    68         .D MSG
    69         .D EN1^ORCB(DNRORD,"RENEW")  ;display order, allow renewing, then delete
    70         .D DEL(.ORY,ORBXQAID)
    71         Q
    72 UNLINKED        ;unlinked provider follow-up
    73         K XQAKILL
    74         N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
    75         S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
    76         N ORNUM,ORUNY S ORNUM=$P(XQADATA,"@")
    77         I $G(ORENVIR)="GUI" D
    78         .S ORBY(1)=ORUNY
    79         I $G(ORENVIR)'="GUI" D
    80         .D MSG
    81         .D EN1^ORCB(ORNUM,"REPLACE")  ;display order, allow replace, then delete
    82         .D DEL(.ORY,ORBXQAID)
    83         Q
    84 FLORD   ;flagged order(s) follow-up
    85         K XQAKILL
    86         N ORPT,ORDG,X,ORBXQAID,ORY,ORBLMDEL
    87         S ORBXQAID=XQAID
    88         S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
    89         ;the FLG code for "FLAGGED" in ORQ1 is '12'
    90         I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",12,"","")
    91         I $G(ORENVIR)'="GUI" D
    92         .D MSG
    93         .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
    94         .D EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
    95         .K ^TMP("ORR",$J)
    96         .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
    97         .D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
    98         .S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
    99         ..D DEL(.ORY,ORBXQAID)  ;if no more flagged orders found, delete alert
    100         .K ^TMP("ORR",$J)
    101         Q
    102 NEWORD  ;new order(s) follow-up
    103         K XQAKILL
    104         N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
    105         S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
    106         S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
    107         ;the FLG code for NEW orders since last reviewed orders in ORQ1 is '6'
    108         I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
    109         I $G(ORENVIR)'="GUI" D
    110         .D MSG
    111         .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
    112         .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
    113         .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
    114         .D DEL(.ORY,ORBXQAID) ;delete the alert
    115         Q
    116 DCORD   ;DC order(s) follow-up
    117         K XQAKILL
    118         N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
    119         S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
    120         S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
    121         ;the FLG code for DC orders is '3'
    122         I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
    123         I $G(ORENVIR)'="GUI" D
    124         .D MSG
    125         .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
    126         .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
    127         .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
    128         .D DEL(.ORY,ORBXQAID) ;delete the alert
    129         Q
    130 NUMORD  ;detailed order display follow-up - return order number
    131         K XQAKILL
    132         N ORBXQAID,ORY S ORBXQAID=XQAID
    133         S ORNUM=$P(XQADATA,"@")
    134         I $G(ORENVIR)="GUI" D
    135         .Q
    136         I $G(ORENVIR)'="GUI" D
    137         .D MSG
    138         .D EN1^ORCB(+ORNUM,"NEW")  ;display order, allow new order then delete
    139         .D DEL(.ORY,ORBXQAID)
    140         Q
    141 ESORD   ;order(s) requiring electronic signature follow-up
    142         K XQAKILL
    143         N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
    144         S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
    145         S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
    146         ;the FLG code for UNSIGNED orders in ORQ1 is '11'
    147         I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",11,"","")
    148         I $G(ORENVIR)'="GUI" D
    149         .D MSG
    150         .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
    151         .D EN^ORCB(ORPT,11,ORDG,.ORBLMDEL)
    152         .K ^TMP("ORR",$J)  ;clean up array
    153         .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
    154         .I $L($G(XQAID)) D  ;EN^ORCB may kill XQAID in its follow-up
    155         ..;
    156         ..;get unsigned orders - if none exist, delete alert then quit:
    157         ..D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
    158         ..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
    159         ..;
    160         ..;user does not have ORES key, delete user's alert:
    161         ..I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
    162         ..;
    163         ..;if prov is NOT linked to pt via attending, primary, teams or PCMM:
    164         ..I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
    165         ...S ORX="" F  S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1)  D
    166         ....S ORZ="" F  S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:ORZ=""!(ORDERS=1)  D
    167         .....S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
    168         .....;quit if this unsigned order's last action was made by the user
    169         .....I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
    170         ...I ORDERS'=1 D  ;provider has no outstanding unsiged orders for pt
    171         ....S XQAKILL=1 D DEL(.ORY,ORBXQAID) ;delete alert for this user
    172         ..K ^TMP("ORR",$J)
    173         Q
    174 UNFLAG(ORPT)    ;order unflagged - delete alert if no more flagged orders
    175         N ORDG,ORDOIT,ORQUIT,X,XQAID,XQAKILL,XQAUSER
    176         S ORDOIT=1,ORQUIT=0
    177         S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
    178         K ^TMP("ORR",$J)
    179         D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
    180         ;========DELETE ALERT (FOR ALL USERS) IF NO FLAGGED ORDERS AT ALL=====
    181         S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
    182         .;if no more flagged orders found, delete alert:
    183         .S XQAKILL=$$XQAKILL^ORB3F1(6)
    184         .I $G(XQAKILL)="" S XQAKILL=1
    185         .S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL S ORQUIT=1
    186         Q:ORQUIT
    187         ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT IS UNFLAGGING=====
    188         S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  D
    189         .N Y S Y="" F  S Y=$O(^TMP("ORR",$J,X,Y)) Q:'Y  D
    190         ..N ORDER S ORDER=$G(^TMP("ORR",$J,X,Y))
    191         ..I $$FLAGRULE^ORWORR1(+ORDER)=0 S ORDOIT=0 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
    192         I ORDOIT D
    193         .;if no more flagged orders found for this user, delete alert only for this user:
    194         .S XQAKILL=1
    195         .S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL
    196         ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT WAS THE ALERTED PROVIDER OF THE CURRENT ORDER=====
    197         S ORDOIT=1
    198         ;get the alerted provider
    199         I $G(ORIFN) D
    200         .N ORD,ORACT S ORD=+$G(ORIFN),ORACT=$P($G(ORIFN),";",2)
    201         .N ORUSR S ORUSR=$P($G(^OR(100,ORD,8,ORACT,3)),U,9)
    202         .I ORUSR D
    203         ..S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  D
    204         ...N Y S Y="" F  S Y=$O(^TMP("ORR",$J,X,Y)) Q:'Y  D
    205         ....N ORDER S ORDER=$G(^TMP("ORR",$J,X,Y))
    206         ....I $$FLAGRULE^ORWORR1(+ORDER,ORUSR)=0 S ORDOIT=0 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
    207         ..I ORDOIT D
    208         ...;if no more flagged orders found for this user, delete alert only for this user:
    209         ...S XQAKILL=1,XQAUSER=ORUSR
    210         ...S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL,XQAUSER
    211         K ^TMP("ORR",$J)
    212         Q
     1ORB3FUP1 ; slc/CLA - Routine to support notification follow-up actions ;7/15/95  17:23
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139**;Dec 17, 1997
     3 Q
     4TYPE(ORBY,ORXQAID) ; return notif follow-up action type
     5 N NIEN
     6 S NIEN=$P($P(ORXQAID,";"),",",3)
     7 S ORBY=$G(^ORD(100.9,NIEN,3))
     8 I ORBY="" S ORBY="INFO^"
     9 E  S ORBY=$P(ORBY,U,2)
     10 Q
     11GUI(ORBY,ORXQAID) ; Notification follow-up for GUI called via API: ORB FOLLOW-UP
     12 ; called by ORB FOLLOW-UP api:
     13 S ORENVIR="GUI"
     14 D PROCESS
     15 Q
     16PROCESS ; main process for notification follow-up
     17 ;ORXQAID = OR,dfn,nien;
     18 ;XQADATA = placer num^placer id;filler num^filler id
     19 ;XQAKILL = value of parameter ORB DELETE MECHANISM for notif in 101.9
     20 N ORPDIEN,ORN,ORDFN,ORSITE,ORFID,ORFIEN,ORKILL
     21 D GETACT^XQALERT(ORXQAID)  ;return follow-up action info
     22 ;Q:'($D(XQADATA))  Q:'($D(XQAID))
     23 ;Q:($P(XQAID,",")'="OR")
     24 ;call function rpc stored in xqarou with params from xqadata
     25 D @XQAROU
     26 K ORENVIR
     27 Q
     28MSG ; display msg re: alert being processed for non-GUI follow-up actions
     29 I $G(ORENVIR)'="GUI" D
     30 .I $L($G(XQX)) W !!,"Processing alert: ",$P(XQX,U,3) H 1.5
     31 Q
     32DEL(ORBY,XQAID,ORKILL) ; delete an alert
     33 N ORN
     34 S ORN=$P($P(XQAID,";"),",",3)
     35 I $G(ORKILL)=1!($G(ORKILL)=0) S XQAKILL=ORKILL
     36 I $G(XQAKILL)="" S XQAKILL=$$XQAKILL^ORB3F1(ORN)
     37 I $G(XQAKILL)="" S XQAKILL=1
     38 S ORBY="FALSE"
     39 I $L($G(XQAID)) D DELETE^XQALERT S ORBY="TRUE"
     40 K XQAKILL
     41 Q
     42CSORD ;co-sign order(s) follow-up
     43 K XQAKILL
     44 N ORPT,ORDG,ORBXQAID,ORY S ORBXQAID=XQAID
     45 S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
     46 ;the FLG code for orders requiring CO-SIGNATURE in ORQ1 is 'to be determined when ASU is available'
     47 D DEL(.ORY,XQAID)  ;until ASU is implemented, delete the alert and quit
     48 Q  ;quit until ASU is implemented
     49 ;I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",???,"","")
     50 ;I $G(ORENVIR)'="GUI" D
     51 ;.D MSG
     52 ;.S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
     53 ;.D EN^ORCB(ORPT,???,ORDG,???)
     54 ;.K ^TMP("ORR",$J)
     55 ;.D EN^ORQ1(ORPT_";DPT(",ORDG,???,"","","",0,0)
     56 ;.S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
     57 ;..D DEL(.ORY,ORBXQAID)  ;if no more orders req. co-sign, delete the alert
     58 ;.K ^TMP("ORR",$J)
     59 Q
     60EXDNR ;expiring dnr follow-up
     61 K XQAKILL
     62 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
     63 S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
     64 N DNRORD,DNRY S DNRORD=$P(XQADATA,"@")
     65 I $G(ORENVIR)="GUI" D
     66 .S ORBY(1)=DNRY
     67 I $G(ORENVIR)'="GUI" D
     68 .D MSG
     69 .D EN1^ORCB(DNRORD,"RENEW")  ;display order, allow renewing, then delete
     70 .D DEL(.ORY,ORBXQAID)
     71 Q
     72UNLINKED ;unlinked provider follow-up
     73 K XQAKILL
     74 N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
     75 S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
     76 N ORNUM,ORUNY S ORNUM=$P(XQADATA,"@")
     77 I $G(ORENVIR)="GUI" D
     78 .S ORBY(1)=ORUNY
     79 I $G(ORENVIR)'="GUI" D
     80 .D MSG
     81 .D EN1^ORCB(ORNUM,"REPLACE")  ;display order, allow replace, then delete
     82 .D DEL(.ORY,ORBXQAID)
     83 Q
     84FLORD ;flagged order(s) follow-up
     85 K XQAKILL
     86 N ORPT,ORDG,X,ORBXQAID,ORY,ORBLMDEL
     87 S ORBXQAID=XQAID
     88 S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
     89 ;the FLG code for "FLAGGED" in ORQ1 is '12'
     90 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",12,"","")
     91 I $G(ORENVIR)'="GUI" D
     92 .D MSG
     93 .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
     94 .D EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
     95 .K ^TMP("ORR",$J)
     96 .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
     97 .D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
     98 .S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
     99 ..D DEL(.ORY,ORBXQAID)  ;if no more flagged orders found, delete alert
     100 .K ^TMP("ORR",$J)
     101 Q
     102NEWORD ;new order(s) follow-up
     103 K XQAKILL
     104 N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
     105 S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
     106 S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
     107 ;the FLG code for NEW orders since last reviewed orders in ORQ1 is '6'
     108 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
     109 I $G(ORENVIR)'="GUI" D
     110 .D MSG
     111 .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
     112 .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
     113 .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
     114 .D DEL(.ORY,ORBXQAID) ;delete the alert
     115 Q
     116DCORD ;DC order(s) follow-up
     117 K XQAKILL
     118 N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
     119 S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
     120 S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
     121 ;the FLG code for DC orders is '3'
     122 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
     123 I $G(ORENVIR)'="GUI" D
     124 .D MSG
     125 .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
     126 .D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
     127 .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
     128 .D DEL(.ORY,ORBXQAID) ;delete the alert
     129 Q
     130NUMORD ;detailed order display follow-up - return order number
     131 K XQAKILL
     132 N ORBXQAID,ORY S ORBXQAID=XQAID
     133 S ORNUM=$P(XQADATA,"@")
     134 I $G(ORENVIR)="GUI" D
     135 .Q
     136 I $G(ORENVIR)'="GUI" D
     137 .D MSG
     138 .D EN1^ORCB(+ORNUM,"NEW")  ;display order, allow new order then delete
     139 .D DEL(.ORY,ORBXQAID)
     140 Q
     141ESORD ;order(s) requiring electronic signature follow-up
     142 K XQAKILL
     143 N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
     144 S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
     145 S ORPT=$P($P(XQAID,";"),",",2)  ;get pt dfn from xqaid
     146 ;the FLG code for UNSIGNED orders in ORQ1 is '11'
     147 I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",11,"","")
     148 I $G(ORENVIR)'="GUI" D
     149 .D MSG
     150 .S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
     151 .D EN^ORCB(ORPT,11,ORDG,.ORBLMDEL)
     152 .K ^TMP("ORR",$J)  ;clean up array
     153 .Q:$G(ORBLMDEL)=1  ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
     154 .I $L($G(XQAID)) D  ;EN^ORCB may kill XQAID in its follow-up
     155 ..;
     156 ..;get unsigned orders - if none exist, delete alert then quit:
     157 ..D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
     158 ..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
     159 ..;
     160 ..;user does not have ORES key, delete user's alert:
     161 ..I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
     162 ..;
     163 ..;if prov is NOT linked to pt via attending, primary, teams or PCMM:
     164 ..I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
     165 ...S ORX="" F  S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1)  D
     166 ....S ORZ="" F  S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:ORZ=""!(ORDERS=1)  D
     167 .....S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
     168 .....;quit if this unsigned order's last action was made by the user
     169 .....I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
     170 ...I ORDERS'=1 D  ;provider has no outstanding unsiged orders for pt
     171 ....S XQAKILL=1 D DEL(.ORY,ORBXQAID) ;delete alert for this user
     172 ..K ^TMP("ORR",$J)
     173 Q
     174UNFLAG(ORPT) ;order unflagged - delete alert if no more flagged orders
     175 N ORDG
     176 S ORDG=$$DG^ORQOR1("ALL")  ;get Display Group ien
     177 K ^TMP("ORR",$J)
     178 D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
     179 S X="",X=$O(^TMP("ORR",$J,X)) Q:X=""  I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
     180 .;if no more flagged orders found, delete alert:
     181 .S XQAKILL=$$XQAKILL^ORB3F1(6)
     182 .I $G(XQAKILL)="" S XQAKILL=1
     183 .S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL
     184 K ^TMP("ORR",$J)
     185 Q
Note: See TracChangeset for help on using the changeset viewer.