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/OCXOZ0G.m

    r613 r623  
    1 OCXOZ0G ;SLC/RJS,CLA - Order Check Scan ;NOV 8,2009 at 18:44
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
    3         ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
    4         ;
    5         ; ***************************************************************
    6         ; ** Warning: This routine is automatically generated by the   **
    7         ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine  **
    8         ; ** will be lost the next time the rule compiler executes.    **
    9         ; ***************************************************************
    10         ;
    11         Q
    12         ;
    13 CHK482  ; Look through the current environment for valid Event/Elements for this patient.
    14         ;  Called from CHK446+17^OCXOZ0F.
    15         ;
    16         Q:$G(OCXOERR)
    17         ;
    18         ;    Local CHK482 Variables
    19         ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
    20         ; OCXDF(58) ---> Data Field: ABNORMAL RENAL BIOCHEM RESULTS (FREE TEXT)
    21         ;
    22         ;      Local Extrinsic Functions
    23         ; ABREN( -----------> DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW
    24         ; FILE(DFN,133, ----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: NO CREAT RESULTS W/IN X DAYS)
    25         ;
    26         S OCXDF(58)=$P($$ABREN(OCXDF(37)),"^",2),OCXOERR=$$FILE(DFN,133,"58,154") Q:OCXOERR
    27         Q
    28         ;
    29 CHK497  ; Look through the current environment for valid Event/Elements for this patient.
    30         ;  Called from CHK360+15^OCXOZ0D.
    31         ;
    32         Q:$G(OCXOERR)
    33         ;
    34         ;    Local CHK497 Variables
    35         ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
    36         ; OCXDF(74) ---> Data Field: VA DRUG CLASS (FREE TEXT)
    37         ; OCXDF(158) --> Data Field: DUPLICATE OPIOID MEDICATIONS TEXT (FREE TEXT)
    38         ;
    39         ;      Local Extrinsic Functions
    40         ; LIST( ------------> IN LIST OPERATOR
    41         ; OPIOID( ----------> OPIOID MEDICATIONS
    42         ;
    43         I $$LIST(OCXDF(74),"OPIOID ANALGESICS,OPIOID ANTAGONIST ANALGESICS") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(158)=$P($$OPIOID(OCXDF(37)),"^",2) D CHK501
    44         Q
    45         ;
    46 CHK50; Look through the current environment for valid Event/Elements for this patient.
    47         ;  Called from CHK497+14.
    48         ;
    49         Q:$G(OCXOERR)
    50         ;
    51         ;      Local Extrinsic Functions
    52         ; FILE(DFN,139, ----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: OPIOID MED ORDER)
    53         ;
    54         S OCXOERR=$$FILE(DFN,139,"158") Q:OCXOERR
    55         Q
    56         ;
    57 CHK505  ; Look through the current environment for valid Event/Elements for this patient.
    58         ;  Called from CHK355+14^OCXOZ0C.
    59         ;
    60         Q:$G(OCXOERR)
    61         ;
    62         ;    Local CHK505 Variables
    63         ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
    64         ; OCXDF(130) --> Data Field: CLOZAPINE LAB RESULTS (FREE TEXT)
    65         ; OCXDF(131) --> Data Field: PHARMACY LOCAL ID (FREE TEXT)
    66         ;
    67         ;      Local Extrinsic Functions
    68         ; FILE(DFN,140, ----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: CLOZAPINE ANC >= 1.5 & < 2.0)
    69         ;
    70         S OCXDF(130)=$P($$CLOZLABS^ORKLR(OCXDF(37),"",OCXDF(131)),"^",4),OCXOERR=$$FILE(DFN,140,"130") Q:OCXOERR
    71         Q
    72         ;
    73 EL24    ; Examine every rule that involves Element #24 [HL7 LAB TEST RESULTS CRITICAL]
    74         ;  Called from SCAN+9^OCXOZ01.
    75         ;
    76         Q:$G(OCXOERR)
    77         ;
    78         D R3R1A^OCXOZ0I   ; Check Relation #1 in Rule #3 'CRITICAL LAB RESULTS'
    79         Q
    80         ;
    81 EL105   ; Examine every rule that involves Element #105 [HL7 LAB ORDER RESULTS CRITICAL]
    82         ;  Called from SCAN+9^OCXOZ01.
    83         ;
    84         Q:$G(OCXOERR)
    85         ;
    86         D R3R2A^OCXOZ0J   ; Check Relation #2 in Rule #3 'CRITICAL LAB RESULTS'
    87         Q
    88         ;
    89 EL44    ; Examine every rule that involves Element #44 [ORDER FLAGGED]
    90         ;  Called from SCAN+9^OCXOZ01.
    91         ;
    92         Q:$G(OCXOERR)
    93         ;
    94         D R5R1A^OCXOZ0J   ; Check Relation #1 in Rule #5 'ORDER FLAGGED FOR CLARIFICATION'
    95         Q
    96         ;
    97 EL134   ; Examine every rule that involves Element #134 [ORDER UNFLAGGED]
    98         ;  Called from SCAN+9^OCXOZ01.
    99         ;
    100         Q:$G(OCXOERR)
    101         ;
    102         D R5R2A^OCXOZ0K   ; Check Relation #2 in Rule #5 'ORDER FLAGGED FOR CLARIFICATION'
    103         Q
    104         ;
    105 EL45    ; Examine every rule that involves Element #45 [ORDER REQUIRES CHART SIGNATURE]
    106         ;  Called from SCAN+9^OCXOZ01.
    107         ;
    108         Q:$G(OCXOERR)
    109         ;
    110         D R6R1A^OCXOZ0K   ; Check Relation #1 in Rule #6 'ORDER REQUIRES CHART SIGNATURE'
    111         Q
    112         ;
    113 EL21    ; Examine every rule that involves Element #21 [PATIENT ADMISSION]
    114         ;  Called from SCAN+9^OCXOZ01.
    115         ;
    116         Q:$G(OCXOERR)
    117         ;
    118         D R7R1A^OCXOZ0K   ; Check Relation #1 in Rule #7 'PATIENT ADMISSION'
    119         Q
    120         ;
    121 EL31    ; Examine every rule that involves Element #31 [RADIOLOGY ORDER CANCELLED]
    122         ;  Called from SCAN+9^OCXOZ01.
    123         ;
    124         Q:$G(OCXOERR)
    125         ;
    126         D R11R1A^OCXOZ0L   ; Check Relation #1 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
    127         Q
    128         ;
    129 EL100   ; Examine every rule that involves Element #100 [CANCELED BY NON-ORIG ORDERING PROVIDER]
    130         ;  Called from SCAN+9^OCXOZ01.
    131         ;
    132         Q:$G(OCXOERR)
    133         ;
    134         D R11R1A^OCXOZ0L   ; Check Relation #1 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
    135         D R11R2A^OCXOZ0L   ; Check Relation #2 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
    136         D R11R3A^OCXOZ0M   ; Check Relation #3 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
    137         D R35R1A^OCXOZ0Q   ; Check Relation #1 in Rule #35 'LAB ORDER CANCELLED'
    138         Q
    139         ;
    140 EL30    ; Examine every rule that involves Element #30 [RADIOLOGY ORDER PUT ON-HOLD]
    141         ;  Called from SCAN+9^OCXOZ01.
    142         ;
    143         Q:$G(OCXOERR)
    144         ;
    145         D R11R2A^OCXOZ0L   ; Check Relation #2 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
    146         Q
    147         ;
    148 EL32    ; Examine every rule that involves Element #32 [RADIOLOGY ORDER DISCONTINUED]
    149         ;  Called from SCAN+9^OCXOZ01.
    150         ;
    151         Q:$G(OCXOERR)
    152         ;
    153         D R11R3A^OCXOZ0M   ; Check Relation #3 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
    154         Q
    155         ;
    156 EL46    ; Examine every rule that involves Element #46 [SERVICE ORDER REQUIRES CHART SIGNATURE]
    157         ;  Called from SCAN+9^OCXOZ01.
    158         ;
    159         Q:$G(OCXOERR)
    160         ;
    161         D R16R1A^OCXOZ0M   ; Check Relation #1 in Rule #16 'SERVICE ORDER REQUIRES CHART SIGNATURE'
    162         Q
    163         ;
    164 EL76    ; Examine every rule that involves Element #76 [STAT LAB RESULT]
    165         ;  Called from SCAN+9^OCXOZ01.
    166         ;
    167         Q:$G(OCXOERR)
    168         ;
    169         D R18R1A^OCXOZ0M   ; Check Relation #1 in Rule #18 'STAT RESULTS AVAILABLE'
    170         Q
    171         ;
    172 EL75    ; Examine every rule that involves Element #75 [STAT IMAGING RESULT]
    173         ;  Called from SCAN+9^OCXOZ01.
    174         ;
    175         Q:$G(OCXOERR)
    176         ;
    177         D R18R2A^OCXOZ0N   ; Check Relation #2 in Rule #18 'STAT RESULTS AVAILABLE'
    178         Q
    179         ;
    180 EL110   ; Examine every rule that involves Element #110 [STAT CONSULT RESULT]
    181         ;  Called from SCAN+9^OCXOZ01.
    182         ;
    183         Q:$G(OCXOERR)
    184         ;
    185         D R18R3A^OCXOZ0N   ; Check Relation #3 in Rule #18 'STAT RESULTS AVAILABLE'
    186         Q
    187         ;
    188 ABREN(DFN)      ;  Compiler Function: DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW
    189         ;
    190         N OCXFLAG,OCXVAL,OCXLIST,OCXTEST,UNAV,OCXTLIST,OCXTERM,OCXSLIST,OCXSPEC
    191         S (OCXLIST,OCXTLIST)="",UNAV="0^<Unavailable>"
    192         S OCXSLIST="" Q:'$$TERMLKUP("SERUM SPECIMEN",.OCXSLIST) UNAV
    193         F OCXTERM="SERUM CREATININE","SERUM UREA NITROGEN" D  Q:($L(OCXLIST)>130)
    194         .Q:'$$TERMLKUP(OCXTERM,.OCXTLIST)
    195         .S OCXTEST=0 F  S OCXTEST=$O(OCXTLIST(OCXTEST)) Q:'OCXTEST  D  Q:($L(OCXLIST)>130)
    196         ..S OCXSPEC=0 F  S OCXSPEC=$O(OCXSLIST(OCXSPEC)) Q:'OCXSPEC  D  Q:($L(OCXLIST)>130)
    197         ...S OCXVAL=$$LOCL^ORQQLR1(DFN,OCXTEST,OCXSPEC),OCXFLAG=$P(OCXVAL,U,5)
    198         ...I $L(OCXVAL),((OCXFLAG["H")!(OCXFLAG["L")) D
    199         ....N OCXY S OCXY=""
    200         ....S OCXY=$P(OCXVAL,U,2)_": "_$P(OCXVAL,U,3)_" "_$P(OCXVAL,U,4)
    201         ....S OCXY=OCXY_" "_$S($L(OCXFLAG):"["_OCXFLAG_"]",1:"")
    202         ....S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXVAL,U,7),"2P")
    203         ....S:$L(OCXLIST) OCXLIST=OCXLIST_" " S OCXLIST=OCXLIST_OCXY
    204         Q:'$L(OCXLIST) UNAV  Q 1_U_OCXLIST
    205        
    206         ;
    207 FILE(DFN,OCXELE,OCXDFL) ;     This Local Extrinsic Function logs a validated event/element.
    208         ;
    209         N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
    210         S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
    211         ;
    212         Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
    213         ;
    214         S OCXDATA(DFN,OCXELE)=1
    215         F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D
    216         .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
    217         ;
    218         M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
    219         ;
    220         Q 0
    221         ;
    222 LIST(DATA,LIST) ;   IS THE DATA FIELD IN THE LIST
    223         ;
    224         S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LIST=LIST_"," S DATA=","_DATA_","
    225         Q (LIST[DATA)
    226         ;
    227 OPIOID(ORPT)    ;determine if pat is receiving opioid med
    228         ; rtn 1^opioid drug 1, opioid drug 2, opioid drug3, ...
    229         N ORDG,ORTN,ORNUM,ORDI,ORDCLAS,ORDERS,ORTEXT,DUP,DUPI,DUPJ,DUPLEN
    230         S ORDG=0,ORTN=0,DUPI=0,DUPLEN=20
    231         K ^TMP("ORR",$J)
    232         S ORDG=$O(^ORD(100.98,"B","RX",ORDG))
    233         D EN^ORQ1(ORPT_";DPT(",ORDG,2,"","","",0,0)
    234         N J,HOR,SEQ,X S J=1,HOR=0,SEQ=0
    235         S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1 ORTN
    236         F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D
    237         .S X=^TMP("ORR",$J,HOR,SEQ)
    238         .S ORNUM=+$P(X,";")
    239         .Q:ORNUM=+$G(ORIFN)  ;quit if dup med order # = current order #
    240         .S ORDI=$$VALUE^ORCSAVE2(ORNUM,"DRUG")
    241         .I +$G(ORDI)>0 D
    242         ..S ORDCLAS=$P(^PSDRUG(ORDI,0),U,2)  ;va drug class
    243         ..I ($G(ORDCLAS)="CN101")!($G(ORDCLAS)="CN102") D  ;opioid classes
    244         ...S ORTEXT=$$FULLTEXT^ORQOR1(ORNUM)
    245         ...S ORTEXT=$P(ORTEXT,U)_" ["_$P(ORTEXT,U,2)_"]"
    246         ...S DUPI=DUPI+1,DUP(DUPI)=" ["_DUPI_"] "_ORTEXT
    247         ...S ORTN=1
    248         I DUPI>0 D
    249         .S DUPLEN=$P(215/DUPI,".")
    250         .F DUPJ=1:1:DUPI D
    251         ..I DUPJ=1 S ORDERS=$E(DUP(DUPJ),1,DUPLEN)
    252         ..E  S ORDERS=ORDERS_", "_$E(DUP(DUPJ),1,DUPLEN)
    253         K ^TMP("ORR",$J)
    254         Q ORTN_U_$G(ORDERS)
    255         ;
    256 TERMLKUP(OCXTERM,OCXLIST)       ;
    257         Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
    258         ;
     1OCXOZ0G ;SLC/RJS,CLA - Order Check Scan ;DEC 27,2007 at 06:00
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
     3 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
     4 ;
     5 ; ***************************************************************
     6 ; ** Warning: This routine is automatically generated by the   **
     7 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine  **
     8 ; ** will be lost the next time the rule compiler executes.    **
     9 ; ***************************************************************
     10 ;
     11 Q
     12 ;
     13CHK490 ; Look through the current environment for valid Event/Elements for this patient.
     14 ;  Called from CHK454+17^OCXOZ0F.
     15 ;
     16 Q:$G(OCXOERR)
     17 ;
     18 ;    Local CHK490 Variables
     19 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
     20 ; OCXDF(58) ---> Data Field: ABNORMAL RENAL BIOCHEM RESULTS (FREE TEXT)
     21 ;
     22 ;      Local Extrinsic Functions
     23 ; ABREN( -----------> DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW
     24 ; FILE(DFN,133, ----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: NO CREAT RESULTS W/IN X DAYS)
     25 ;
     26 S OCXDF(58)=$P($$ABREN(OCXDF(37)),"^",2),OCXOERR=$$FILE(DFN,133,"58,154") Q:OCXOERR
     27 Q
     28 ;
     29CHK505 ; Look through the current environment for valid Event/Elements for this patient.
     30 ;  Called from CHK362+15^OCXOZ0D.
     31 ;
     32 Q:$G(OCXOERR)
     33 ;
     34 ;    Local CHK505 Variables
     35 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
     36 ; OCXDF(74) ---> Data Field: VA DRUG CLASS (FREE TEXT)
     37 ; OCXDF(158) --> Data Field: DUPLICATE OPIOID MEDICATIONS TEXT (FREE TEXT)
     38 ;
     39 ;      Local Extrinsic Functions
     40 ; LIST( ------------> IN LIST OPERATOR
     41 ; OPIOID( ----------> OPIOID MEDICATIONS
     42 ;
     43 I $$LIST(OCXDF(74),"OPIOID ANALGESICS,OPIOID ANTAGONIST ANALGESICS") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(158)=$P($$OPIOID(OCXDF(37)),"^",2) D CHK509
     44 Q
     45 ;
     46CHK509 ; Look through the current environment for valid Event/Elements for this patient.
     47 ;  Called from CHK505+14.
     48 ;
     49 Q:$G(OCXOERR)
     50 ;
     51 ;      Local Extrinsic Functions
     52 ; FILE(DFN,139, ----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: OPIOID MED ORDER)
     53 ;
     54 S OCXOERR=$$FILE(DFN,139,"158") Q:OCXOERR
     55 Q
     56 ;
     57EL24 ; Examine every rule that involves Element #24 [HL7 LAB TEST RESULTS CRITICAL]
     58 ;  Called from SCAN+9^OCXOZ01.
     59 ;
     60 Q:$G(OCXOERR)
     61 ;
     62 D R3R1A^OCXOZ0I   ; Check Relation #1 in Rule #3 'CRITICAL LAB RESULTS'
     63 Q
     64 ;
     65EL105 ; Examine every rule that involves Element #105 [HL7 LAB ORDER RESULTS CRITICAL]
     66 ;  Called from SCAN+9^OCXOZ01.
     67 ;
     68 Q:$G(OCXOERR)
     69 ;
     70 D R3R2A^OCXOZ0J   ; Check Relation #2 in Rule #3 'CRITICAL LAB RESULTS'
     71 Q
     72 ;
     73EL44 ; Examine every rule that involves Element #44 [ORDER FLAGGED]
     74 ;  Called from SCAN+9^OCXOZ01.
     75 ;
     76 Q:$G(OCXOERR)
     77 ;
     78 D R5R1A^OCXOZ0J   ; Check Relation #1 in Rule #5 'ORDER FLAGGED FOR CLARIFICATION'
     79 Q
     80 ;
     81EL134 ; Examine every rule that involves Element #134 [ORDER UNFLAGGED]
     82 ;  Called from SCAN+9^OCXOZ01.
     83 ;
     84 Q:$G(OCXOERR)
     85 ;
     86 D R5R2A^OCXOZ0K   ; Check Relation #2 in Rule #5 'ORDER FLAGGED FOR CLARIFICATION'
     87 Q
     88 ;
     89EL45 ; Examine every rule that involves Element #45 [ORDER REQUIRES CHART SIGNATURE]
     90 ;  Called from SCAN+9^OCXOZ01.
     91 ;
     92 Q:$G(OCXOERR)
     93 ;
     94 D R6R1A^OCXOZ0K   ; Check Relation #1 in Rule #6 'ORDER REQUIRES CHART SIGNATURE'
     95 Q
     96 ;
     97EL21 ; Examine every rule that involves Element #21 [PATIENT ADMISSION]
     98 ;  Called from SCAN+9^OCXOZ01.
     99 ;
     100 Q:$G(OCXOERR)
     101 ;
     102 D R7R1A^OCXOZ0K   ; Check Relation #1 in Rule #7 'PATIENT ADMISSION'
     103 Q
     104 ;
     105EL31 ; Examine every rule that involves Element #31 [RADIOLOGY ORDER CANCELLED]
     106 ;  Called from SCAN+9^OCXOZ01.
     107 ;
     108 Q:$G(OCXOERR)
     109 ;
     110 D R11R1A^OCXOZ0L   ; Check Relation #1 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
     111 Q
     112 ;
     113EL100 ; Examine every rule that involves Element #100 [CANCELED BY NON-ORIG ORDERING PROVIDER]
     114 ;  Called from SCAN+9^OCXOZ01.
     115 ;
     116 Q:$G(OCXOERR)
     117 ;
     118 D R11R1A^OCXOZ0L   ; Check Relation #1 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
     119 D R11R2A^OCXOZ0L   ; Check Relation #2 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
     120 D R11R3A^OCXOZ0M   ; Check Relation #3 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
     121 D R35R1A^OCXOZ0Q   ; Check Relation #1 in Rule #35 'LAB ORDER CANCELLED'
     122 Q
     123 ;
     124EL30 ; Examine every rule that involves Element #30 [RADIOLOGY ORDER PUT ON-HOLD]
     125 ;  Called from SCAN+9^OCXOZ01.
     126 ;
     127 Q:$G(OCXOERR)
     128 ;
     129 D R11R2A^OCXOZ0L   ; Check Relation #2 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
     130 Q
     131 ;
     132EL32 ; Examine every rule that involves Element #32 [RADIOLOGY ORDER DISCONTINUED]
     133 ;  Called from SCAN+9^OCXOZ01.
     134 ;
     135 Q:$G(OCXOERR)
     136 ;
     137 D R11R3A^OCXOZ0M   ; Check Relation #3 in Rule #11 'IMAGING REQUEST CANCELLED/HELD'
     138 Q
     139 ;
     140EL46 ; Examine every rule that involves Element #46 [SERVICE ORDER REQUIRES CHART SIGNATURE]
     141 ;  Called from SCAN+9^OCXOZ01.
     142 ;
     143 Q:$G(OCXOERR)
     144 ;
     145 D R16R1A^OCXOZ0M   ; Check Relation #1 in Rule #16 'SERVICE ORDER REQUIRES CHART SIGNATURE'
     146 Q
     147 ;
     148EL76 ; Examine every rule that involves Element #76 [STAT LAB RESULT]
     149 ;  Called from SCAN+9^OCXOZ01.
     150 ;
     151 Q:$G(OCXOERR)
     152 ;
     153 D R18R1A^OCXOZ0M   ; Check Relation #1 in Rule #18 'STAT RESULTS AVAILABLE'
     154 Q
     155 ;
     156EL75 ; Examine every rule that involves Element #75 [STAT IMAGING RESULT]
     157 ;  Called from SCAN+9^OCXOZ01.
     158 ;
     159 Q:$G(OCXOERR)
     160 ;
     161 D R18R2A^OCXOZ0N   ; Check Relation #2 in Rule #18 'STAT RESULTS AVAILABLE'
     162 Q
     163 ;
     164EL110 ; Examine every rule that involves Element #110 [STAT CONSULT RESULT]
     165 ;  Called from SCAN+9^OCXOZ01.
     166 ;
     167 Q:$G(OCXOERR)
     168 ;
     169 D R18R3A^OCXOZ0N   ; Check Relation #3 in Rule #18 'STAT RESULTS AVAILABLE'
     170 Q
     171 ;
     172EL56 ; Examine every rule that involves Element #56 [PATIENT DISCHARGE]
     173 ;  Called from SCAN+9^OCXOZ01.
     174 ;
     175 Q:$G(OCXOERR)
     176 ;
     177 D R19R1A^OCXOZ0N   ; Check Relation #1 in Rule #19 'PATIENT DISCHARGE'
     178 Q
     179 ;
     180EL47 ; Examine every rule that involves Element #47 [ORDER REQUIRES CO-SIGNATURE]
     181 ;  Called from SCAN+9^OCXOZ01.
     182 ;
     183 Q:$G(OCXOERR)
     184 ;
     185 D R22R1A^OCXOZ0O   ; Check Relation #1 in Rule #22 'ORDER REQUIRES CO-SIGNATURE'
     186 Q
     187 ;
     188ABREN(DFN) ;  Compiler Function: DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW
     189 ;
     190 N OCXFLAG,OCXVAL,OCXLIST,OCXTEST,UNAV,OCXTLIST,OCXTERM,OCXSLIST,OCXSPEC
     191 S (OCXLIST,OCXTLIST)="",UNAV="0^<Unavailable>"
     192 S OCXSLIST="" Q:'$$TERMLKUP("SERUM SPECIMEN",.OCXSLIST) UNAV
     193 F OCXTERM="SERUM CREATININE","SERUM UREA NITROGEN" D  Q:($L(OCXLIST)>130)
     194 .Q:'$$TERMLKUP(OCXTERM,.OCXTLIST)
     195 .S OCXTEST=0 F  S OCXTEST=$O(OCXTLIST(OCXTEST)) Q:'OCXTEST  D  Q:($L(OCXLIST)>130)
     196 ..S OCXSPEC=0 F  S OCXSPEC=$O(OCXSLIST(OCXSPEC)) Q:'OCXSPEC  D  Q:($L(OCXLIST)>130)
     197 ...S OCXVAL=$$LOCL^ORQQLR1(DFN,OCXTEST,OCXSPEC),OCXFLAG=$P(OCXVAL,U,5)
     198 ...I $L(OCXVAL),((OCXFLAG["H")!(OCXFLAG["L")) D
     199 ....N OCXY S OCXY=""
     200 ....S OCXY=$P(OCXVAL,U,2)_": "_$P(OCXVAL,U,3)_" "_$P(OCXVAL,U,4)
     201 ....S OCXY=OCXY_" "_$S($L(OCXFLAG):"["_OCXFLAG_"]",1:"")
     202 ....S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXVAL,U,7),"2P")
     203 ....S:$L(OCXLIST) OCXLIST=OCXLIST_" " S OCXLIST=OCXLIST_OCXY
     204 Q:'$L(OCXLIST) UNAV  Q 1_U_OCXLIST
     205 
     206 ;
     207FILE(DFN,OCXELE,OCXDFL) ;     This Local Extrinsic Function logs a validated event/element.
     208 ;
     209 N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
     210 S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
     211 ;
     212 Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
     213 ;
     214 S OCXDATA(DFN,OCXELE)=1
     215 F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D
     216 .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
     217 ;
     218 M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
     219 ;
     220 Q 0
     221 ;
     222LIST(DATA,LIST) ;   IS THE DATA FIELD IN THE LIST
     223 ;
     224 S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LIST=LIST_"," S DATA=","_DATA_","
     225 Q (LIST[DATA)
     226 ;
     227OPIOID(ORPT) ;determine if pat is receiving opioid med
     228 ; rtn 1^opioid drug 1, opioid drug 2, opioid drug3, ...
     229 N ORDG,ORTN,ORNUM,ORDI,ORDCLAS,ORDERS,ORTEXT,DUP,DUPI,DUPJ,DUPLEN
     230 S ORDG=0,ORTN=0,DUPI=0,DUPLEN=20
     231 K ^TMP("ORR",$J)
     232 S ORDG=$O(^ORD(100.98,"B","RX",ORDG))
     233 D EN^ORQ1(ORPT_";DPT(",ORDG,2,"","","",0,0)
     234 N J,HOR,SEQ,X S J=1,HOR=0,SEQ=0
     235 S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1 ORTN
     236 F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D
     237 .S X=^TMP("ORR",$J,HOR,SEQ)
     238 .S ORNUM=+$P(X,";")
     239 .Q:ORNUM=+$G(ORIFN)  ;quit if dup med order # = current order #
     240 .S ORDI=$$VALUE^ORCSAVE2(ORNUM,"DRUG")
     241 .I +$G(ORDI)>0 D
     242 ..S ORDCLAS=$P(^PSDRUG(ORDI,0),U,2)  ;va drug class
     243 ..I ($G(ORDCLAS)="CN101")!($G(ORDCLAS)="CN102") D  ;opioid classes
     244 ...S ORTEXT=$$FULLTEXT^ORQOR1(ORNUM)
     245 ...S ORTEXT=$P(ORTEXT,U)_" ["_$P(ORTEXT,U,2)_"]"
     246 ...S DUPI=DUPI+1,DUP(DUPI)=" ["_DUPI_"] "_ORTEXT
     247 ...S ORTN=1
     248 I DUPI>0 D
     249 .S DUPLEN=$P(215/DUPI,".")
     250 .F DUPJ=1:1:DUPI D
     251 ..I DUPJ=1 S ORDERS=$E(DUP(DUPJ),1,DUPLEN)
     252 ..E  S ORDERS=ORDERS_", "_$E(DUP(DUPJ),1,DUPLEN)
     253 K ^TMP("ORR",$J)
     254 Q ORTN_U_$G(ORDERS)
     255 ;
     256TERMLKUP(OCXTERM,OCXLIST) ;
     257 Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
     258 ;
Note: See TracChangeset for help on using the changeset viewer.