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

BLRPR30P.m

Go to the documentation of this file. 
  1. BLRPR30P ;IHS/OIT/MKK - IHS Lab PATCH 1030 Post Install Routine ;FEB 09, 2011 6:45 AM
  1.  ;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
  1.  ;
  1.  ; Cloned from BLRPR27P
  1.  ; 
  1.  Q
  1.  ;
  1. EP ; EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1.  ; Modify the Estimated Average Glucose (EAG) Delta Check so that only a
  1.  ; NUMERIC A1C result will store data. If the A1C result is not numeric,
  1.  ; DO NOT store anything.
  1. MODEAGDC ; EP
  1.  NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
  1.  NEW A1CIEN,A1CDESC,CP,MESSAGE,TARGET
  1.  ;
  1.  S CP=$P($T(+2),"*",3)  ; Current Patch
  1.  ;
  1.  D MKDELTA("HEMOGLOBIN A1C","ESTIMATED AVERAGE GLUCOSE","Modified by IHS Lab Patch "_CP)
  1.  Q
  1.  ;
  1. MKDELTA(F60TEST1,F60TEST2,FRMWHERE) ; EP
  1.  NEW EAGDNAME
  1.  ;
  1.  S XCODESTR="S %X="""" X:$D(LRDEL(1)) LRDEL(1) W:+$G(%X)>0 ""  ESTIMATED AVERAGE GLUCOSE:"",$P(%X,""^"") S:+$G(%X)>0 LRSB($$GETDNAM^BLREXECU("""_F60TEST2_"""))=%X K %,%X,%Y,%Z,%ZZ"
  1.  S OVER1STR="S %ZZ=$$GETDNAM^BLREXECU("""_F60TEST1_""") X:LRVRM>0 ""F %=%ZZ S %X(%)=$S(%=LRSB:X,$D(LRSB(%)):+LRSB(%),1:0)"" X:LRVRM>0 ""F %=%ZZ S %X(%)=$S($D(LRSB(%)):LRSB(%),1:0)"" S %X=$FN((((X)*28.7)-46.7),"""",0)"
  1.  S OVER1STR=OVER1STR_"_""^^!!!!!!^^!!!!!!mg/dl!!^^^^""_$G(DUZ(2))"
  1.  ;
  1.  S NAME="EAG"
  1.  S EAGDNAME=$$GETDNAM^BLREXECU(F60TEST2)
  1.  S EAGDNAME=$P($G(^DD(63.04,EAGDNAME,0)),"^")
  1.  S XCODE=XCODESTR
  1.  S OVER1=OVER1STR
  1.  S DESC(1)="This delta check, when added to the A1C test, will calculate an Estimated"
  1.  S DESC(2)="Average Glucose (EAG) using the equation: EAG=((A1C)*28.7)-46.7.  It will"
  1.  S DESC(3)="stuff the result into the "_EAGDNAME_" Location (Data Name).  NOTE: if "
  1.  S DESC(4)="the result of the A1C test is not numeric, or if the EAG evaluates to a"
  1.  S DESC(5)="number < 1, no value will be inserted into the Estimated Average Glucose"
  1.  S DESC(6)="test."
  1.  D DLTADICA(NAME,XCODE,OVER1,.DESC,FRMWHERE)
  1.  ;
  1.  Q
  1.  ;
  1. DLTADICA(NAME,XCODE,OVER1,DESC,FRMWHERE) ; EP
  1.  NEW DICT0,DICT1,FDA,ERRS,PTR
  1.  NEW HEREYAGO
  1.  ;
  1.  D BMES^XPDUTL("Modifying "_NAME_" Delta Check")
  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.  S FDA(DICT1,"?+1,",20)=OVER1   ; Overflow 1
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . D SORRY^BLRPRE27("Error in modifying "_NAME_" Delta Check XECUTABLE CODE field.","NONFATAL")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAME_" Delta Check XECUTABLE CODE field modified.",5)
  1.  ;
  1.  ; Modify the Description
  1.  K ERRS
  1.  D FIND^DIC(62.1,"","","",NAME,"","","","","HEREYAGO") ; Get Pointer
  1.  S PTR=$G(HEREYAGO("DILIST",2,1))
  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.  . D SORRY^BLRPRE27("Error in modifying DESCRIPTION of "_NAME_" Delta Check.","NONFATAL")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAME_" Delta Check DESCRIPTION modified.",5)
  1.  ;
  1.  ; Modify 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.  . D SORRY^BLRPRE27("Error in modifying SITES NOTES DATE of "_NAME_" Delta Check.","NONFATAL")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAME_" Delta Check SITES NOTES DATE modified.",5)
  1.  ;
  1.  ; Modify the TEXT
  1.  K ERRS,WPARRAY
  1.  S WPARRAY("WP",1)=FRMWHERE
  1.  D WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . D SORRY^BLRPRE27("Error in modifying TEXT of "_NAME_" Delta Check.","NONFATAL")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAME_" Delta Check TEXT modified.",5)
  1.  D MES^XPDUTL(NAME_" Delta Check Successfully Modified.")
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1.  ; Create new Estimated Average Glucose that will use GETREFR^BLRLINKU call to get
  1.  ; Reference Ranges & Units to stuff into File 63
  1. NEWEAG ; EP
  1.  NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
  1.  NEW A1CIEN,A1CDESC,CP,MESSAGE,TARGET
  1.  ;
  1.  S CP=$P($T(+2),"*",3)  ; Current Patch
  1.  ;
  1.  D MKNDELTA("ESTIMATED AVERAGE GLUCOSE","Created by IHS Lab Patch "_CP,"MEAG")
  1.  Q
  1.  ;
  1. MKNDELTA(F60TEST2,FRMWHERE,EAGDNAME) ; EP
  1.  S XCODESTR="S %X="""" X:$D(LRDEL(1)) LRDEL(1) W:+$G(%X)>0 ""  ESTIMATED AVERAGE GLUCOSE:"",$P(%X,""^"") S:+$G(%X)>0 LRSB($$GETDNAM^BLREXECU("""_F60TEST2_"""))=%X K %,%X,%Y,%Z,%ZZ"
  1.  S OVER1STR="S %ZZ=$$GETREFR^BLRUTIL3(""ESTIMATED AVERAGE GLUCOSE"")  S %XX=$FN((((X)*28.7)-46.7),"""",0)  S %YY=$S(%XX'>$P(%ZZ,""!"",2):""L"",%XX'<$P(%ZZ,""!"",3):""H"",1:"""")  S %X=%XX_""^""_%YY_""^!!!!!!^^""_%ZZ_""^^^^""_$G(DUZ(2))"
  1.  ;
  1.  S XCODE=XCODESTR
  1.  S OVER1=OVER1STR
  1.  S DESC(1)="This delta check, when added to the A1C test, will calculate an Estimated"
  1.  S DESC(2)="Average Glucose (EAG) using the equation:"
  1.  S DESC(3)="          EAG=((A1C)*28.7)-46.7."
  1.  S DESC(4)=" "
  1.  S DESC(5)="It will store the calculated result in the LAB DATA (# 63) File."
  1.  S DESC(6)="It will also store the UNITS, REFERENCE LOW, and REFERENCE HIGH values for"
  1.  S DESC(7)="the ESTIMATED AVERAGE GLUCOSE test in the LAB DATA (#63) file, if those"
  1.  S DESC(8)="entries exist."
  1.  S DESC(9)=" "
  1.  S DESC(10)="NOTE: if the result of the A1C test is not numeric, OR if the EAG"
  1.  S DESC(11)="      calculation < 1, then data will NOT be stored into the"
  1.  S DESC(12)="      Estimated Average Glucose test."
  1.  S DESC(13)=" "
  1.  ;
  1.  D NDLTADIC(EAGDNAME,XCODE,OVER1,.DESC,FRMWHERE)
  1.  ;
  1.  Q
  1.  ;
  1.  ; Adding NEW delta check
  1. NDLTADIC(NAME,XCODE,OVER1,DESC,FRMWHERE) ; EP
  1.  NEW DICT0,DICT1,FDA,ERRS,PTR
  1.  NEW HEREYAGO
  1.  ;
  1.  D BMES^XPDUTL("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.  S FDA(DICT1,"?+1,",20)=OVER1   ; Overflow 1
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . D SORRY^BLRPRE27("Error in adding "_NAME_" to the Delta Check Dictionary.","NONFATAL")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAME_" Delta Check added to Delta Check Dictionary.",5)
  1.  ;
  1.  ; Now, add the Description
  1.  K ERRS
  1.  D FIND^DIC(62.1,"","","",NAME,"","","","","HEREYAGO") ; Get Pointer
  1.  S PTR=$G(HEREYAGO("DILIST",2,1))
  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.  . D SORRY^BLRPRE27("Error in adding DESCRIPTION to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAME_" Delta Check DESCRIPTION added to Delta Check Dictionary.",5)
  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.  . D SORRY^BLRPRE27("Error in adding SITES NOTES DATE to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
  1.  ;
  1.  ; Now, add the TEXT
  1.  K ERRS,WPARRAY
  1.  S WPARRAY("WP",1)=FRMWHERE
  1.  D WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . D SORRY^BLRPRE27("Error in adding TEXT to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAME_" Delta Check TEXT added to Delta Check Dictionary.",5)
  1.  D BMES^XPDUTL(NAME_" Successfully Added to Delta Check Dictionary")
  1.  Q