| 1 | OCXDI02E ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;SEP 7,1999 at 10:30 | 
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997 | 
|---|
| 3 | ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998 | 
|---|
| 4 | ; | 
|---|
| 5 | S ; | 
|---|
| 6 | ; | 
|---|
| 7 | D DOT^OCXDIAG | 
|---|
| 8 | ; | 
|---|
| 9 | ; | 
|---|
| 10 | K REMOTE,LOCAL,OPCODE,REF | 
|---|
| 11 | F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT  I $L(TEXT) D  Q:QUIT | 
|---|
| 12 | .S ^TMP("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT | 
|---|
| 13 | ; | 
|---|
| 14 | G ^OCXDI02F | 
|---|
| 15 | ; | 
|---|
| 16 | Q | 
|---|
| 17 | ; | 
|---|
| 18 | DATA ; | 
|---|
| 19 | ; | 
|---|
| 20 | ;;R^"860.8:",100,5 | 
|---|
| 21 | ;;D^  ; F OCXTERM="SERUM CREATININE","SERUM UREA NITROGEN" D  Q:$L(OCXV) | 
|---|
| 22 | ;;R^"860.8:",100,6 | 
|---|
| 23 | ;;D^  ; .Q:'$$TERMLKUP(OCXTERM,.OCXTL) "" | 
|---|
| 24 | ;;R^"860.8:",100,7 | 
|---|
| 25 | ;;D^  ; .S OCXX=0 F  S OCXX=$O(OCXTL(OCXX)) Q:'OCXX  D  Q:$L(OCXV) | 
|---|
| 26 | ;;R^"860.8:",100,8 | 
|---|
| 27 | ;;D^  ; ..S OCXS=0 F  S OCXS=$O(OCXSLIST(OCXS)) Q:'OCXS  D  Q:$L(OCXV) | 
|---|
| 28 | ;;R^"860.8:",100,9 | 
|---|
| 29 | ;;D^  ; ...S OCXV=$$OIRES^ORQQLR1(DFN,OCXX,OCXS) | 
|---|
| 30 | ;;R^"860.8:",100,10 | 
|---|
| 31 | ;;D^  ; Q OCXV | 
|---|
| 32 | ;;R^"860.8:",100,11 | 
|---|
| 33 | ;;D^  ; | 
|---|
| 34 | ;;EOR^ | 
|---|
| 35 | ;;KEY^860.8:^DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW | 
|---|
| 36 | ;;R^"860.8:",.01,"E" | 
|---|
| 37 | ;;D^DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW | 
|---|
| 38 | ;;R^"860.8:",.02,"E" | 
|---|
| 39 | ;;D^ABREN | 
|---|
| 40 | ;;R^"860.8:",100,1 | 
|---|
| 41 | ;;D^  ;ABREN(DFN) ; | 
|---|
| 42 | ;;R^"860.8:",100,2 | 
|---|
| 43 | ;;D^  ; ; | 
|---|
| 44 | ;;R^"860.8:",100,3 | 
|---|
| 45 | ;;D^  ; N OCXFLAG,OCXVAL,OCXLIST,OCXTEST,UNAV,OCXTLIST,OCXTERM,OCXSLIST,OCXSPEC | 
|---|
| 46 | ;;R^"860.8:",100,4 | 
|---|
| 47 | ;;D^  ; S (OCXLIST,OCXTLIST)="",UNAV="0^<Unavailable>" | 
|---|
| 48 | ;;R^"860.8:",100,5 | 
|---|
| 49 | ;;D^  ; S OCXSLIST="" Q:'$$TERMLKUP("SERUM SPECIMEN",.OCXSLIST) UNAV | 
|---|
| 50 | ;;R^"860.8:",100,6 | 
|---|
| 51 | ;;D^  ; F OCXTERM="SERUM CREATININE","SERUM UREA NITROGEN" D | 
|---|
| 52 | ;;R^"860.8:",100,7 | 
|---|
| 53 | ;;D^  ; .Q:'$$TERMLKUP(OCXTERM,.OCXTLIST) | 
|---|
| 54 | ;;R^"860.8:",100,8 | 
|---|
| 55 | ;;D^  ; .S OCXTEST=0 F  S OCXTEST=$O(OCXTLIST(OCXTEST)) Q:'OCXTEST  D | 
|---|
| 56 | ;;R^"860.8:",100,9 | 
|---|
| 57 | ;;D^  ; ..S OCXSPEC=0 F  S OCXSPEC=$O(OCXSLIST(OCXSPEC)) Q:'OCXSPEC  D | 
|---|
| 58 | ;;R^"860.8:",100,10 | 
|---|
| 59 | ;;D^  ; ...S OCXVAL=$$LOCL^ORQQLR1(DFN,OCXTEST,OCXSPEC),OCXFLAG=$P(OCXVAL,U,5) | 
|---|
| 60 | ;;R^"860.8:",100,11 | 
|---|
| 61 | ;;D^  ; ...I $L(OCXVAL),((OCXFLAG["H")!(OCXFLAG["L")) D | 
|---|
| 62 | ;;R^"860.8:",100,12 | 
|---|
| 63 | ;;D^  ; ....N OCXY S OCXY="" | 
|---|
| 64 | ;;R^"860.8:",100,13 | 
|---|
| 65 | ;;D^  ; ....S OCXY=$P(OCXVAL,U,2)_": "_$P(OCXVAL,U,3)_" "_$P(OCXVAL,U,4) | 
|---|
| 66 | ;;R^"860.8:",100,14 | 
|---|
| 67 | ;;D^  ; ....S OCXY=OCXY_" "_$S($L(OCXFLAG):"["_OCXFLAG_"]",1:"") | 
|---|
| 68 | ;;R^"860.8:",100,15 | 
|---|
| 69 | ;;D^  ; ....S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXVAL,U,7),"2P") | 
|---|
| 70 | ;;R^"860.8:",100,16 | 
|---|
| 71 | ;;D^  ; ....S:$L(OCXLIST) OCXLIST=OCXLIST_" " S OCXLIST=OCXLIST_OCXY | 
|---|
| 72 | ;;R^"860.8:",100,17 | 
|---|
| 73 | ;;D^  ; Q:'$L(OCXLIST) UNAV  Q 1_U_OCXLIST | 
|---|
| 74 | ;;R^"860.8:",100,18 | 
|---|
| 75 | ;;D^  ; ; | 
|---|
| 76 | ;;EOR^ | 
|---|
| 77 | ;;KEY^860.8:^DOES THIS RADIOLOGY PROCEDURE USE A CONTRAST MEDIA | 
|---|
| 78 | ;;R^"860.8:",.01,"E" | 
|---|
| 79 | ;;D^DOES THIS RADIOLOGY PROCEDURE USE A CONTRAST MEDIA | 
|---|
| 80 | ;;R^"860.8:",.02,"E" | 
|---|
| 81 | ;;D^CM | 
|---|
| 82 | ;;R^"860.8:",100,1 | 
|---|
| 83 | ;;D^  ;CM(OCXOI) ; | 
|---|
| 84 | ;;R^"860.8:",100,2 | 
|---|
| 85 | ;;D^  ; ; | 
|---|
| 86 | ;;R^"860.8:",100,3 | 
|---|
| 87 | ;;D^  ; N OCXVAL S OCXVAL=$$CM^ORQQRA(OCXOI) Q:((OCXVAL["B")!(OCXVAL["M")) 1_U_OCXVAL Q 0 | 
|---|
| 88 | ;;R^"860.8:",100,4 | 
|---|
| 89 | ;;D^  ; ; | 
|---|
| 90 | ;;EOR^ | 
|---|
| 91 | ;;KEY^860.8:^IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE | 
|---|
| 92 | ;;R^"860.8:",.01,"E" | 
|---|
| 93 | ;;D^IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE | 
|---|
| 94 | ;;R^"860.8:",.02,"E" | 
|---|
| 95 | ;;D^CH | 
|---|
| 96 | ;;R^"860.8:",100,1 | 
|---|
| 97 | ;;D^  ;CH(OCXOI) ; | 
|---|
| 98 | ;;R^"860.8:",100,2 | 
|---|
| 99 | ;;D^  ; ; | 
|---|
| 100 | ;;R^"860.8:",100,3 | 
|---|
| 101 | ;;D^  ; N OCXVAL S OCXVAL=$$CM^ORQQRA(OCXOI) Q:(OCXVAL["C") 1_U_OCXVAL Q 0 | 
|---|
| 102 | ;;R^"860.8:",100,4 | 
|---|
| 103 | ;;D^  ; ; | 
|---|
| 104 | ;;EOR^ | 
|---|
| 105 | ;;KEY^860.8:^GET DATA FROM THE ACTIVE DATA FILE | 
|---|
| 106 | ;;R^"860.8:",.01,"E" | 
|---|
| 107 | ;;D^GET DATA FROM THE ACTIVE DATA FILE | 
|---|
| 108 | ;;R^"860.8:",.02,"E" | 
|---|
| 109 | ;;D^GETDATA | 
|---|
| 110 | ;;R^"860.8:",100,1 | 
|---|
| 111 | ;;D^  ;GETDATA(DFN,OCXL,OCXDFI) ;     This Local Extrinsic Function returns runtime data | 
|---|
| 112 | ;;R^"860.8:",100,2 | 
|---|
| 113 | ;;D^  ; ; | 
|---|
| 114 | ;;R^"860.8:",100,3 | 
|---|
| 115 | ;;D^  ; N OCXE,VAL,PC S VAL="" | 
|---|
| 116 | ;;R^"860.8:",100,4 | 
|---|
| 117 | ;;D^  ; F PC=1:1:$L(OCXL,U) S OCXE=$P(OCXL,U,PC) I OCXE S VAL=$G(^TMP("OCXCHK",$J,DFN,OCXE,OCXDFI)) Q:$L(VAL) | 
|---|
| 118 | ;;R^"860.8:",100,5 | 
|---|
| 119 | ;;D^  ; Q VAL | 
|---|
| 120 | ;;R^"860.8:",100,6 | 
|---|
| 121 | ;;D^  ; ; | 
|---|
| 122 | ;;EOR^ | 
|---|
| 123 | ;;KEY^860.8:^DATE PATIENT DECEASED | 
|---|
| 124 | ;;R^"860.8:",.01,"E" | 
|---|
| 125 | ;;D^DATE PATIENT DECEASED | 
|---|
| 126 | ;;R^"860.8:",.02,"E" | 
|---|
| 127 | ;;D^DECEASED | 
|---|
| 128 | ;;EOR^ | 
|---|
| 129 | ;;KEY^860.8:^SITE FLAGGED ORDER | 
|---|
| 130 | ;;R^"860.8:",.01,"E" | 
|---|
| 131 | ;;D^SITE FLAGGED ORDER | 
|---|
| 132 | ;;R^"860.8:",.02,"E" | 
|---|
| 133 | ;;D^SITEORD | 
|---|
| 134 | ;;R^"860.8:",100,1 | 
|---|
| 135 | ;;D^  ;SITEORD(ORNUM) ;Ext. funct return 1 (Yes) or 0 (No) if the site has flagged the | 
|---|
| 136 | ;;R^"860.8:",100,2 | 
|---|
| 137 | ;;D^  ; ; orderable item (determined via order number ORNUM) to trigger a | 
|---|
| 138 | ;;R^"860.8:",100,3 | 
|---|
| 139 | ;;D^  ; ; notification when ordered | 
|---|
| 140 | ;;R^"860.8:",100,4 | 
|---|
| 141 | ;;D^  ; N ORBFLAG,OI S ORBFLAG="",OI="" | 
|---|
| 142 | ;;R^"860.8:",100,5 | 
|---|
| 143 | ;;D^T+; W:$G(OCXTRACE) !!,"Site Flagged Order function, ORNUM: ",ORNUM | 
|---|
| 144 | ;;R^"860.8:",100,6 | 
|---|
| 145 | ;;D^  ; Q:'$L($G(ORNUM)) ORBFLAG | 
|---|
| 146 | ;;R^"860.8:",100,7 | 
|---|
| 147 | ;;D^  ; S OI=$$OI^ORQOR2(ORNUM) | 
|---|
| 148 | ;;R^"860.8:",100,8 | 
|---|
| 149 | ;;D^  ; Q:'$L($G(OI)) ORBFLAG | 
|---|
| 150 | ;;R^"860.8:",100,9 | 
|---|
| 151 | ;;D^  ; S ORBFLAG=$$GET^XPAR("ALL","ORB ORDERABLE ITEM ORDERED","`"_OI,"Q") | 
|---|
| 152 | ;;R^"860.8:",100,10 | 
|---|
| 153 | ;;D^T+; W:$G(OCXTRACE) !,"                Results (ORBFLAG): ",ORBFLAG,!! | 
|---|
| 154 | ;;R^"860.8:",100,11 | 
|---|
| 155 | ;;D^  ; Q ORBFLAG | 
|---|
| 156 | ;;R^"860.8:",100,12 | 
|---|
| 157 | ;;D^  ; ; | 
|---|
| 158 | ;;EOR^ | 
|---|
| 159 | ;;KEY^860.8:^SITE FLAGGED RESULT | 
|---|
| 160 | ;;R^"860.8:",.01,"E" | 
|---|
| 161 | ;;D^SITE FLAGGED RESULT | 
|---|
| 162 | ;;R^"860.8:",.02,"E" | 
|---|
| 163 | ;;D^SITERES | 
|---|
| 164 | ;;R^"860.8:",100,1 | 
|---|
| 165 | ;;D^  ;SITERES(ORNUM) ;Ext. funct return 1 (Yes) if the site has flagged the | 
|---|
| 166 | ;1; | 
|---|
| 167 | ; | 
|---|