OCXOZ0A ;SLC/RJS,CLA - Order Check Scan ;OCT 30,2024 at 12:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
; ***************************************************************
; ** Warning: This routine is automatically generated by the **
; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
; ** will be lost the next time the rule compiler executes. **
; ***************************************************************
;
Q
;
CHK226 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK162+20^OCXOZ07.
;
Q:$G(OCXOERR)
;
; Local CHK226 Variables
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(43) ---> Data Field: OI NATIONAL ID (FREE TEXT)
; OCXDF(74) ---> Data Field: VA DRUG CLASS (FREE TEXT)
;
; Local Extrinsic Functions
;
S OCXDF(74)=$P($$ENVAC^PSJORUT2(OCXDF(43)),"^",2) I $L(OCXDF(74)),(OCXDF(74)="AMINOGLYCOSIDES") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK231
Q
;
CHK231 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK226+12.
;
Q:$G(OCXOERR)
;
; Local CHK231 Variables
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(64) ---> Data Field: FORMATTED RENAL LAB RESULTS (FREE TEXT)
; OCXDF(76) ---> Data Field: CREATININE CLEARANCE (ESTIM) VALUE (NUMERIC)
;
; Local Extrinsic Functions
; CRCL( ------------> CREATININE CLEARANCE (ESTIMATED/CALCULATED)
; FILE(DFN,71, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: AMINOGLYCOSIDE ORDER SESSION)
; FLAB( ------------> FORMATTED LAB RESULTS
;
S OCXDF(64)=$$FLAB(OCXDF(37),"SERUM CREATININE^SERUM UREA NITROGEN","SERUM SPECIMEN"),OCXDF(76)=$P($$CRCL(OCXDF(37)),"^",2),OCXOERR=$$FILE(DFN,71,"64,76") Q:OCXOERR
Q
;
CHK235 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK198+10^OCXOZ09.
;
Q:$G(OCXOERR)
;
; Local CHK235 Variables
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT)
; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
; OCXDF(78) ---> Data Field: PATIENT TOO BIG FOR SCANNER FLAG (BOOLEAN)
;
; Local Extrinsic Functions
; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES
; CTMRI( -----------> CT MRI PHYSICAL LIMITS
; FILE(DFN,106, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: RADIOLOGY PROCEDURE CONTAINS NON-BARIUM CONTRAST MEDIA)
;
S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(78)=$P($$CTMRI(OCXDF(37),OCXDF(73)),"^",1) I $L(OCXDF(78)),(OCXDF(78)) D CHK240
S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) I $L(OCXDF(67)),$$CLIST(OCXDF(67),"M,I,N") S OCXOERR=$$FILE(DFN,106,"") Q:OCXOERR
Q
;
CHK240 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK235+16.
;
Q:$G(OCXOERR)
;
; Local CHK240 Variables
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
; OCXDF(79) ---> Data Field: PATIENT TOO BIG FOR SCANNER TEXT (FREE TEXT)
; OCXDF(80) ---> Data Field: PATIENT TOO BIG FOR SCANNER DEVICE (FREE TEXT)
;
; Local Extrinsic Functions
; CTMRI( -----------> CT MRI PHYSICAL LIMITS
; FILE(DFN,72, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PATIENT OVER CT OR MRI DEVICE LIMITATIONS)
;
S OCXDF(79)=$P($$CTMRI(OCXDF(37),OCXDF(73)),"^",2),OCXDF(80)=$P($$CTMRI(OCXDF(37),OCXDF(73)),"^",3),OCXOERR=$$FILE(DFN,72,"79,80") Q:OCXOERR
Q
;
CHK246 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK181+19^OCXOZ08.
;
Q:$G(OCXOERR)
;
; Local CHK246 Variables
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(64) ---> Data Field: FORMATTED RENAL LAB RESULTS (FREE TEXT)
;
; Local Extrinsic Functions
; FILE(DFN,73, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: CREATININE CLEARANCE ESTIMATE)
; FLAB( ------------> FORMATTED LAB RESULTS
;
S OCXDF(64)=$$FLAB(OCXDF(37),"SERUM CREATININE^SERUM UREA NITROGEN","SERUM SPECIMEN"),OCXOERR=$$FILE(DFN,73,"64,76") Q:OCXOERR
Q
;
CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
;
N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q
Q ''PC
;
CRCL(DFN) ; Compiler Function: CREATININE CLEARANCE (ESTIMATED/CALCULATED)
;
N HT,AGE,SEX,SCR,SCRD,CRCL,LRWKLD,RSLT,ORW,ORH,PSCR
N HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW
S RSLT="0^<Unavailable>"
S PSCR="^^^^^^0"
D VITAL^ORQQVI("WEIGHT","WT",DFN,.ORW,0,"",$$NOW^XLFDT)
Q:'$D(ORW) RSLT
S ABW=$P(ORW(1),U,3) Q:+$G(ABW)<1 RSLT
S ABW=ABW/2.2 ;ABW (actual body weight) in kg
D VITAL^ORQQVI("HEIGHT","HT",DFN,.ORH,0,"",$$NOW^XLFDT)
Q:'$D(ORH) RSLT
S HT=$P(ORH(1),U,3) Q:+$G(HT)<1 RSLT
S AGE=$$AGE^ORQPTQ4(DFN) Q:'AGE RSLT
S SEX=$P($$SEX^ORQPTQ4(DFN),U,1) Q:'$L(SEX) RSLT
S OCXTL="" Q:'$$TERMLKUP^ORB31(.OCXTL,"SERUM CREATININE") RSLT
S OCXTLS="" Q:'$$TERMLKUP^ORB31(.OCXTLS,"SERUM SPECIMEN") RSLT
S SCR="",OCXT=0 F S OCXT=$O(OCXTL(OCXT)) Q:'OCXT D
.S OCXTS=0 F S OCXTS=$O(OCXTLS(OCXTS)) Q:'OCXTS D
..S SCR=$$LOCL^ORQQLR1(DFN,$P(OCXTL(OCXT),U),$P(OCXTLS(OCXTS),U))
..I $P(SCR,U,7)>$P(PSCR,U,7) S PSCR=SCR
S SCR=PSCR,SCRV=$P(SCR,U,3) Q:+$G(SCRV)<.01 RSLT
S SCRD=$P(SCR,U,7) Q:'$L(SCRD) RSLT
;
S HTGT60=$S(HT>60:(HT-60)*2.3,1:0) ;if ht > 60 inches
I HTGT60>0 D
.S IBW=$S(SEX="M":50+HTGT60,1:45.5+HTGT60) ;Ideal Body Weight
.S BWRATIO=(ABW/IBW) ;body weight ratio
.S BWDIFF=$S(ABW>IBW:ABW-IBW,1:0)
.S LOWBW=$S(IBW<ABW:IBW,1:ABW)
.I BWRATIO>1.3,(BWDIFF>0) S ADJBW=((0.3*BWDIFF)+IBW)
.E S ADJBW=LOWBW
I +$G(ADJBW)<1 D
.S ADJBW=ABW
S CRCL=(((140-AGE)*ADJBW)/(SCRV*72))
;
S:SEX="M" RSLT=SCRD_U_$J(CRCL,1,1)
S:SEX="F" RSLT=SCRD_U_$J((CRCL*.85),1,1)
Q RSLT
;
CTMRI(DFN,OCXOI) ; Compiler Function: CT MRI PHYSICAL LIMITS
;
N OCXDEV,OCXWTP,OCXHTP,OCXWTL,OCXHTL
S OCXDEV=$$TYPE^ORKRA(OCXOI)
Q:'((OCXDEV="MRI")!(OCXDEV="CT")) 0_U
S OCXWTP=$P($$WT^ORQPTQ4(DFN),U,2),OCXHTP=$P($$HT^ORQPTQ4(DFN),U,2)
I (OCXDEV="CT") S OCXWTL=$$GET^XPAR("ALL","ORK CT LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK CT LIMIT HT",1,"Q")
I (OCXDEV="CT"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"CT scanner"
I (OCXDEV="CT"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"CT scanner"
I (OCXDEV="MRI") S OCXWTL=$$GET^XPAR("ALL","ORK MRI LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK MRI LIMIT HT",1,"Q")
I (OCXDEV="MRI"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"MRI scanner"
I (OCXDEV="MRI"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"MRI scanner"
Q 0_U
;
FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element.
;
N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
;
Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
;
S OCXDATA(DFN,OCXELE)=1
F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D
.S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
;
M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
;
Q 0
;
FLAB(DFN,OCXLIST,OCXSPEC) ; Compiler Function: FORMATTED LAB RESULTS
;
Q:'$G(DFN) "<Patient Not Specified>"
Q:'$L($G(OCXLIST)) "<Lab Tests Not Specified>"
N OCXLAB,OCXOUT,OCXPC,OCXSL,SPEC S OCXOUT="",SPEC=""
I $L($G(OCXSPEC)) S OCXSL=$$TERMLKUP(OCXSPEC,.OCXSL)
F OCXPC=1:1:$L(OCXLIST,U) S OCXLAB=$P(OCXLIST,U,OCXPC) I $L(OCXLAB) D
.N OCXX,OCXY,X,Y,DIC,TEST,SPEC,OCXTL,OCXA,OCXR
.S OCXTL="" Q:'$$TERMLKUP(OCXLAB,.OCXTL)
.S OCXX="",TEST=0 F S TEST=$O(OCXTL(TEST)) Q:'TEST D
..I $L($G(OCXSL)) D
...S SPEC=0 F S SPEC=$O(OCXSL(SPEC)) Q:'SPEC D
....S OCXX=$$LOCL^ORQQLR1(DFN,TEST,SPEC) I $L(OCXX) D
.....S OCXA($P(OCXX,U,7))=OCXX
..I '$L($G(OCXSL)) S OCXX=$$LOCL^ORQQLR1(DFN,TEST,"")
..Q:'$L(OCXX)
.I $D(OCXA) S OCXR="",OCXR=$O(OCXA(OCXR),-1),OCXX=OCXA(OCXR)
.I $L(OCXX) D
..S OCXY=$P(OCXX,U,2)_": "_$P(OCXX,U,3)_" "_$P(OCXX,U,4)
..S OCXY=OCXY_" "_$S($L($P(OCXX,U,5)):"["_$P(OCXX,U,5)_"]",1:"")
..I $L($P(OCXX,U,7)) S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXX,U,7),"2P")
.S:$L(OCXOUT) OCXOUT=OCXOUT_" " S OCXOUT=OCXOUT_$G(OCXY)
Q:'$L(OCXOUT) "<Results Not Found>" Q OCXOUT
;
TERMLKUP(OCXTERM,OCXLIST) ;
Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOZ0A 8495 printed Dec 13, 2024@02:25:56 Page 2
OCXOZ0A ;SLC/RJS,CLA - Order Check Scan ;OCT 30,2024 at 12:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ; ***************************************************************
+5 ; ** Warning: This routine is automatically generated by the **
+6 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
+7 ; ** will be lost the next time the rule compiler executes. **
+8 ; ***************************************************************
+9 ;
+10 QUIT
+11 ;
CHK226 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK162+20^OCXOZ07.
+2 ;
+3 if $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK226 Variables
+6 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+7 ; OCXDF(43) ---> Data Field: OI NATIONAL ID (FREE TEXT)
+8 ; OCXDF(74) ---> Data Field: VA DRUG CLASS (FREE TEXT)
+9 ;
+10 ; Local Extrinsic Functions
+11 ;
+12 SET OCXDF(74)=$PIECE($$ENVAC^PSJORUT2(OCXDF(43)),"^",2)
IF $LENGTH(OCXDF(74))
IF (OCXDF(74)="AMINOGLYCOSIDES")
SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
DO CHK231
+13 QUIT
+14 ;
CHK231 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK226+12.
+2 ;
+3 if $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK231 Variables
+6 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+7 ; OCXDF(64) ---> Data Field: FORMATTED RENAL LAB RESULTS (FREE TEXT)
+8 ; OCXDF(76) ---> Data Field: CREATININE CLEARANCE (ESTIM) VALUE (NUMERIC)
+9 ;
+10 ; Local Extrinsic Functions
+11 ; CRCL( ------------> CREATININE CLEARANCE (ESTIMATED/CALCULATED)
+12 ; FILE(DFN,71, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: AMINOGLYCOSIDE ORDER SESSION)
+13 ; FLAB( ------------> FORMATTED LAB RESULTS
+14 ;
+15 SET OCXDF(64)=$$FLAB(OCXDF(37),"SERUM CREATININE^SERUM UREA NITROGEN","SERUM SPECIMEN")
SET OCXDF(76)=$PIECE($$CRCL(OCXDF(37)),"^",2)
SET OCXOERR=$$FILE(DFN,71,"64,76")
if OCXOERR
QUIT
+16 QUIT
+17 ;
CHK235 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK198+10^OCXOZ09.
+2 ;
+3 if $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK235 Variables
+6 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+7 ; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT)
+8 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
+9 ; OCXDF(78) ---> Data Field: PATIENT TOO BIG FOR SCANNER FLAG (BOOLEAN)
+10 ;
+11 ; Local Extrinsic Functions
+12 ; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES
+13 ; CTMRI( -----------> CT MRI PHYSICAL LIMITS
+14 ; FILE(DFN,106, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: RADIOLOGY PROCEDURE CONTAINS NON-BARIUM CONTRAST MEDIA)
+15 ;
+16 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXDF(78)=$PIECE($$CTMRI(OCXDF(37),OCXDF(73)),"^",1)
IF $LENGTH(OCXDF(78))
IF (OCXDF(78))
DO CHK240
+17 SET OCXDF(67)=$$CM^ORQQRA(OCXDF(73))
IF $LENGTH(OCXDF(67))
IF $$CLIST(OCXDF(67),"M,I,N")
SET OCXOERR=$$FILE(DFN,106,"")
if OCXOERR
QUIT
+18 QUIT
+19 ;
CHK240 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK235+16.
+2 ;
+3 if $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK240 Variables
+6 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+7 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
+8 ; OCXDF(79) ---> Data Field: PATIENT TOO BIG FOR SCANNER TEXT (FREE TEXT)
+9 ; OCXDF(80) ---> Data Field: PATIENT TOO BIG FOR SCANNER DEVICE (FREE TEXT)
+10 ;
+11 ; Local Extrinsic Functions
+12 ; CTMRI( -----------> CT MRI PHYSICAL LIMITS
+13 ; FILE(DFN,72, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PATIENT OVER CT OR MRI DEVICE LIMITATIONS)
+14 ;
+15 SET OCXDF(79)=$PIECE($$CTMRI(OCXDF(37),OCXDF(73)),"^",2)
SET OCXDF(80)=$PIECE($$CTMRI(OCXDF(37),OCXDF(73)),"^",3)
SET OCXOERR=$$FILE(DFN,72,"79,80")
if OCXOERR
QUIT
+16 QUIT
+17 ;
CHK246 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK181+19^OCXOZ08.
+2 ;
+3 if $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK246 Variables
+6 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+7 ; OCXDF(64) ---> Data Field: FORMATTED RENAL LAB RESULTS (FREE TEXT)
+8 ;
+9 ; Local Extrinsic Functions
+10 ; FILE(DFN,73, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: CREATININE CLEARANCE ESTIMATE)
+11 ; FLAB( ------------> FORMATTED LAB RESULTS
+12 ;
+13 SET OCXDF(64)=$$FLAB(OCXDF(37),"SERUM CREATININE^SERUM UREA NITROGEN","SERUM SPECIMEN")
SET OCXOERR=$$FILE(DFN,73,"64,76")
if OCXOERR
QUIT
+14 QUIT
+15 ;
CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
+1 ;
+2 NEW PC
FOR PC=1:1:$LENGTH(LIST,","),0
IF PC
IF $LENGTH($PIECE(LIST,",",PC))
IF (DATA[$PIECE(LIST,",",PC))
QUIT
+3 QUIT ''PC
+4 ;
CRCL(DFN) ; Compiler Function: CREATININE CLEARANCE (ESTIMATED/CALCULATED)
+1 ;
+2 NEW HT,AGE,SEX,SCR,SCRD,CRCL,LRWKLD,RSLT,ORW,ORH,PSCR
+3 NEW HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW
+4 SET RSLT="0^<Unavailable>"
+5 SET PSCR="^^^^^^0"
+6 DO VITAL^ORQQVI("WEIGHT","WT",DFN,.ORW,0,"",$$NOW^XLFDT)
+7 if '$DATA(ORW)
QUIT RSLT
+8 SET ABW=$PIECE(ORW(1),U,3)
if +$GET(ABW)<1
QUIT RSLT
+9 ;ABW (actual body weight) in kg
SET ABW=ABW/2.2
+10 DO VITAL^ORQQVI("HEIGHT","HT",DFN,.ORH,0,"",$$NOW^XLFDT)
+11 if '$DATA(ORH)
QUIT RSLT
+12 SET HT=$PIECE(ORH(1),U,3)
if +$GET(HT)<1
QUIT RSLT
+13 SET AGE=$$AGE^ORQPTQ4(DFN)
if 'AGE
QUIT RSLT
+14 SET SEX=$PIECE($$SEX^ORQPTQ4(DFN),U,1)
if '$LENGTH(SEX)
QUIT RSLT
+15 SET OCXTL=""
if '$$TERMLKUP^ORB31(.OCXTL,"SERUM CREATININE")
QUIT RSLT
+16 SET OCXTLS=""
if '$$TERMLKUP^ORB31(.OCXTLS,"SERUM SPECIMEN")
QUIT RSLT
+17 SET SCR=""
SET OCXT=0
FOR
SET OCXT=$ORDER(OCXTL(OCXT))
if 'OCXT
QUIT
Begin DoDot:1
+18 SET OCXTS=0
FOR
SET OCXTS=$ORDER(OCXTLS(OCXTS))
if 'OCXTS
QUIT
Begin DoDot:2
+19 SET SCR=$$LOCL^ORQQLR1(DFN,$PIECE(OCXTL(OCXT),U),$PIECE(OCXTLS(OCXTS),U))
+20 IF $PIECE(SCR,U,7)>$PIECE(PSCR,U,7)
SET PSCR=SCR
End DoDot:2
End DoDot:1
+21 SET SCR=PSCR
SET SCRV=$PIECE(SCR,U,3)
if +$GET(SCRV)<.01
QUIT RSLT
+22 SET SCRD=$PIECE(SCR,U,7)
if '$LENGTH(SCRD)
QUIT RSLT
+23 ;
+24 ;if ht > 60 inches
SET HTGT60=$SELECT(HT>60:(HT-60)*2.3,1:0)
+25 IF HTGT60>0
Begin DoDot:1
+26 ;Ideal Body Weight
SET IBW=$SELECT(SEX="M":50+HTGT60,1:45.5+HTGT60)
+27 ;body weight ratio
SET BWRATIO=(ABW/IBW)
+28 SET BWDIFF=$SELECT(ABW>IBW:ABW-IBW,1:0)
+29 SET LOWBW=$SELECT(IBW<ABW:IBW,1:ABW)
+30 IF BWRATIO>1.3
IF (BWDIFF>0)
SET ADJBW=((0.3*BWDIFF)+IBW)
+31 IF '$TEST
SET ADJBW=LOWBW
End DoDot:1
+32 IF +$GET(ADJBW)<1
Begin DoDot:1
+33 SET ADJBW=ABW
End DoDot:1
+34 SET CRCL=(((140-AGE)*ADJBW)/(SCRV*72))
+35 ;
+36 if SEX="M"
SET RSLT=SCRD_U_$JUSTIFY(CRCL,1,1)
+37 if SEX="F"
SET RSLT=SCRD_U_$JUSTIFY((CRCL*.85),1,1)
+38 QUIT RSLT
+39 ;
CTMRI(DFN,OCXOI) ; Compiler Function: CT MRI PHYSICAL LIMITS
+1 ;
+2 NEW OCXDEV,OCXWTP,OCXHTP,OCXWTL,OCXHTL
+3 SET OCXDEV=$$TYPE^ORKRA(OCXOI)
+4 if '((OCXDEV="MRI")!(OCXDEV="CT"))
QUIT 0_U
+5 SET OCXWTP=$PIECE($$WT^ORQPTQ4(DFN),U,2)
SET OCXHTP=$PIECE($$HT^ORQPTQ4(DFN),U,2)
+6 IF (OCXDEV="CT")
SET OCXWTL=$$GET^XPAR("ALL","ORK CT LIMIT WT",1,"Q")
SET OCXHTL=$$GET^XPAR("ALL","ORK CT LIMIT HT",1,"Q")
+7 IF (OCXDEV="CT")
IF (OCXWTL)
IF (OCXWTP>OCXWTL)
QUIT 1_U_"too heavy"_U_"CT scanner"
+8 IF (OCXDEV="CT")
IF (OCXHTL)
IF (OCXHTP>OCXHTL)
QUIT 1_U_"too tall"_U_"CT scanner"
+9 IF (OCXDEV="MRI")
SET OCXWTL=$$GET^XPAR("ALL","ORK MRI LIMIT WT",1,"Q")
SET OCXHTL=$$GET^XPAR("ALL","ORK MRI LIMIT HT",1,"Q")
+10 IF (OCXDEV="MRI")
IF (OCXWTL)
IF (OCXWTP>OCXWTL)
QUIT 1_U_"too heavy"_U_"MRI scanner"
+11 IF (OCXDEV="MRI")
IF (OCXHTL)
IF (OCXHTP>OCXHTL)
QUIT 1_U_"too tall"_U_"MRI scanner"
+12 QUIT 0_U
+13 ;
FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element.
+1 ;
+2 NEW OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
+3 SET DFN=+$GET(DFN)
SET OCXELE=+$GET(OCXELE)
+4 ;
+5 if 'DFN
QUIT 1
if 'OCXELE
QUIT 1
KILL OCXDATA
+6 ;
+7 SET OCXDATA(DFN,OCXELE)=1
+8 FOR OCXPC=1:1:$LENGTH(OCXDFL,",")
SET OCXDFI=$PIECE(OCXDFL,",",OCXPC)
IF OCXDFI
Begin DoDot:1
+9 SET OCXVAL=$GET(OCXDF(+OCXDFI))
SET OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
End DoDot:1
+10 ;
+11 MERGE ^TMP("OCXCHK",$JOB,DFN)=OCXDATA(DFN)
+12 ;
+13 QUIT 0
+14 ;
FLAB(DFN,OCXLIST,OCXSPEC) ; Compiler Function: FORMATTED LAB RESULTS
+1 ;
+2 if '$GET(DFN)
QUIT "<Patient Not Specified>"
+3 if '$LENGTH($GET(OCXLIST))
QUIT "<Lab Tests Not Specified>"
+4 NEW OCXLAB,OCXOUT,OCXPC,OCXSL,SPEC
SET OCXOUT=""
SET SPEC=""
+5 IF $LENGTH($GET(OCXSPEC))
SET OCXSL=$$TERMLKUP(OCXSPEC,.OCXSL)
+6 FOR OCXPC=1:1:$LENGTH(OCXLIST,U)
SET OCXLAB=$PIECE(OCXLIST,U,OCXPC)
IF $LENGTH(OCXLAB)
Begin DoDot:1
+7 NEW OCXX,OCXY,X,Y,DIC,TEST,SPEC,OCXTL,OCXA,OCXR
+8 SET OCXTL=""
if '$$TERMLKUP(OCXLAB,.OCXTL)
QUIT
+9 SET OCXX=""
SET TEST=0
FOR
SET TEST=$ORDER(OCXTL(TEST))
if 'TEST
QUIT
Begin DoDot:2
+10 IF $LENGTH($GET(OCXSL))
Begin DoDot:3
+11 SET SPEC=0
FOR
SET SPEC=$ORDER(OCXSL(SPEC))
if 'SPEC
QUIT
Begin DoDot:4
+12 SET OCXX=$$LOCL^ORQQLR1(DFN,TEST,SPEC)
IF $LENGTH(OCXX)
Begin DoDot:5
+13 SET OCXA($PIECE(OCXX,U,7))=OCXX
End DoDot:5
End DoDot:4
End DoDot:3
+14 IF '$LENGTH($GET(OCXSL))
SET OCXX=$$LOCL^ORQQLR1(DFN,TEST,"")
+15 if '$LENGTH(OCXX)
QUIT
End DoDot:2
+16 IF $DATA(OCXA)
SET OCXR=""
SET OCXR=$ORDER(OCXA(OCXR),-1)
SET OCXX=OCXA(OCXR)
+17 IF $LENGTH(OCXX)
Begin DoDot:2
+18 SET OCXY=$PIECE(OCXX,U,2)_": "_$PIECE(OCXX,U,3)_" "_$PIECE(OCXX,U,4)
+19 SET OCXY=OCXY_" "_$SELECT($LENGTH($PIECE(OCXX,U,5)):"["_$PIECE(OCXX,U,5)_"]",1:"")
+20 IF $LENGTH($PIECE(OCXX,U,7))
SET OCXY=OCXY_" "_$$FMTE^XLFDT($PIECE(OCXX,U,7),"2P")
End DoDot:2
+21 if $LENGTH(OCXOUT)
SET OCXOUT=OCXOUT_" "
SET OCXOUT=OCXOUT_$GET(OCXY)
End DoDot:1
+22 if '$LENGTH(OCXOUT)
QUIT "<Results Not Found>"
QUIT OCXOUT
+23 ;
TERMLKUP(OCXTERM,OCXLIST) ;
+1 QUIT $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
+2 ;
