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