Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLREXEC4

BLREXEC4.m

Go to the documentation of this file. 
  1. BLREXEC4 ;IHS/OIT/MKK - IHS Implementation of the Creatinine Clearance equation ; 11-Apr-2016 14:39 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38
  1.  ;
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1.  ;
  1. CREATCLR(CREAT,URINECR,URINEVOL,CREATCLR) ; EP - Standard -- major assumption is 24hr urine
  1.  NEW (CREAT,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,URINECR,URINEVOL,XPARSYS,XQXFLG)
  1.  ;
  1.  ; Algorithm:  Ucr     TV
  1.  ;             ---  x  ----
  1.  ;             Scr     1440
  1.  ;
  1.  ; where Ucr = Urine Creatinine; Scr = Serum Creatinine; TV = Total Urine Volume; 1440 = 24 hours in minutes
  1.  ;
  1.  ; None of the values can be less than 0.1, otherwise it's deemed an invalid amount.
  1.  Q:+$G(CREAT)<.1 " CREAT N/A"
  1.  Q:+$G(URINECR)<.1 "URINECR N/A"
  1.  Q:+$G(URINEVOL)<.1 "URINEVOL N/A"
  1.  ;
  1.  S TRAILER=""
  1.  ;
  1.  I +$G(CREATCLR) D
  1.  . S F60CCLR=$O(^LAB(60,"C","CH;"_CREATCLR_";1",0))
  1.  . S SITESPEC=$O(^LAB(60,F60CCLR,1,0))
  1.  . S UNITS=$P($G(^LAB(60,F60CCLR,1,SITESPEC,0)),U,7)
  1.  . ;
  1.  . S $P(TRAILER,"!",13)=""
  1.  . S TRAILER="^^"_TRAILER_UNITS_"^^^^"_DUZ(2)
  1.  ;
  1.  Q $FN(((URINECR/CREAT)*(URINEVOL/1440)),"",2)
  1.  ;
  1.  ;
  1. TESTEQUA ; EP - Debug -- Allows user to TEST the equation
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S (BLRTFLAG,ONGO)="YES"
  1.  S TAB=$J("",5),TAB2=TAB_TAB,TAB3=TAB_TAB_TAB
  1.  S HEADER(1)="IHS LAB"
  1.  S HEADER(2)="Creatinine Clearance"
  1.  S HEADER(3)=$$CJ^XLFSTR("Equation Testing",IOM)
  1.  ;
  1.  F  Q:ONGO'="YES"  D
  1.  . D HEADERDT^BLRGMENU
  1.  . Q:$$GETCREAT(.CREATININE)="Q"
  1.  . Q:$$GETURICR(.URINECR)="Q"
  1.  . Q:$$GETURVOL(.URINEVOL)="Q"
  1.  . ;
  1.  . D HEADERDT^BLRGMENU
  1.  . W TAB,"Serum Creatinine: ",CREATININE_" mg/dL",!
  1.  . W TAB,"Urine Creatinine: ",URINECR_" mg/dL",!
  1.  . W TAB,"    Urine Volume: ",URINEVOL_" mL",!
  1.  . W TAB,"Time Assumed to be 24 Hours.",!
  1.  . W !!,TAB2,"Creatinine Clearance Equation = ",$$CREATCLR(CREATININE,URINECR,URINEVOL),!!
  1.  . ;
  1.  . D ^XBFMK
  1.  . S DIR(0)="YO"
  1.  . S DIR("A")=TAB3_"Again"
  1.  . S DIR("B")="NO"
  1.  . D ^DIR
  1.  . S ONGO=$S(Y=1:"YES",1:"NO")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. NEWDELTA ; EP - Allows users to create new Creatinine Clearance Delta Check
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D SETBLRVS("NEWDELTA")
  1.  ;
  1.  S CREATSTR="Creatinine Clearance"
  1.  S HEADER(1)="IHS LAB"
  1.  S HEADER(2)=CREATSTR
  1.  S HEADER(3)=$$CJ^XLFSTR("Delta Check Creation",IOM)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Name of the "_CREATSTR_" Delta Check"
  1.  D ^DIR
  1.  I +$G(DIRUT) D GQMFDIRR  Q
  1.  ;
  1.  S NAME=$G(X)
  1.  ;
  1.  ; Make sure it's not a duplicate Delta Check Name
  1.  I +$O(^LAB(62.1,"B",NAME,0)) D BADSTUFF(NAME_" is a duplicate Delta Check Name.")  Q
  1.  ;
  1.  Q:$$GF60DATA("Test to hold "_CREATSTR_" Results",.F60CCPTR,.F60CCDSC,.CRECLRDN)="Q"
  1.  ;
  1.  Q:$$GF60DATA("Serum Creatinine Test to use for "_CREATSTR_" calculation",.F60SCRP,.F60SCRD,.SCRDN)="Q"
  1.  ;
  1.  Q:$$GF60DATA("Urine Creatinine Test to use for "_CREATSTR_" calculation",.F60UCRP,.F60UCRD,.UCRDN)="Q"
  1.  ;
  1.  Q:$$GF60DATA("Urine Volume test to use for "_CREATSTR_" calculation",.F60UVPTR,.F60UVDSC,.URVOLDN)="Q"
  1.  ;
  1.  ; Create the delta check
  1.  S XCODE="I LRSB("_SCRDN_"),LRSB("_UCRDN_"),LRDL S LRSB("_CRECLRDN_")=$$CREATCLR^BLREXEC4(LRSB("_SCRDN_"),LRSB("_UCRDN_"),LRDL)"
  1.  ;
  1.  S DESC(1)="This delta check, when added to the test named "
  1.  S DESC(2)="     "_$$LJ^XLFSTR(F60UVDSC,75)
  1.  S DESC(3)="will calculate a Creatinine Clearance."
  1.  S DESC(4)=" "
  1.  S DESC(5)="The Creatinine Clearance calculation will be stuffed into the test called"
  1.  S DESC(6)="     "_$$LJ^XLFSTR(F60CCDSC,75)
  1.  S DESC(7)=" "
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D DLTADICA(NAME,XCODE,.DESC)
  1.  ;
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1.  ;
  1.  ; ============================= UTILITIES =============================
  1.  ;
  1. JUSTNEW ; EP - Generic RPMS EXCLUSIVE NEW
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  Q
  1.  ;
  1. SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
  1.  K BLRVERN,BLRVERN2
  1.  ;
  1.  S BLRVERN=$P($P($T(+1),";")," ")
  1.  S:$L($G(TWO)) BLRVERN2=$G(TWO)
  1.  Q
  1.  ;
  1. GQMFDIRR ; Generic "Quit" message for D ^DIR response
  1.  D BADSTUFF("No/Invalid/Quit Entry.")
  1.  Q
  1.  ;
  1. BADSTUFF(MSG,TAB) ; EP - Simple Message
  1.  S:+$G(TAB)<1 TAB=4
  1.  W !!,?TAB,$$TRIM^XLFSTR(MSG,"LR"," "),"  Routine Ends."
  1.  D PRESSKEY^BLRGMENU(TAB+5)
  1.  Q
  1.  ;
  1. GF60DATA(PROMPT,F60PTR,F60DESC,F60DN) ; EP - Get File 60 Data
  1.  W !
  1.  D ^XBFMK
  1.  S DIR(0)="PO^60:EMZ"
  1.  S DIR("A")=PROMPT
  1.  D ^DIR
  1.  I +$G(DIRUT) D GQMFDIRR  Q "Q"
  1.  ;
  1.  S F60DN=$$GET1^DIQ(60,+Y,"DATA NAME","I")
  1.  I $L(F60DN)<1 D BADSTUFF("Test "_$P(Y,U,2)_" has no DataName.")  Q "Q"
  1.  ;
  1.  S F60PTR=+Y,F60DESC=$P(Y,U,2)
  1.  Q "OK"
  1.  ;
  1. GETDNAMT(NAME) ; EP - Get DataName from File 60 Test
  1.  NEW F60IEN
  1.  S F60IEN=+$$FIND1^DIC(60,,,NAME)
  1.  Q:F60IEN<1 "NULL"
  1.  ;
  1.  S DNAME=+$$GET1^DIQ(60,F60IEN_",",400,"I")
  1.  ;
  1.  Q $S(DNAME:DNAME,1:"NULL")
  1.  ;
  1. GETCREAT(CREATININE) ; EP - Serum Creatinine function
  1.  D ^XBFMK
  1.  S DIR(0)="NO^::2"
  1.  S DIR("A")=TAB_"Enter Serum Creatinine Value (mg/dL Units)"
  1.  D ^DIR
  1.  ;
  1.  I X=""!(+$G(DIRUT))!(+$G(Y)<.1) D GQMFDIRR  S ONGO="NO"  Q "Q"
  1.  ;
  1.  W !
  1.  S CREATININE=+Y
  1.  Q "OK"
  1.  ;
  1.  ;
  1. GETURICR(URINECR) ; EP - Urine Creatinine function
  1.  ; D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="NO^::2"
  1.  S DIR("A")=TAB_"Enter Urine Creatinine Value (mg/dL Units)"
  1.  D ^DIR
  1.  ;
  1.  I X=""!(+$G(DIRUT))!(+$G(Y)<.1) D GQMFDIRR  S ONGO="NO"  Q "Q"
  1.  ;
  1.  W !
  1.  S URINECR=+Y
  1.  Q "OK"
  1.  ;
  1.  ;
  1. GETURVOL(URINEVOL) ; EP - Urine Volume function
  1.  ; D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="NO^::2"
  1.  S DIR("A")=TAB_"Enter 24 Hour Urine Volume (mL Units)"
  1.  D ^DIR
  1.  ;
  1.  I X=""!(+$G(DIRUT))!(+$G(Y)<.1) D GQMFDIRR  S ONGO="NO"  Q "Q"
  1.  ;
  1.  S URINEVOL=+Y
  1.  W !
  1.  Q "OK"
  1.  ;
  1.  ;
  1. DLTADICA(NAME,XCODE,DESC) ; EP
  1.  NEW DICT0,DICT1,FDA,ERRS,PTR
  1.  NEW HEREYAGO
  1.  ;
  1.  W !!,"Adding "_NAME_" to Delta Check Dictionary.",!
  1.  ;
  1.  D ^XBFMK
  1.  K ERRS,FDA,IENS,DIE
  1.  ; 
  1.  S DICT1="62.1"
  1.  S FDA(DICT1,"?+1,",.01)=NAME   ; Find the Name node, or create it.
  1.  S FDA(DICT1,"?+1,",10)=XCODE   ; Execute Code
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . D BADSTUFF("Error in adding "_NAME_" to the Delta Check Dictionary.")
  1.  ;
  1.  W !,?5,NAME_" Delta Check added to Delta Check Dictionary.",!
  1.  ;
  1.  ; Now, add the Description
  1.  K ERRS
  1.  S PTR=$$FIND1^DIC(62.1,,,NAME)
  1.  M WPARRAY("WP")=DESC
  1.  D WP^DIE(62.1,PTR_",",30,"K","WPARRAY(""WP"")","ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . W !!,"Error in adding DESCRIPTION to "_NAME_" Delta Check in the Delta Check Dictionary."
  1.  . D BADSTUFF("")
  1.  ;
  1.  W !,?5,NAME_" Delta Check DESCRIPTION added to Delta Check Dictionary.",!
  1.  ;
  1.  ; Now, add the SITE NOTES DATE
  1.  K ERRS,FDA
  1.  S FDA(62.131,"?+1,"_PTR_",",.01)=$P($$NOW^XLFDT,".",1)
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . W !!,"Error in adding SITES NOTES DATE to "_NAME_" Delta Check in the Delta Check Dictionary."
  1.  . D BADSTUFF("")
  1.  ;
  1.  ; Now, add the TEXT
  1.  K ERRS,WPARRAY
  1.  S WPARRAY("WP",1)="Created by "_$$GET1^DIQ(200,DUZ,"NAME")_"     DUZ:"_DUZ
  1.  D WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . W !!,"Error in adding TEXT to "_NAME_" Delta Check in the Delta Check Dictionary."
  1.  . D BADSTUFF("")
  1.  ;
  1.  W !,?5,NAME_" Delta Check TEXT added to Delta Check Dictionary."
  1.  Q