ORY21107 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*211) ;APR 5,2005 at 08:07 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**211**;Dec 17,1997 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998 ; S ; ; D DOT^ORY211ES ; ; 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("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT ; G ^ORY21108 ; Q ; DATA ; ; ;;R^"860.8:",100,2 ;;D^ ; ;SERUM CREATININE within in format: ;;R^"860.8:",100,3 ;;D^ ; ; test id^result units flag ref range collection d/t ;;R^"860.8:",100,4 ;;D^ ; N BDT,CDT,ORY,ORX,ORZ,X,ORI,ORJ,CREARSLT,LABFILE,SPECFILE ;;R^"860.8:",100,5 ;;D^ ; Q:'$L($G(ORDFN)) "0^" ;;R^"860.8:",100,6 ;;D^ ; Q:'$L($G(ORDAYS)) "0^" ;;R^"860.8:",100,7 ;;D^ ; D NOW^%DTC ;;R^"860.8:",100,8 ;;D^ ; S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","") ;;R^"860.8:",100,9 ;;D^ ; K % ;;R^"860.8:",100,10 ;;D^ ; Q:'$L($G(BDT)) "0^" ;;R^"860.8:",100,11 ;;D^ ; S LABFILE=$$TERMLKUP("SERUM CREATININE",.ORY) ;;R^"860.8:",100,12 ;;D^ ; Q:$G(LABFILE)'=60 "0^" ;;R^"860.8:",100,13 ;;D^ ; Q:+$D(ORY)<1 "0^" ;;R^"860.8:",100,14 ;;D^ ; S SPECFILE=$$TERMLKUP("SERUM SPECIMEN",.ORX) ;;R^"860.8:",100,15 ;;D^ ; Q:$G(SPECFILE)'=61 "0^" ;;R^"860.8:",100,16 ;;D^ ; Q:+$D(ORX)<1 "0^" ;;R^"860.8:",100,17 ;;D^ ; S ORI=0 F S ORI=$O(ORY(ORI)) Q:'ORI I +$G(CREARSLT)<1 D ;;R^"860.8:",100,18 ;;D^ ; .S ORJ=0 F S ORJ=$O(ORX(ORJ)) Q:'ORJ I +$G(CREARSLT)<1 D ;;R^"860.8:",100,19 ;;D^ ; ..S ORZ=$$LOCL^ORQQLR1(ORDFN,ORI,ORJ) ;;R^"860.8:",100,20 ;;D^ ; ..Q:'$L($G(ORZ)) ;;R^"860.8:",100,21 ;;D^ ; ..S CDT=$P(ORZ,U,7) ;;R^"860.8:",100,22 ;;D^ ; ..I CDT'