OCXOZ08 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
;;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
;
CHK163 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK58+18^OCXOZ05.
;
Q:$G(OCXOERR)
;
; Local CHK163 Variables
; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(40) ---> Data Field: ORDER MODE (FREE TEXT)
; OCXDF(43) ---> Data Field: OI NATIONAL ID (FREE TEXT)
;
I (OCXDF(40)="ACCEPT") D CHK164
I (OCXDF(40)="DISPLAY") S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)),($E(OCXDF(2),1,2)="PS") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK182
I (OCXDF(40)="SELECT") D CHK196^OCXOZ09
I (OCXDF(40)="SESSION") S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)),($E(OCXDF(2),1,2)="PS") S OCXDF(43)=$P($P($G(OCXPSD),"|",3),"^",1) I $L(OCXDF(43)) D CHK227^OCXOZ0A
Q
;
CHK164 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK163+11.
;
Q:$G(OCXOERR)
;
; Local CHK164 Variables
; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(59) ---> Data Field: CHOLECYSTOGRAM PROCEDURE FLAG (BOOLEAN)
; OCXDF(62) ---> Data Field: PATIENT AGE (NUMERIC)
; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
;
; Local Extrinsic Functions
; CH( --------------> IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE
;
S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(59)=$P($$CH(OCXDF(73)),"^",1) I $L(OCXDF(59)),(OCXDF(59)) S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK171
S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)),($E(OCXDF(2),1,2)="PS") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(62)=$$AGE^ORQPTQ4(OCXDF(37)) I $L(OCXDF(62)) D CHK426^OCXOZ0D
Q
;
CHK171 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK164+15.
;
Q:$G(OCXOERR)
;
; Local CHK171 Variables
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(60) ---> Data Field: RECENT CHOLECYSTOGRAM FLAG (BOOLEAN)
; OCXDF(61) ---> Data Field: RECENT CHOLECYSTOGRAM TEXT (FREE TEXT)
; OCXDF(122) --> Data Field: RECENT CHOLECYSTOGRAM ORDER STATUS (FREE TEXT)
;
; Local Extrinsic Functions
; RECCH( -----------> RECENT CHOLECYSTOGRAM PREOCEDURE
; RECCHST( ---------> RECENT CHOLECYSTOGRAM ORDER STATUS
;
S OCXDF(60)=$P($$RECCH(OCXDF(37),7),"^",1) I $L(OCXDF(60)),(OCXDF(60)) S OCXDF(61)=$P($$RECCH(OCXDF(37),7),"^",3),OCXDF(122)=$P($$RECCHST(OCXDF(37),7),"^",2) D CHK176
Q
;
CHK176 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK171+15.
;
Q:$G(OCXOERR)
;
; Local Extrinsic Functions
; FILE(DFN,63, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PATIENT HAS RECENT CHOLECYSTOGRAM)
;
S OCXOERR=$$FILE(DFN,63,"61,122") Q:OCXOERR
Q
;
CHK182 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK163+12.
;
Q:$G(OCXOERR)
;
; Local CHK182 Variables
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(62) ---> Data Field: PATIENT AGE (NUMERIC)
; OCXDF(64) ---> Data Field: FORMATTED RENAL LAB RESULTS (FREE TEXT)
; OCXDF(76) ---> Data Field: CREATININE CLEARANCE (ESTIM) VALUE (NUMERIC)
; OCXDF(109) --> Data Field: NUMBER OF MEDS (NUMERIC)
; OCXDF(123) --> Data Field: POLYPHARMACY (BOOLEAN)
;
; Local Extrinsic Functions
; CRCL( ------------> CREATININE CLEARANCE (ESTIMATED/CALCULATED)
; FILE(DFN,95, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: POLYPHARMACY)
; FLAB( ------------> FORMATTED LAB RESULTS
;
S OCXDF(62)=$$AGE^ORQPTQ4(OCXDF(37)) I $L(OCXDF(62)),(OCXDF(62)>65) S OCXDF(64)=$$FLAB(OCXDF(37),"SERUM CREATININE^SERUM UREA NITROGEN","SERUM SPECIMEN") D CHK186
S OCXDF(76)=$P($$CRCL(OCXDF(37)),"^",2) I $L(OCXDF(76)),(OCXDF(76)<50),(OCXDF(76)>0) D CHK247^OCXOZ0A
S OCXDF(123)=$P($$POLYRX^ORKPS(OCXDF(37)),"^",1) I $L(OCXDF(123)),(OCXDF(123)) S OCXDF(109)=$P($$NUMRX^ORKPS(OCXDF(37)),"^",1),OCXOERR=$$FILE(DFN,95,"109") Q:OCXOERR
Q
;
CHK186 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK182+18.
;
Q:$G(OCXOERR)
;
; Local Extrinsic Functions
; FILE(DFN,64, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PHARMACY PATIENT OVER 65)
;
S OCXOERR=$$FILE(DFN,64,"64") Q:OCXOERR
Q
;
CH(OCXOI) ; Compiler Function: IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE
;
N OCXVAL S OCXVAL=$$CM^ORQQRA(OCXOI) Q:(OCXVAL["C") 1_U_OCXVAL Q 0
;
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
;
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
;
RECCH(DFN,DAYS) ; Compiler Function: RECENT CHOLECYSTOGRAM PREOCEDURE
;
Q:'$G(DFN) 0 Q:'$G(DAYS) 0 N OUT S OUT=$$RECENTCH^ORKRA(DFN,DAYS) Q:'$L(OUT) 0 Q 1_U_OUT
;
RECCHST(DFN,DAYS) ; Compiler Function: RECENT CHOLECYSTOGRAM ORDER STATUS
;
Q:'$G(DFN) 0 Q:'$G(DAYS) 0
N ORDER S ORDER=$P($$RECENTCH^ORKRA(DFN,DAYS),U) Q:'$L(ORDER) 0
N STATUS S STATUS=$P($$STATUS^ORQOR2(ORDER),U,2) Q:'$L(STATUS) 0
Q 1_U_STATUS
;
TERMLKUP(OCXTERM,OCXLIST) ;
Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
;
OCXOZ08 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
+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 ;
CHK163 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK58+18^OCXOZ05.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK163 Variables
+6 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
+7 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+8 ; OCXDF(40) ---> Data Field: ORDER MODE (FREE TEXT)
+9 ; OCXDF(43) ---> Data Field: OI NATIONAL ID (FREE TEXT)
+10 ;
+11 IF (OCXDF(40)="ACCEPT")
DO CHK164
+12 IF (OCXDF(40)="DISPLAY")
SET OCXDF(2)=$PIECE($GET(OCXPSD),"|",2)
IF $LENGTH(OCXDF(2))
IF ($EXTRACT(OCXDF(2),1,2)="PS")
SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
DO CHK182
+13 IF (OCXDF(40)="SELECT")
DO CHK196^OCXOZ09
+14 IF (OCXDF(40)="SESSION")
SET OCXDF(2)=$PIECE($GET(OCXPSD),"|",2)
IF $LENGTH(OCXDF(2))
IF ($EXTRACT(OCXDF(2),1,2)="PS")
SET OCXDF(43)=$PIECE($PIECE($GET(OCXPSD),"|",3),"^",1)
IF $LENGTH(OCXDF(43))
DO CHK227^OCXOZ0A
+15 QUIT
+16 ;
CHK164 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK163+11.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK164 Variables
+6 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
+7 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+8 ; OCXDF(59) ---> Data Field: CHOLECYSTOGRAM PROCEDURE FLAG (BOOLEAN)
+9 ; OCXDF(62) ---> Data Field: PATIENT AGE (NUMERIC)
+10 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
+11 ;
+12 ; Local Extrinsic Functions
+13 ; CH( --------------> IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE
+14 ;
+15 SET OCXDF(73)=$PIECE($GET(OCXPSD),"|",1)
IF $LENGTH(OCXDF(73))
SET OCXDF(59)=$PIECE($$CH(OCXDF(73)),"^",1)
IF $LENGTH(OCXDF(59))
IF (OCXDF(59))
SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
DO CHK171
+16 SET OCXDF(2)=$PIECE($GET(OCXPSD),"|",2)
IF $LENGTH(OCXDF(2))
IF ($EXTRACT(OCXDF(2),1,2)="PS")
SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXDF(62)=$$AGE^ORQPTQ4(OCXDF(37))
IF $LENGTH(OCXDF(62))
DO CHK426^OCXOZ0D
+17 QUIT
+18 ;
CHK171 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK164+15.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK171 Variables
+6 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+7 ; OCXDF(60) ---> Data Field: RECENT CHOLECYSTOGRAM FLAG (BOOLEAN)
+8 ; OCXDF(61) ---> Data Field: RECENT CHOLECYSTOGRAM TEXT (FREE TEXT)
+9 ; OCXDF(122) --> Data Field: RECENT CHOLECYSTOGRAM ORDER STATUS (FREE TEXT)
+10 ;
+11 ; Local Extrinsic Functions
+12 ; RECCH( -----------> RECENT CHOLECYSTOGRAM PREOCEDURE
+13 ; RECCHST( ---------> RECENT CHOLECYSTOGRAM ORDER STATUS
+14 ;
+15 SET OCXDF(60)=$PIECE($$RECCH(OCXDF(37),7),"^",1)
IF $LENGTH(OCXDF(60))
IF (OCXDF(60))
SET OCXDF(61)=$PIECE($$RECCH(OCXDF(37),7),"^",3)
SET OCXDF(122)=$PIECE($$RECCHST(OCXDF(37),7),"^",2)
DO CHK176
+16 QUIT
+17 ;
CHK176 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK171+15.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local Extrinsic Functions
+6 ; FILE(DFN,63, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PATIENT HAS RECENT CHOLECYSTOGRAM)
+7 ;
+8 SET OCXOERR=$$FILE(DFN,63,"61,122")
IF OCXOERR
QUIT
+9 QUIT
+10 ;
CHK182 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK163+12.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK182 Variables
+6 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+7 ; OCXDF(62) ---> Data Field: PATIENT AGE (NUMERIC)
+8 ; OCXDF(64) ---> Data Field: FORMATTED RENAL LAB RESULTS (FREE TEXT)
+9 ; OCXDF(76) ---> Data Field: CREATININE CLEARANCE (ESTIM) VALUE (NUMERIC)
+10 ; OCXDF(109) --> Data Field: NUMBER OF MEDS (NUMERIC)
+11 ; OCXDF(123) --> Data Field: POLYPHARMACY (BOOLEAN)
+12 ;
+13 ; Local Extrinsic Functions
+14 ; CRCL( ------------> CREATININE CLEARANCE (ESTIMATED/CALCULATED)
+15 ; FILE(DFN,95, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: POLYPHARMACY)
+16 ; FLAB( ------------> FORMATTED LAB RESULTS
+17 ;
+18 SET OCXDF(62)=$$AGE^ORQPTQ4(OCXDF(37))
IF $LENGTH(OCXDF(62))
IF (OCXDF(62)>65)
SET OCXDF(64)=$$FLAB(OCXDF(37),"SERUM CREATININE^SERUM UREA NITROGEN","SERUM SPECIMEN")
DO CHK186
+19 SET OCXDF(76)=$PIECE($$CRCL(OCXDF(37)),"^",2)
IF $LENGTH(OCXDF(76))
IF (OCXDF(76)<50)
IF (OCXDF(76)>0)
DO CHK247^OCXOZ0A
+20 SET OCXDF(123)=$PIECE($$POLYRX^ORKPS(OCXDF(37)),"^",1)
IF $LENGTH(OCXDF(123))
IF (OCXDF(123))
SET OCXDF(109)=$PIECE($$NUMRX^ORKPS(OCXDF(37)),"^",1)
SET OCXOERR=$$FILE(DFN,95,"109")
IF OCXOERR
QUIT
+21 QUIT
+22 ;
CHK186 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK182+18.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local Extrinsic Functions
+6 ; FILE(DFN,64, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PHARMACY PATIENT OVER 65)
+7 ;
+8 SET OCXOERR=$$FILE(DFN,64,"64")
IF OCXOERR
QUIT
+9 QUIT
+10 ;
CH(OCXOI) ; Compiler Function: IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE
+1 ;
+2 NEW OCXVAL
SET OCXVAL=$$CM^ORQQRA(OCXOI)
IF (OCXVAL["C")
QUIT 1_U_OCXVAL
QUIT 0
+3 ;
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 ;
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 ;
RECCH(DFN,DAYS) ; Compiler Function: RECENT CHOLECYSTOGRAM PREOCEDURE
+1 ;
+2 IF '$GET(DFN)
QUIT 0
IF '$GET(DAYS)
QUIT 0
NEW OUT
SET OUT=$$RECENTCH^ORKRA(DFN,DAYS)
IF '$LENGTH(OUT)
QUIT 0
QUIT 1_U_OUT
+3 ;
RECCHST(DFN,DAYS) ; Compiler Function: RECENT CHOLECYSTOGRAM ORDER STATUS
+1 ;
+2 IF '$GET(DFN)
QUIT 0
IF '$GET(DAYS)
QUIT 0
+3 NEW ORDER
SET ORDER=$PIECE($$RECENTCH^ORKRA(DFN,DAYS),U)
IF '$LENGTH(ORDER)
QUIT 0
+4 NEW STATUS
SET STATUS=$PIECE($$STATUS^ORQOR2(ORDER),U,2)
IF '$LENGTH(STATUS)
QUIT 0
+5 QUIT 1_U_STATUS
+6 ;
TERMLKUP(OCXTERM,OCXLIST) ;
+1 QUIT $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
+2 ;
