source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ0B.m@ 1361

OCXOZ0B ;SLC/RJS,CLA - Order Check Scan ;DEC 27,2007 at 06:00
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
 ;;  ;;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
 ;
CHK241 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK236+16^OCXOZ0A.
 ;
 Q:$G(OCXOERR)
 ;
 ;    Local CHK241 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
 ;
CHK247 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK182+19^OCXOZ08.
 ;
 Q:$G(OCXOERR)
 ;
 ;    Local CHK247 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
 ;
CHK253 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK157+18^OCXOZ07.
 ;
 Q:$G(OCXOERR)
 ;
 ;    Local CHK253 Variables
 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
 ; OCXDF(34) ---> Data Field: ORDER NUMBER (NUMERIC)
 ; OCXDF(96) ---> Data Field: ORDERABLE ITEM NAME (FREE TEXT)
 ;
 ;      Local Extrinsic Functions
 ; FILE(DFN,110, ----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: STAT CONSULT RESULT)
 ; FILE(DFN,75, -----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: STAT IMAGING RESULT)
 ; ORDITEM( ---------> GET ORDERABLE ITEM FROM ORDER NUMBER
 ;
 I (OCXDF(2)="RA"),$L(OCXDF(34)) S OCXDF(96)=$$ORDITEM(OCXDF(34)),OCXOERR=$$FILE(DFN,75,"24,96") Q:OCXOERR 
 I (OCXDF(2)="GMRC"),$L(OCXDF(34)) S OCXDF(96)=$$ORDITEM(OCXDF(34)),OCXOERR=$$FILE(DFN,110,"24,96") Q:OCXOERR 
 Q
 ;
CHK264 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK151+18^OCXOZ07.
 ;
 Q:$G(OCXOERR)
 ;
 ;      Local Extrinsic Functions
 ; FILE(DFN,76, -----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: STAT LAB RESULT)
 ;
 S OCXOERR=$$FILE(DFN,76,"24,96") Q:OCXOERR 
 Q
 ;
CHK270 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK12+34^OCXOZ03.
 ;
 Q:$G(OCXOERR)
 ;
 ;    Local CHK270 Variables
 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
 ; OCXDF(84) ---> Data Field: INPATIENT (BOOLEAN)
 ; OCXDF(147) --> Data Field: PATIENT LOCATION (FREE TEXT)
 ;
 ;      Local Extrinsic Functions
 ; FILE(DFN,84, -----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: INPATIENT FOOD-DRUG REACTION)
 ; PATLOC( ----------> PATIENT LOCATION
 ; WARDRMBD( --------> WARD ROOM-BED
 ;
 S OCXDF(84)=$P($$WARDRMBD(OCXDF(37)),"^",1) I $L(OCXDF(84)),(OCXDF(84)) S OCXDF(147)=$P($$PATLOC(OCXDF(37)),"^",2),OCXOERR=$$FILE(DFN,84,"82,147") Q:OCXOERR 
 Q
 ;
CHK280 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK188+15^OCXOZ09.
 ;
 Q:$G(OCXOERR)
 ;
 ;    Local CHK280 Variables
 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
 ; OCXDF(125) --> Data Field: RECENT GLUCOPHAGE CREATININE TEXT (FREE TEXT)
 ; OCXDF(127) --> Data Field: RECENT GLUCOPHAGE CREATININE DAYS (NUMERIC)
 ;
 ;      Local Extrinsic Functions
 ;
 I ($E(OCXDF(2),1,2)="PS") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(125)=$P($$GLCREAT^ORKPS(OCXDF(37)),"^",2),OCXDF(127)=$P($$GCDAYS^ORKPS(OCXDF(37)),"^",1) D CHK285
 Q
 ;
CHK285 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK280+13.
 ;
 Q:$G(OCXOERR)
 ;
 ;      Local Extrinsic Functions
 ; FILE(DFN,86, -----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: GLUCOPHAGE ORDER)
 ;
 S OCXOERR=$$FILE(DFN,86,"125,127") Q:OCXOERR 
 Q
 ;
CHK293 ; Look through the current environment for valid Event/Elements for this patient.
 ;  Called from CHK113+20^OCXOZ06.
 ;
 Q:$G(OCXOERR)
 ;
 ;      Local Extrinsic Functions
 ; FILE(DFN,100, ----> FILE DATA IN PATIENT ACTIVE DATA FILE  (Event/Element: CANCELED BY NON-ORIG ORDERING PROVIDER)
 ;
 S OCXOERR=$$FILE(DFN,100,"105") Q:OCXOERR 
 Q
 ;
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
 ;
ORDITEM(OIEN) ;  Compiler Function: GET ORDERABLE ITEM FROM ORDER NUMBER
 Q:'$G(OIEN) ""
 ;
 N OITXT,X S OITXT=$$OI^ORQOR2(OIEN) Q:'OITXT "No orderable item found."
 S X=$G(^ORD(101.43,+OITXT,0)) Q:'$L(X) "No orderable item found."
 Q $P(X,U,1)
 ;
PATLOC(DFN) ;  Compiler Function: PATIENT LOCATION
 ;
 N OCXP1,OCXP2
 S OCXP1=$G(^TMP("OCXSWAP",$J,"OCXODATA","PV1",2))
 S OCXP2=$P($G(^TMP("OCXSWAP",$J,"OCXODATA","PV1",3)),"^",1)
 I OCXP2 D
 .S OCXP2=$P($G(^SC(+OCXP2,0)),"^",1,2)
 .I $L($P(OCXP2,"^",2)) S OCXP2=$P(OCXP2,"^",2)
 .E  S OCXP2=$P(OCXP2,"^",1)
 .S:'$L(OCXP2) OCXP2="NO LOC"
 I $L(OCXP1),$L(OCXP2) Q OCXP1_"^"_OCXP2
 ;
 S OCXP2=$G(^DPT(+$G(DFN),.1))
 I $L(OCXP2) Q "I^"_OCXP2
 Q "O^OUTPT"
 ;
TERMLKUP(OCXTERM,OCXLIST) ;
 Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
 ;
WARDRMBD(DFN) ;  Compiler Function: WARD ROOM-BED
 ;
 Q:'$G(DFN) 0
 N OUT S OUT=$G(^DPT(DFN,.1)) Q:'$L(OUT) 0
 S OUT=1_"^"_OUT_" "_$G(^DPT(DFN,.101)) Q OUT
 ;