OCXDI02G ;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 ^OCXDI02H
;
Q
;
DATA ;
;
;;R^"860.8:",100,3
;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace OILIST: ",$G(OILIST)
;;R^"860.8:",100,4
;;D^ ; N OCXPC,OCXOI,OCXOUT S OCXOUT=""
;;R^"860.8:",100,5
;;D^ ; F OCXPC=1:1:$L(OILIST,",") S OCXOI=$P(OILIST,",",OCXPC) I $L(OCXOI) D
;;R^"860.8:",100,6
;;D^ ; .N OCXL,OCXF,OCXD0
;;R^"860.8:",100,7
;;D^ ; .S OCXL="",OCXF=$$TERMLKUP(OCXOI,.OCXL)
;;R^"860.8:",100,8
;;D^ ; .S OCXD0=0 F S OCXD0=$O(OCXL(OCXD0)) Q:'OCXD0 Q:$$OISESS^ORKCHK2(+OCXD0)
;;R^"860.8:",100,9
;;D^ ; .Q:OCXD0
;;R^"860.8:",100,10
;;D^ ; .S:$L(OCXOUT) OCXOUT=OCXOUT_", " S OCXOUT=OCXOUT_OCXOI
;;R^"860.8:",100,11
;;D^ ; Q OCXOUT
;;R^"860.8:",100,12
;;D^ ; ;
;;EOR^
;;KEY^860.8:^RECENT BARIUM STUDY
;;R^"860.8:",.01,"E"
;;D^RECENT BARIUM STUDY
;;R^"860.8:",.02,"E"
;;D^RECBAR
;;R^"860.8:",100,1
;;D^ ;RECBAR(DFN,HOURS) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; Q:'$G(DFN) 0 Q:'$G(HOURS) 0 N OUT S OUT=$$RECENTBA^ORKRA(DFN,HOURS) Q:'$L(OUT) 0 Q 1_U_OUT
;;R^"860.8:",100,4
;;D^ ; ;
;;EOR^
;;KEY^860.8:^RECENT WBC LAB PROCEDURE
;;R^"860.8:",.01,"E"
;;D^RECENT WBC LAB PROCEDURE
;;R^"860.8:",.02,"E"
;;D^RECWBC
;;R^"860.8:",100,1
;;D^ ;RECWBC(DFN,DAYS) ;
;;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=$$RECNTWBC^ORKLR(DFN,DAYS) Q:'OUT 0 Q OUT
;;R^"860.8:",100,5
;;D^ ; ;
;;EOR^
;;KEY^860.8:^CREATININE CLEARANCE (ESTIMATED/CALCULATED)
;;R^"860.8:",.01,"E"
;;D^CREATININE CLEARANCE (ESTIMATED/CALCULATED)
;;R^"860.8:",.02,"E"
;;D^CRCL
;;R^"860.8:",100,1
;;D^ ;CRCL(DFN) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; N WT,AGE,SEX,SCR,SCRD,CRCL,UNAV,OCXTL,OCXTLS,OCXT,OCXTS
;;R^"860.8:",100,4
;;D^ ; S UNAV="0^<Unavailable>"
;;R^"860.8:",100,5
;;D^ ; S WT=$P($$WT^ORQPTQ4(DFN),U,2)*.454 Q:'WT UNAV
;;R^"860.8:",100,6
;;D^ ; S AGE=$$AGE^ORQPTQ4(DFN) Q:'AGE UNAV
;;R^"860.8:",100,7
;;D^ ; S SEX=$P($$SEX^ORQPTQ4(DFN),U,1) Q:'$L(SEX) UNAV
;;R^"860.8:",100,8
;;D^ ; S OCXTL="" Q:'$$TERMLKUP("SERUM CREATININE",.OCXTL) UNAV
;;R^"860.8:",100,9
;;D^ ; S OCXTLS="" Q:'$$TERMLKUP("SERUM SPECIMEN",.OCXTLS) UNAV
;;R^"860.8:",100,10
;;D^ ; S SCR="",OCXT=0 F S OCXT=$O(OCXTL(OCXT)) Q:'OCXT D Q:$L(SCR)
;;R^"860.8:",100,11
;;D^ ; .S OCXTS=0 F S OCXTS=$O(OCXTLS(OCXTS)) Q:'OCXTS D Q:$L(SCR)
;;R^"860.8:",100,12
;;D^ ; ..S SCR=$$LOCL^ORQQLR1(DFN,OCXT,OCXTS)
;;R^"860.8:",100,13
;;D^ ; Q:'$L(SCR) UNAV S SCRV=$P(SCR,U,3) Q:'SCRV UNAV
;;R^"860.8:",100,14
;;D^ ; S SCRD=$P(SCR,U,7) Q:'$L(SCRD) UNAV
;;R^"860.8:",100,15
;;D^ ; ;
;;R^"860.8:",100,16
;;D^ ; S CRCL=(((140-AGE)*WT)/(SCRV*72))
;;R^"860.8:",100,17
;;D^ ; ;
;;R^"860.8:",100,18
;;D^ ; I (SEX="M") Q SCRD_U_$J(CRCL,1,2)
;;R^"860.8:",100,19
;;D^ ; I (SEX="F") Q SCRD_U_$J((CRCL*.85),1,2)
;;R^"860.8:",100,20
;;D^ ; Q UNAV
;;R^"860.8:",100,21
;;D^ ; ;
;;EOR^
;;KEY^860.8:^CT MRI PHYSICAL LIMITS
;;R^"860.8:",.01,"E"
;;D^CT MRI PHYSICAL LIMITS
;;R^"860.8:",.02,"E"
;;D^CTMRI
;;R^"860.8:",100,1
;;D^ ;CTMRI(DFN,OCXOI) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; N OCXDEV,OCXWTP,OCXHTP,OCXWTL,OCXHTL
;;R^"860.8:",100,4
;;D^ ; S OCXDEV=$$TYPE^ORKRA(OCXOI)
;;R^"860.8:",100,5
;;D^ ; Q:'((OCXDEV="MRI")!(OCXDEV="CT")) 0_U
;;R^"860.8:",100,6
;;D^ ; S OCXWTP=$P($$WT^ORQPTQ4(DFN),U,2),OCXHTP=$P($$HT^ORQPTQ4(DFN),U,2)
;;R^"860.8:",100,7
;;D^ ; I (OCXDEV="CT") S OCXWTL=$$GET^XPAR("ALL","ORK CT LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK CT LIMIT HT",1,"Q")
;;R^"860.8:",100,8
;;D^ ; I (OCXDEV="CT"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"CT scanner"
;;R^"860.8:",100,9
;;D^ ; I (OCXDEV="CT"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"CT scanner"
;;R^"860.8:",100,10
;;D^ ; I (OCXDEV="MRI") S OCXWTL=$$GET^XPAR("ALL","ORK MRI LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK MRI LIMIT HT",1,"Q")
;;R^"860.8:",100,11
;;D^ ; I (OCXDEV="MRI"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"MRI scanner"
;;R^"860.8:",100,12
;;D^ ; I (OCXDEV="MRI"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"MRI scanner"
;;R^"860.8:",100,13
;;D^ ; Q 0_U
;;R^"860.8:",100,14
;;D^ ; ;
;;EOR^
;;KEY^860.8:^GET ORDERABLE ITEM INTERNAL ENTRY NUMBER
;;R^"860.8:",.01,"E"
;;D^GET ORDERABLE ITEM INTERNAL ENTRY NUMBER
;;R^"860.8:",.02,"E"
;;D^GETOIIEN
;;R^"860.8:",100,1
;;D^ ;GETOIIEN(OCXPKG,OCXNAME) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; Q:'$L($G(OCXNAME)) 0 Q:'$L($G(OCXPKG)) 0 Q:'$D(^ORD(101.43,"S."_OCXPKG)) 0
;;R^"860.8:",100,4
;;D^ ; N OCXD0,OCXLIST,OCXOI
;;R^"860.8:",100,5
;1;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXDI02G 5200 printed Apr 09, 2024@21:32:06 Page 2
OCXDI02G ;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 ^OCXDI02H
+10 ;
+11 QUIT
+12 ;
DATA ;
+1 ;
+2 ;;R^"860.8:",100,3
+3 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace OILIST: ",$G(OILIST)
+4 ;;R^"860.8:",100,4
+5 ;;D^ ; N OCXPC,OCXOI,OCXOUT S OCXOUT=""
+6 ;;R^"860.8:",100,5
+7 ;;D^ ; F OCXPC=1:1:$L(OILIST,",") S OCXOI=$P(OILIST,",",OCXPC) I $L(OCXOI) D
+8 ;;R^"860.8:",100,6
+9 ;;D^ ; .N OCXL,OCXF,OCXD0
+10 ;;R^"860.8:",100,7
+11 ;;D^ ; .S OCXL="",OCXF=$$TERMLKUP(OCXOI,.OCXL)
+12 ;;R^"860.8:",100,8
+13 ;;D^ ; .S OCXD0=0 F S OCXD0=$O(OCXL(OCXD0)) Q:'OCXD0 Q:$$OISESS^ORKCHK2(+OCXD0)
+14 ;;R^"860.8:",100,9
+15 ;;D^ ; .Q:OCXD0
+16 ;;R^"860.8:",100,10
+17 ;;D^ ; .S:$L(OCXOUT) OCXOUT=OCXOUT_", " S OCXOUT=OCXOUT_OCXOI
+18 ;;R^"860.8:",100,11
+19 ;;D^ ; Q OCXOUT
+20 ;;R^"860.8:",100,12
+21 ;;D^ ; ;
+22 ;;EOR^
+23 ;;KEY^860.8:^RECENT BARIUM STUDY
+24 ;;R^"860.8:",.01,"E"
+25 ;;D^RECENT BARIUM STUDY
+26 ;;R^"860.8:",.02,"E"
+27 ;;D^RECBAR
+28 ;;R^"860.8:",100,1
+29 ;;D^ ;RECBAR(DFN,HOURS) ;
+30 ;;R^"860.8:",100,2
+31 ;;D^ ; ;
+32 ;;R^"860.8:",100,3
+33 ;;D^ ; Q:'$G(DFN) 0 Q:'$G(HOURS) 0 N OUT S OUT=$$RECENTBA^ORKRA(DFN,HOURS) Q:'$L(OUT) 0 Q 1_U_OUT
+34 ;;R^"860.8:",100,4
+35 ;;D^ ; ;
+36 ;;EOR^
+37 ;;KEY^860.8:^RECENT WBC LAB PROCEDURE
+38 ;;R^"860.8:",.01,"E"
+39 ;;D^RECENT WBC LAB PROCEDURE
+40 ;;R^"860.8:",.02,"E"
+41 ;;D^RECWBC
+42 ;;R^"860.8:",100,1
+43 ;;D^ ;RECWBC(DFN,DAYS) ;
+44 ;;R^"860.8:",100,2
+45 ;;D^ ; ;
+46 ;;R^"860.8:",100,3
+47 ;;D^ ; Q:'$G(DFN) 0
+48 ;;R^"860.8:",100,4
+49 ;;D^ ; N OUT S OUT=$$RECNTWBC^ORKLR(DFN,DAYS) Q:'OUT 0 Q OUT
+50 ;;R^"860.8:",100,5
+51 ;;D^ ; ;
+52 ;;EOR^
+53 ;;KEY^860.8:^CREATININE CLEARANCE (ESTIMATED/CALCULATED)
+54 ;;R^"860.8:",.01,"E"
+55 ;;D^CREATININE CLEARANCE (ESTIMATED/CALCULATED)
+56 ;;R^"860.8:",.02,"E"
+57 ;;D^CRCL
+58 ;;R^"860.8:",100,1
+59 ;;D^ ;CRCL(DFN) ;
+60 ;;R^"860.8:",100,2
+61 ;;D^ ; ;
+62 ;;R^"860.8:",100,3
+63 ;;D^ ; N WT,AGE,SEX,SCR,SCRD,CRCL,UNAV,OCXTL,OCXTLS,OCXT,OCXTS
+64 ;;R^"860.8:",100,4
+65 ;;D^ ; S UNAV="0^<Unavailable>"
+66 ;;R^"860.8:",100,5
+67 ;;D^ ; S WT=$P($$WT^ORQPTQ4(DFN),U,2)*.454 Q:'WT UNAV
+68 ;;R^"860.8:",100,6
+69 ;;D^ ; S AGE=$$AGE^ORQPTQ4(DFN) Q:'AGE UNAV
+70 ;;R^"860.8:",100,7
+71 ;;D^ ; S SEX=$P($$SEX^ORQPTQ4(DFN),U,1) Q:'$L(SEX) UNAV
+72 ;;R^"860.8:",100,8
+73 ;;D^ ; S OCXTL="" Q:'$$TERMLKUP("SERUM CREATININE",.OCXTL) UNAV
+74 ;;R^"860.8:",100,9
+75 ;;D^ ; S OCXTLS="" Q:'$$TERMLKUP("SERUM SPECIMEN",.OCXTLS) UNAV
+76 ;;R^"860.8:",100,10
+77 ;;D^ ; S SCR="",OCXT=0 F S OCXT=$O(OCXTL(OCXT)) Q:'OCXT D Q:$L(SCR)
+78 ;;R^"860.8:",100,11
+79 ;;D^ ; .S OCXTS=0 F S OCXTS=$O(OCXTLS(OCXTS)) Q:'OCXTS D Q:$L(SCR)
+80 ;;R^"860.8:",100,12
+81 ;;D^ ; ..S SCR=$$LOCL^ORQQLR1(DFN,OCXT,OCXTS)
+82 ;;R^"860.8:",100,13
+83 ;;D^ ; Q:'$L(SCR) UNAV S SCRV=$P(SCR,U,3) Q:'SCRV UNAV
+84 ;;R^"860.8:",100,14
+85 ;;D^ ; S SCRD=$P(SCR,U,7) Q:'$L(SCRD) UNAV
+86 ;;R^"860.8:",100,15
+87 ;;D^ ; ;
+88 ;;R^"860.8:",100,16
+89 ;;D^ ; S CRCL=(((140-AGE)*WT)/(SCRV*72))
+90 ;;R^"860.8:",100,17
+91 ;;D^ ; ;
+92 ;;R^"860.8:",100,18
+93 ;;D^ ; I (SEX="M") Q SCRD_U_$J(CRCL,1,2)
+94 ;;R^"860.8:",100,19
+95 ;;D^ ; I (SEX="F") Q SCRD_U_$J((CRCL*.85),1,2)
+96 ;;R^"860.8:",100,20
+97 ;;D^ ; Q UNAV
+98 ;;R^"860.8:",100,21
+99 ;;D^ ; ;
+100 ;;EOR^
+101 ;;KEY^860.8:^CT MRI PHYSICAL LIMITS
+102 ;;R^"860.8:",.01,"E"
+103 ;;D^CT MRI PHYSICAL LIMITS
+104 ;;R^"860.8:",.02,"E"
+105 ;;D^CTMRI
+106 ;;R^"860.8:",100,1
+107 ;;D^ ;CTMRI(DFN,OCXOI) ;
+108 ;;R^"860.8:",100,2
+109 ;;D^ ; ;
+110 ;;R^"860.8:",100,3
+111 ;;D^ ; N OCXDEV,OCXWTP,OCXHTP,OCXWTL,OCXHTL
+112 ;;R^"860.8:",100,4
+113 ;;D^ ; S OCXDEV=$$TYPE^ORKRA(OCXOI)
+114 ;;R^"860.8:",100,5
+115 ;;D^ ; Q:'((OCXDEV="MRI")!(OCXDEV="CT")) 0_U
+116 ;;R^"860.8:",100,6
+117 ;;D^ ; S OCXWTP=$P($$WT^ORQPTQ4(DFN),U,2),OCXHTP=$P($$HT^ORQPTQ4(DFN),U,2)
+118 ;;R^"860.8:",100,7
+119 ;;D^ ; I (OCXDEV="CT") S OCXWTL=$$GET^XPAR("ALL","ORK CT LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK CT LIMIT HT",1,"Q")
+120 ;;R^"860.8:",100,8
+121 ;;D^ ; I (OCXDEV="CT"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"CT scanner"
+122 ;;R^"860.8:",100,9
+123 ;;D^ ; I (OCXDEV="CT"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"CT scanner"
+124 ;;R^"860.8:",100,10
+125 ;;D^ ; I (OCXDEV="MRI") S OCXWTL=$$GET^XPAR("ALL","ORK MRI LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK MRI LIMIT HT",1,"Q")
+126 ;;R^"860.8:",100,11
+127 ;;D^ ; I (OCXDEV="MRI"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"MRI scanner"
+128 ;;R^"860.8:",100,12
+129 ;;D^ ; I (OCXDEV="MRI"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"MRI scanner"
+130 ;;R^"860.8:",100,13
+131 ;;D^ ; Q 0_U
+132 ;;R^"860.8:",100,14
+133 ;;D^ ; ;
+134 ;;EOR^
+135 ;;KEY^860.8:^GET ORDERABLE ITEM INTERNAL ENTRY NUMBER
+136 ;;R^"860.8:",.01,"E"
+137 ;;D^GET ORDERABLE ITEM INTERNAL ENTRY NUMBER
+138 ;;R^"860.8:",.02,"E"
+139 ;;D^GETOIIEN
+140 ;;R^"860.8:",100,1
+141 ;;D^ ;GETOIIEN(OCXPKG,OCXNAME) ;
+142 ;;R^"860.8:",100,2
+143 ;;D^ ; ;
+144 ;;R^"860.8:",100,3
+145 ;;D^ ; Q:'$L($G(OCXNAME)) 0 Q:'$L($G(OCXPKG)) 0 Q:'$D(^ORD(101.43,"S."_OCXPKG)) 0
+146 ;;R^"860.8:",100,4
+147 ;;D^ ; N OCXD0,OCXLIST,OCXOI
+148 ;;R^"860.8:",100,5
+149 ;1;
+150 ;
