OCXDI02F ;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 ^OCXDI02G
;
Q
;
DATA ;
;
;;R^"860.8:",100,2
;;D^ ; ; orderable item (determined via order number ORNUM) to trigger a
;;R^"860.8:",100,3
;;D^ ; ; notification when resulted
;;R^"860.8:",100,4
;;D^ ; N ORBFLAG,OI S ORBFLAG="",OI=""
;;R^"860.8:",100,5
;;D^ ; Q:+$G(ORNUM)<1 ORBFLAG
;;R^"860.8:",100,6
;;D^ ; S OI=$$OI^ORQOR2(ORNUM)
;;R^"860.8:",100,7
;;D^ ; Q:+$G(OI)<1 ORBFLAG
;;R^"860.8:",100,8
;;D^ ; S ORBFLAG=$$GET^XPAR("ALL","ORB ORDERABLE ITEM RESULTS","`"_OI,"Q")
;;R^"860.8:",100,9
;;D^ ; Q ORBFLAG
;;R^"860.8:",100,10
;;D^ ; ;
;;EOR^
;;KEY^860.8:^WARD ROOM-BED
;;R^"860.8:",.01,"E"
;;D^WARD ROOM-BED
;;R^"860.8:",.02,"E"
;;D^WARDRMBD
;;R^"860.8:",1,1
;;D^Returns the patient's ward and room-bed if they exist. Can be used to
;;R^"860.8:",1,2
;;D^determine if the patient is inpatient or outpatient. Official MAS policy
;;R^"860.8:",1,3
;;D^indicates that if the patient has a ward (^DPT(DFN,.1)), then they are an
;;R^"860.8:",1,4
;;D^inpatient. If the .1 node does not exist, they are an outpatient.
;;R^"860.8:",100,1
;;D^ ;WARDRMBD(DFN) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; Q:'$G(DFN) 0
;;R^"860.8:",100,4
;;D^ ; N OUT S OUT=$G(^DPT(DFN,.1)) Q:'$L(OUT) 0
;;R^"860.8:",100,5
;;D^ ; S OUT=1_"^"_OUT_" "_$G(^DPT(DFN,.101)) Q OUT
;;R^"860.8:",100,6
;;D^ ; ;
;;EOR^
;;KEY^860.8:^IN LIST OPERATOR
;;R^"860.8:",.01,"E"
;;D^IN LIST OPERATOR
;;R^"860.8:",.02,"E"
;;D^LIST
;;R^"860.8:",100,1
;;D^ ;LIST(DATA,LIST) ; IS THE DATA FIELD IN THE LIST
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20," $$LIST(""",DATA,""",""",LIST,""")"
;;R^"860.8:",100,4
;;D^ ; S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LIST=LIST_"," S DATA=","_DATA_","
;;R^"860.8:",100,5
;;D^ ; Q (LIST[DATA)
;;R^"860.8:",100,6
;;D^ ; ;
;;EOR^
;;KEY^860.8:^RECENT CHOLECYSTOGRAM PREOCEDURE
;;R^"860.8:",.01,"E"
;;D^RECENT CHOLECYSTOGRAM PREOCEDURE
;;R^"860.8:",.02,"E"
;;D^RECCH
;;R^"860.8:",100,1
;;D^ ;RECCH(DFN,DAYS) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; Q:'$G(DFN) 0 Q:'$G(DAYS) 0 N OUT S OUT=$$RECENTCH^ORKRA(DFN,DAYS) Q:'$L(OUT) 0 Q 1_U_OUT
;;R^"860.8:",100,4
;;D^ ; ;
;;EOR^
;;KEY^860.8:^FORMATTED LAB RESULTS
;;R^"860.8:",.01,"E"
;;D^FORMATTED LAB RESULTS
;;R^"860.8:",.02,"E"
;;D^FLAB
;;R^"860.8:",100,1
;;D^ ;FLAB(DFN,OCXLIST,OCXSPEC) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; Q:'$G(DFN) "<Patient Not Specified>"
;;R^"860.8:",100,4
;;D^ ; Q:'$L($G(OCXLIST)) "<Lab Tests Not Specified>"
;;R^"860.8:",100,5
;;D^ ; N OCXLAB,OCXOUT,OCXPC,OCXSL,SPEC S OCXOUT="",SPEC=""
;;R^"860.8:",100,6
;;D^ ; I $L($G(OCXSPEC)) S OCXSL=$$TERMLKUP(OCXSPEC,.OCXSL)
;;R^"860.8:",100,7
;;D^ ; F OCXPC=1:1:$L(OCXLIST,U) S OCXLAB=$P(OCXLIST,U,OCXPC) I $L(OCXLAB) D
;;R^"860.8:",100,8
;;D^ ; .N OCXX,OCXY,X,Y,DIC,TEST,SPEC,OCXTL
;;R^"860.8:",100,9
;;D^ ; .S OCXTL="" Q:'$$TERMLKUP(OCXLAB,.OCXTL)
;;R^"860.8:",100,10
;;D^ ; .S OCXX="",TEST=0 F S TEST=$O(OCXTL(TEST)) Q:'TEST D Q:$L(OCXX)
;;R^"860.8:",100,11
;;D^ ; ..I $L($G(OCXSL)) D
;;R^"860.8:",100,12
;;D^ ; ...S SPEC=0 F S SPEC=$O(OCXSL(SPEC)) Q:'SPEC D Q:$L(OCXX)
;;R^"860.8:",100,13
;;D^ ; ....S OCXX=$$LOCL^ORQQLR1(DFN,TEST,SPEC)
;;R^"860.8:",100,14
;;D^ ; ..I '$L($G(OCXSL)) S OCXX=$$LOCL^ORQQLR1(DFN,TEST,"")
;;R^"860.8:",100,15
;;D^ ; ..Q:'$L(OCXX)
;;R^"860.8:",100,16
;;D^ ; ..S OCXY=$P(OCXX,U,2)_": "_$P(OCXX,U,3)_" "_$P(OCXX,U,4)
;;R^"860.8:",100,17
;;D^ ; ..S OCXY=OCXY_" "_$S($L($P(OCXX,U,5)):"["_$P(OCXX,U,5)_"]",1:"")
;;R^"860.8:",100,18
;;D^ ; ..I $L($P(OCXX,U,7)) S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXX,U,7),"2P")
;;R^"860.8:",100,19
;;D^ ; ..S:$L(OCXOUT) OCXOUT=OCXOUT_" " S OCXOUT=OCXOUT_OCXY
;;R^"860.8:",100,20
;;D^ ; Q:'$L(OCXOUT) "<Results Not Found>" Q OCXOUT
;;R^"860.8:",100,21
;;D^ ; ;
;;EOR^
;;KEY^860.8:^CONTRAST MEDIA CODE TRANSLATION
;;R^"860.8:",.01,"E"
;;D^CONTRAST MEDIA CODE TRANSLATION
;;R^"860.8:",.02,"E"
;;D^CONTRANS
;;R^"860.8:",100,1
;;D^ ;CONTRANS(OCXC) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; N OCXX
;;R^"860.8:",100,4
;;D^ ; Q:'$L($G(OCXC)) "" S OCXX=$S((OCXC["B"):"Barium",1:"")
;;R^"860.8:",100,5
;;D^ ; I (OCXC["M") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Unspecified contrast media"
;;R^"860.8:",100,6
;;D^ ; Q OCXX
;;R^"860.8:",100,7
;;D^ ; ;
;;EOR^
;;KEY^860.8:^MISSING TESTS DURING SESSION
;;R^"860.8:",.01,"E"
;;D^MISSING TESTS DURING SESSION
;;R^"860.8:",.02,"E"
;;D^MTSTF
;;R^"860.8:",100,1
;;D^ ;MTSTF(OILIST) ;
;;R^"860.8:",100,2
;;D^ ; ;
;1;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXDI02F 5229 printed Sep 23, 2025@20:00:11 Page 2
OCXDI02F ;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 ^OCXDI02G
+10 ;
+11 QUIT
+12 ;
DATA ;
+1 ;
+2 ;;R^"860.8:",100,2
+3 ;;D^ ; ; orderable item (determined via order number ORNUM) to trigger a
+4 ;;R^"860.8:",100,3
+5 ;;D^ ; ; notification when resulted
+6 ;;R^"860.8:",100,4
+7 ;;D^ ; N ORBFLAG,OI S ORBFLAG="",OI=""
+8 ;;R^"860.8:",100,5
+9 ;;D^ ; Q:+$G(ORNUM)<1 ORBFLAG
+10 ;;R^"860.8:",100,6
+11 ;;D^ ; S OI=$$OI^ORQOR2(ORNUM)
+12 ;;R^"860.8:",100,7
+13 ;;D^ ; Q:+$G(OI)<1 ORBFLAG
+14 ;;R^"860.8:",100,8
+15 ;;D^ ; S ORBFLAG=$$GET^XPAR("ALL","ORB ORDERABLE ITEM RESULTS","`"_OI,"Q")
+16 ;;R^"860.8:",100,9
+17 ;;D^ ; Q ORBFLAG
+18 ;;R^"860.8:",100,10
+19 ;;D^ ; ;
+20 ;;EOR^
+21 ;;KEY^860.8:^WARD ROOM-BED
+22 ;;R^"860.8:",.01,"E"
+23 ;;D^WARD ROOM-BED
+24 ;;R^"860.8:",.02,"E"
+25 ;;D^WARDRMBD
+26 ;;R^"860.8:",1,1
+27 ;;D^Returns the patient's ward and room-bed if they exist. Can be used to
+28 ;;R^"860.8:",1,2
+29 ;;D^determine if the patient is inpatient or outpatient. Official MAS policy
+30 ;;R^"860.8:",1,3
+31 ;;D^indicates that if the patient has a ward (^DPT(DFN,.1)), then they are an
+32 ;;R^"860.8:",1,4
+33 ;;D^inpatient. If the .1 node does not exist, they are an outpatient.
+34 ;;R^"860.8:",100,1
+35 ;;D^ ;WARDRMBD(DFN) ;
+36 ;;R^"860.8:",100,2
+37 ;;D^ ; ;
+38 ;;R^"860.8:",100,3
+39 ;;D^ ; Q:'$G(DFN) 0
+40 ;;R^"860.8:",100,4
+41 ;;D^ ; N OUT S OUT=$G(^DPT(DFN,.1)) Q:'$L(OUT) 0
+42 ;;R^"860.8:",100,5
+43 ;;D^ ; S OUT=1_"^"_OUT_" "_$G(^DPT(DFN,.101)) Q OUT
+44 ;;R^"860.8:",100,6
+45 ;;D^ ; ;
+46 ;;EOR^
+47 ;;KEY^860.8:^IN LIST OPERATOR
+48 ;;R^"860.8:",.01,"E"
+49 ;;D^IN LIST OPERATOR
+50 ;;R^"860.8:",.02,"E"
+51 ;;D^LIST
+52 ;;R^"860.8:",100,1
+53 ;;D^ ;LIST(DATA,LIST) ; IS THE DATA FIELD IN THE LIST
+54 ;;R^"860.8:",100,2
+55 ;;D^ ; ;
+56 ;;R^"860.8:",100,3
+57 ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20," $$LIST(""",DATA,""",""",LIST,""")"
+58 ;;R^"860.8:",100,4
+59 ;;D^ ; S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LIST=LIST_"," S DATA=","_DATA_","
+60 ;;R^"860.8:",100,5
+61 ;;D^ ; Q (LIST[DATA)
+62 ;;R^"860.8:",100,6
+63 ;;D^ ; ;
+64 ;;EOR^
+65 ;;KEY^860.8:^RECENT CHOLECYSTOGRAM PREOCEDURE
+66 ;;R^"860.8:",.01,"E"
+67 ;;D^RECENT CHOLECYSTOGRAM PREOCEDURE
+68 ;;R^"860.8:",.02,"E"
+69 ;;D^RECCH
+70 ;;R^"860.8:",100,1
+71 ;;D^ ;RECCH(DFN,DAYS) ;
+72 ;;R^"860.8:",100,2
+73 ;;D^ ; ;
+74 ;;R^"860.8:",100,3
+75 ;;D^ ; Q:'$G(DFN) 0 Q:'$G(DAYS) 0 N OUT S OUT=$$RECENTCH^ORKRA(DFN,DAYS) Q:'$L(OUT) 0 Q 1_U_OUT
+76 ;;R^"860.8:",100,4
+77 ;;D^ ; ;
+78 ;;EOR^
+79 ;;KEY^860.8:^FORMATTED LAB RESULTS
+80 ;;R^"860.8:",.01,"E"
+81 ;;D^FORMATTED LAB RESULTS
+82 ;;R^"860.8:",.02,"E"
+83 ;;D^FLAB
+84 ;;R^"860.8:",100,1
+85 ;;D^ ;FLAB(DFN,OCXLIST,OCXSPEC) ;
+86 ;;R^"860.8:",100,2
+87 ;;D^ ; ;
+88 ;;R^"860.8:",100,3
+89 ;;D^ ; Q:'$G(DFN) "<Patient Not Specified>"
+90 ;;R^"860.8:",100,4
+91 ;;D^ ; Q:'$L($G(OCXLIST)) "<Lab Tests Not Specified>"
+92 ;;R^"860.8:",100,5
+93 ;;D^ ; N OCXLAB,OCXOUT,OCXPC,OCXSL,SPEC S OCXOUT="",SPEC=""
+94 ;;R^"860.8:",100,6
+95 ;;D^ ; I $L($G(OCXSPEC)) S OCXSL=$$TERMLKUP(OCXSPEC,.OCXSL)
+96 ;;R^"860.8:",100,7
+97 ;;D^ ; F OCXPC=1:1:$L(OCXLIST,U) S OCXLAB=$P(OCXLIST,U,OCXPC) I $L(OCXLAB) D
+98 ;;R^"860.8:",100,8
+99 ;;D^ ; .N OCXX,OCXY,X,Y,DIC,TEST,SPEC,OCXTL
+100 ;;R^"860.8:",100,9
+101 ;;D^ ; .S OCXTL="" Q:'$$TERMLKUP(OCXLAB,.OCXTL)
+102 ;;R^"860.8:",100,10
+103 ;;D^ ; .S OCXX="",TEST=0 F S TEST=$O(OCXTL(TEST)) Q:'TEST D Q:$L(OCXX)
+104 ;;R^"860.8:",100,11
+105 ;;D^ ; ..I $L($G(OCXSL)) D
+106 ;;R^"860.8:",100,12
+107 ;;D^ ; ...S SPEC=0 F S SPEC=$O(OCXSL(SPEC)) Q:'SPEC D Q:$L(OCXX)
+108 ;;R^"860.8:",100,13
+109 ;;D^ ; ....S OCXX=$$LOCL^ORQQLR1(DFN,TEST,SPEC)
+110 ;;R^"860.8:",100,14
+111 ;;D^ ; ..I '$L($G(OCXSL)) S OCXX=$$LOCL^ORQQLR1(DFN,TEST,"")
+112 ;;R^"860.8:",100,15
+113 ;;D^ ; ..Q:'$L(OCXX)
+114 ;;R^"860.8:",100,16
+115 ;;D^ ; ..S OCXY=$P(OCXX,U,2)_": "_$P(OCXX,U,3)_" "_$P(OCXX,U,4)
+116 ;;R^"860.8:",100,17
+117 ;;D^ ; ..S OCXY=OCXY_" "_$S($L($P(OCXX,U,5)):"["_$P(OCXX,U,5)_"]",1:"")
+118 ;;R^"860.8:",100,18
+119 ;;D^ ; ..I $L($P(OCXX,U,7)) S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXX,U,7),"2P")
+120 ;;R^"860.8:",100,19
+121 ;;D^ ; ..S:$L(OCXOUT) OCXOUT=OCXOUT_" " S OCXOUT=OCXOUT_OCXY
+122 ;;R^"860.8:",100,20
+123 ;;D^ ; Q:'$L(OCXOUT) "<Results Not Found>" Q OCXOUT
+124 ;;R^"860.8:",100,21
+125 ;;D^ ; ;
+126 ;;EOR^
+127 ;;KEY^860.8:^CONTRAST MEDIA CODE TRANSLATION
+128 ;;R^"860.8:",.01,"E"
+129 ;;D^CONTRAST MEDIA CODE TRANSLATION
+130 ;;R^"860.8:",.02,"E"
+131 ;;D^CONTRANS
+132 ;;R^"860.8:",100,1
+133 ;;D^ ;CONTRANS(OCXC) ;
+134 ;;R^"860.8:",100,2
+135 ;;D^ ; ;
+136 ;;R^"860.8:",100,3
+137 ;;D^ ; N OCXX
+138 ;;R^"860.8:",100,4
+139 ;;D^ ; Q:'$L($G(OCXC)) "" S OCXX=$S((OCXC["B"):"Barium",1:"")
+140 ;;R^"860.8:",100,5
+141 ;;D^ ; I (OCXC["M") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Unspecified contrast media"
+142 ;;R^"860.8:",100,6
+143 ;;D^ ; Q OCXX
+144 ;;R^"860.8:",100,7
+145 ;;D^ ; ;
+146 ;;EOR^
+147 ;;KEY^860.8:^MISSING TESTS DURING SESSION
+148 ;;R^"860.8:",.01,"E"
+149 ;;D^MISSING TESTS DURING SESSION
+150 ;;R^"860.8:",.02,"E"
+151 ;;D^MTSTF
+152 ;;R^"860.8:",100,1
+153 ;;D^ ;MTSTF(OILIST) ;
+154 ;;R^"860.8:",100,2
+155 ;;D^ ; ;
+156 ;1;
+157 ;
