BLRPR27P ;IHS/OIT/MKK - IHS Lab PATCH 1027 Post Install Routine ;JUL 06, 2010 3:14 PM
;;5.2;IHS LABORATORY;**1027**;NOV 01, 1997
;
Q
;
EP ; EP
D EEP^BLRGMENU
Q
;
ADDEAGDC ; EP -- Add Estimated Average Glucose (EAG) to Delta Check dictionary
NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
NEW A1CIEN,A1CDESC,MESSAGE,TARGET
;
;
D MKDELTA("HEMOGLOBIN A1C","ESTIMATED AVERAGE GLUCOSE","Created by IHS Lab Patch 1027")
Q
;
MKDELTA(F60TEST1,F60TEST2,FRMWHERE) ; EP
NEW EAGDNAME
S XCODESTR="S %X="""" X:$D(LRDEL(1)) LRDEL(1) W:$G(%X)'="""" "" ESTIMATED AVERAGE GLUCOSE:"",$P(%X,""^"") S:LRVRM>0 LRSB($$GETDNAM^BLREXECU("""_F60TEST2_"""))=%X K %,%X,%Y,%Z,%ZZ"
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)"
S OVER1STR=OVER1STR_"_""^^!!!!!!^^!!!!!!mg/dl!!^^^^""_$G(DUZ(2))"
;
S NAME="EAG"
S EAGDNAME=$$GETDNAM^BLREXECU(F60TEST2)
S EAGDNAME=$P($G(^DD(63.04,EAGDNAME,0)),"^")
S XCODE=XCODESTR
S OVER1=OVER1STR
S DESC(1)="This delta check, when added to the A1C test, will calculate an Estimated"
S DESC(2)="Average Glucose (EAG) using the equation: EAG=((A1C)*28.7)-46.7. It will"
S DESC(3)="stuff the result into the "_EAGDNAME_" Location (Data Name)."
D DLTADICA(NAME,XCODE,OVER1,.DESC,FRMWHERE)
;
Q
;
DLTADICA(NAME,XCODE,OVER1,DESC,FRMWHERE) ; EP
NEW DICT0,DICT1,FDA,ERRS,PTR
NEW HEREYAGO
;
D BMES^XPDUTL("Adding "_NAME_" to Delta Check Dictionary")
;
D ^XBFMK
K ERRS,FDA,IENS,DIE
;
S DICT1="62.1"
S FDA(DICT1,"?+1,",.01)=NAME ; Find the Name node, or create it.
S FDA(DICT1,"?+1,",10)=XCODE ; Execute Code
S FDA(DICT1,"?+1,",20)=OVER1 ; Overflow 1
D UPDATE^DIE("S","FDA",,"ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRPRE27("Error in adding "_NAME_" to the Delta Check Dictionary.","NONFATAL")
;
D OKAY^BLRKIDSU(NAME_" Delta Check added to Delta Check Dictionary.",5)
;
; Now, add the Description
K ERRS
D FIND^DIC(62.1,"","","",NAME,"","","","","HEREYAGO") ; Get Pointer
S PTR=$G(HEREYAGO("DILIST",2,1))
M WPARRAY("WP")=DESC
D WP^DIE(62.1,PTR_",",30,"K","WPARRAY(""WP"")","ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRPRE27("Error in adding DESCRIPTION to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
;
D OKAY^BLRKIDSU(NAME_" Delta Check DESCRIPTION added to Delta Check Dictionary.",5)
;
; Now, add the SITE NOTES DATE
K ERRS,FDA
S FDA(62.131,"?+1,"_PTR_",",.01)=$P($$NOW^XLFDT,".",1)
D UPDATE^DIE("S","FDA",,"ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRPRE27("Error in adding SITES NOTES DATE to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
;
; Now, add the TEXT
K ERRS,WPARRAY
S WPARRAY("WP",1)=FRMWHERE
D WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
;
I $D(ERRS("DIERR"))>0 D Q
. D SORRY^BLRPRE27("Error in adding TEXT to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
;
D OKAY^BLRKIDSU(NAME_" Delta Check TEXT added to Delta Check Dictionary.",5)
D BMES^XPDUTL(NAME_" Successfully Added to Delta Check Dictionary")
Q
;
TESTEAG(A1C) ; EP -- Interactive EAG Results
NEW EAG
I $G(A1C)="" D Q
. W !,"Null A1C. Routine Ends.",!
;
S EAG=((A1C)*28.7)-46.7
W !,?4,"A1C = ",A1C,?19,"EAG = ",$FN(EAG,"",0),?34,"EAG with decimals=",EAG,!
Q
;
UCHOOSE ; EP - Allows User to select tests to use for EAG Delta Check
NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
NEW A1CIEN,A1CDESC,MESSAGE,TARGET
NEW A1CTEST,CUREAG,EAGTEST,HEADER,LINE,OUT,QFLAG
;
S HEADER(1)="Estimated Average Glucose Delta Check Setup"
D HEADERDT^BLRGMENU
;
; Write Warning
S PKG="DLTAWARN"
F I=3:1 S X=$T(@PKG+I) Q:X["$$END" D
. W $P(X,";",3),!
;
D ^XBFMK
S DIR("A")="Continue (Y/N)"
S DIR(0)="Y"
D ^DIR
I +$G(Y)<1 D Q
. W !,"YES not selected. Routine ends.",!
. D PRESSKEY^BLRGMENU(10)
;
K HEADER
S HEADER(1)="Estimated Average Glucose Delta Check"
S HEADER(2)="Re-Initialization"
S QFLAG=0
;
; Make sure user either ends the session or answers both test questions
F Q:QFLAG!((+$G(A1CTEST)>0)&(+$G(EAGTEST)>0)) D
. D HEADERDT^BLRGMENU
. Q:$$GETF60("Enter HEMOGLOBIN A1C Test Name",.A1CTEST,.QFLAG)="Q"
. Q:$$GETF60("Enter Estimated Average Glucose Test Name",.EAGTEST,.QFLAG)="Q"
;
Q:QFLAG
;
K HEADER(2)
S HEADER(2)="Delete Current Estimated Average Glucose Delta Check"
D HEADERDT^BLRGMENU
W !,"The Current EAG will now be deleted.",!!
W ?5,"YES will delete the current EAG Delta Check.",!!
W ?5,"NO will stop the process.",!!
D ^XBFMK
S DIR("A")="Delete current EAG"
S DIR(0)="Y"
D ^DIR
I +$G(Y)<1 D
. W !!,"Current EAG Delta Check will *NOT* be deleted. Routine ends.",!
. D PRESSKEY^BLRGMENU(10)
. S QFLAG=1
;
Q:QFLAG
;
; Get IEN of current EAG Delta Check
D ^XBFMK
D FIND^DIC(62.1,,,,"EAG",,,,,"OUT")
S CUREAG=+$G(OUT("DILIST",2,1))
I CUREAG<1 D Q
. W !!,"Could not find Current EAG Delta Check. Routine ends.",!
. D PRESSKEY^BLRGMENU(10)
. S QFLAG=1
;
Q:QFLAG
;
; Delete current EAG
D ^XBFMK
S DIK="^LAB(62.1,"
S DA=CUREAG
D ^DIK
;
W !!,"Current EAG Deleted",!
D PRESSKEY^BLRGMENU(10)
;
; Create NEW EAG
K HEADER(2)
S HEADER(2)="Creating new EAG (Estimated Average Glucose) Delta Check"
D HEADERDT^BLRGMENU
W !
D MKDELTA($P(A1CTEST,"^",3),$P(EAGTEST,"^",3),"Interactively Created.")
;
D PRESSKEY^BLRGMENU(10)
Q
;
GETF60(MSG,F60TEST,QFLAG) ; EP
NEW DATANAME,TESTDESC,TESTIEN
;
S DATANAME=0
F Q:DATANAME>1!(QFLAG) D
. D HEADERDT^BLRGMENU
. D ^XBFMK
. S DIR(0)="P^60"
. S DIR("A")=MSG
. D ^DIR
. I +$G(DIRUT)>0!(+$G(Y)<1) D Q
.. S QFLAG=1
.. W !,?5,"Exit Selected. Routine ends.",!
.. D PRESSKEY^BLRGMENU(10)
. ;
. S TESTIEN=+$P($G(Y),"^")
. S TESTDESC=$P($G(Y),"^",2)
. S DATANAME=+$G(^LAB(60,+$G(Y),.2))
. I DATANAME<1 D
.. W !,?5,"Test ",TESTDESC," does NOT have a LOCATION (DATA NAME).",!!
.. D ^XBFMK
.. S DIR(0)="Y"
.. S DIR("A")="Try Again."
.. D ^DIR
.. I +$G(Y)<1 D
... S QFLAG=1
;
Q:QFLAG "Q"
;
S F60TEST=$G(Y)_"^"_$P($G(^DD(63.04,DATANAME,0)),"^")
I 'QFLAG D
. S WOTNAME=$$TRIM^XLFSTR($P($P(MSG,"Enter",2),"Name"))
. W !!,?5,TESTDESC," (",TESTIEN,") selected as ",WOTNAME,".",!!
. D PRESSKEY^BLRGMENU(10)
;
Q $S(QFLAG:"Q",1:"OK")
;
DLTAWARN ; EP -- Warning verbiage
;;1234567890123456789012345678901234567890123456789012345678901234567890
;;
;; This routine will allow a user to specify two tests from
;; the Laboratory Test File (# 60) that will be used to create a
;; new Estimated Average Glucose (EAG) Delta Check in the Delta
;; Check File (# 62.1).
;;
;; Please note that this will **DELETE** the original EAG
;; Delta check that was created during the post-install phase of
;; IHS Lab Patch 1027.
;;
;;$$END
BLRPR27P ;IHS/OIT/MKK - IHS Lab PATCH 1027 Post Install Routine ;JUL 06, 2010 3:14 PM
+1 ;;5.2;IHS LABORATORY;**1027**;NOV 01, 1997
+2 ;
+3 QUIT
+4 ;
EP ; EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
ADDEAGDC ; EP -- Add Estimated Average Glucose (EAG) to Delta Check dictionary
+1 NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
+2 NEW A1CIEN,A1CDESC,MESSAGE,TARGET
+3 ;
+4 ;
+5 DO MKDELTA("HEMOGLOBIN A1C","ESTIMATED AVERAGE GLUCOSE","Created by IHS Lab Patch 1027")
+6 QUIT
+7 ;
MKDELTA(F60TEST1,F60TEST2,FRMWHERE) ; EP
+1 NEW EAGDNAME
+2 SET XCODESTR="S %X="""" X:$D(LRDEL(1)) LRDEL(1) W:$G(%X)'="""" "" ESTIMATED AVERAGE GLUCOSE:"",$P(%X,""^"") S:LRVRM>0 LRSB($$GETDNAM^BLREXECU("""_F60TEST2_"""))=%X K %,%X,%Y,%Z,%ZZ"
+3 SET 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)"
+4 SET OVER1STR=OVER1STR_"_""^^!!!!!!^^!!!!!!mg/dl!!^^^^""_$G(DUZ(2))"
+5 ;
+6 SET NAME="EAG"
+7 SET EAGDNAME=$$GETDNAM^BLREXECU(F60TEST2)
+8 SET EAGDNAME=$PIECE($GET(^DD(63.04,EAGDNAME,0)),"^")
+9 SET XCODE=XCODESTR
+10 SET OVER1=OVER1STR
+11 SET DESC(1)="This delta check, when added to the A1C test, will calculate an Estimated"
+12 SET DESC(2)="Average Glucose (EAG) using the equation: EAG=((A1C)*28.7)-46.7. It will"
+13 SET DESC(3)="stuff the result into the "_EAGDNAME_" Location (Data Name)."
+14 DO DLTADICA(NAME,XCODE,OVER1,.DESC,FRMWHERE)
+15 ;
+16 QUIT
+17 ;
DLTADICA(NAME,XCODE,OVER1,DESC,FRMWHERE) ; EP
+1 NEW DICT0,DICT1,FDA,ERRS,PTR
+2 NEW HEREYAGO
+3 ;
+4 DO BMES^XPDUTL("Adding "_NAME_" to Delta Check Dictionary")
+5 ;
+6 DO ^XBFMK
+7 KILL ERRS,FDA,IENS,DIE
+8 ;
+9 SET DICT1="62.1"
+10 ; Find the Name node, or create it.
SET FDA(DICT1,"?+1,",.01)=NAME
+11 ; Execute Code
SET FDA(DICT1,"?+1,",10)=XCODE
+12 ; Overflow 1
SET FDA(DICT1,"?+1,",20)=OVER1
+13 DO UPDATE^DIE("S","FDA",,"ERRS")
+14 ;
+15 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+16 DO SORRY^BLRPRE27("Error in adding "_NAME_" to the Delta Check Dictionary.","NONFATAL")
End DoDot:1
QUIT
+17 ;
+18 DO OKAY^BLRKIDSU(NAME_" Delta Check added to Delta Check Dictionary.",5)
+19 ;
+20 ; Now, add the Description
+21 KILL ERRS
+22 ; Get Pointer
DO FIND^DIC(62.1,"","","",NAME,"","","","","HEREYAGO")
+23 SET PTR=$GET(HEREYAGO("DILIST",2,1))
+24 MERGE WPARRAY("WP")=DESC
+25 DO WP^DIE(62.1,PTR_",",30,"K","WPARRAY(""WP"")","ERRS")
+26 ;
+27 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+28 DO SORRY^BLRPRE27("Error in adding DESCRIPTION to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
End DoDot:1
QUIT
+29 ;
+30 DO OKAY^BLRKIDSU(NAME_" Delta Check DESCRIPTION added to Delta Check Dictionary.",5)
+31 ;
+32 ; Now, add the SITE NOTES DATE
+33 KILL ERRS,FDA
+34 SET FDA(62.131,"?+1,"_PTR_",",.01)=$PIECE($$NOW^XLFDT,".",1)
+35 DO UPDATE^DIE("S","FDA",,"ERRS")
+36 ;
+37 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+38 DO SORRY^BLRPRE27("Error in adding SITES NOTES DATE to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
End DoDot:1
QUIT
+39 ;
+40 ; Now, add the TEXT
+41 KILL ERRS,WPARRAY
+42 SET WPARRAY("WP",1)=FRMWHERE
+43 DO WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
+44 ;
+45 IF $DATA(ERRS("DIERR"))>0
Begin DoDot:1
+46 DO SORRY^BLRPRE27("Error in adding TEXT to "_NAME_" Delta Check in the Delta Check Dictionary.","NONFATAL")
End DoDot:1
QUIT
+47 ;
+48 DO OKAY^BLRKIDSU(NAME_" Delta Check TEXT added to Delta Check Dictionary.",5)
+49 DO BMES^XPDUTL(NAME_" Successfully Added to Delta Check Dictionary")
+50 QUIT
+51 ;
TESTEAG(A1C) ; EP -- Interactive EAG Results
+1 NEW EAG
+2 IF $GET(A1C)=""
Begin DoDot:1
+3 WRITE !,"Null A1C. Routine Ends.",!
End DoDot:1
QUIT
+4 ;
+5 SET EAG=((A1C)*28.7)-46.7
+6 WRITE !,?4,"A1C = ",A1C,?19,"EAG = ",$FNUMBER(EAG,"",0),?34,"EAG with decimals=",EAG,!
+7 QUIT
+8 ;
UCHOOSE ; EP - Allows User to select tests to use for EAG Delta Check
+1 NEW DESC,DESC1STR,DESC2STR,NAME,OVER1,OVER1STR,XCODE,XCODESTR
+2 NEW A1CIEN,A1CDESC,MESSAGE,TARGET
+3 NEW A1CTEST,CUREAG,EAGTEST,HEADER,LINE,OUT,QFLAG
+4 ;
+5 SET HEADER(1)="Estimated Average Glucose Delta Check Setup"
+6 DO HEADERDT^BLRGMENU
+7 ;
+8 ; Write Warning
+9 SET PKG="DLTAWARN"
+10 FOR I=3:1
SET X=$TEXT(@PKG+I)
IF X["$$END"
QUIT
Begin DoDot:1
+11 WRITE $PIECE(X,";",3),!
End DoDot:1
+12 ;
+13 DO ^XBFMK
+14 SET DIR("A")="Continue (Y/N)"
+15 SET DIR(0)="Y"
+16 DO ^DIR
+17 IF +$GET(Y)<1
Begin DoDot:1
+18 WRITE !,"YES not selected. Routine ends.",!
+19 DO PRESSKEY^BLRGMENU(10)
End DoDot:1
QUIT
+20 ;
+21 KILL HEADER
+22 SET HEADER(1)="Estimated Average Glucose Delta Check"
+23 SET HEADER(2)="Re-Initialization"
+24 SET QFLAG=0
+25 ;
+26 ; Make sure user either ends the session or answers both test questions
+27 FOR
IF QFLAG!((+$GET(A1CTEST)>0)&(+$GET(EAGTEST)>0))
QUIT
Begin DoDot:1
+28 DO HEADERDT^BLRGMENU
+29 IF $$GETF60("Enter HEMOGLOBIN A1C Test Name",.A1CTEST,.QFLAG)="Q"
QUIT
+30 IF $$GETF60("Enter Estimated Average Glucose Test Name",.EAGTEST,.QFLAG)="Q"
QUIT
End DoDot:1
+31 ;
+32 IF QFLAG
QUIT
+33 ;
+34 KILL HEADER(2)
+35 SET HEADER(2)="Delete Current Estimated Average Glucose Delta Check"
+36 DO HEADERDT^BLRGMENU
+37 WRITE !,"The Current EAG will now be deleted.",!!
+38 WRITE ?5,"YES will delete the current EAG Delta Check.",!!
+39 WRITE ?5,"NO will stop the process.",!!
+40 DO ^XBFMK
+41 SET DIR("A")="Delete current EAG"
+42 SET DIR(0)="Y"
+43 DO ^DIR
+44 IF +$GET(Y)<1
Begin DoDot:1
+45 WRITE !!,"Current EAG Delta Check will *NOT* be deleted. Routine ends.",!
+46 DO PRESSKEY^BLRGMENU(10)
+47 SET QFLAG=1
End DoDot:1
+48 ;
+49 IF QFLAG
QUIT
+50 ;
+51 ; Get IEN of current EAG Delta Check
+52 DO ^XBFMK
+53 DO FIND^DIC(62.1,,,,"EAG",,,,,"OUT")
+54 SET CUREAG=+$GET(OUT("DILIST",2,1))
+55 IF CUREAG<1
Begin DoDot:1
+56 WRITE !!,"Could not find Current EAG Delta Check. Routine ends.",!
+57 DO PRESSKEY^BLRGMENU(10)
+58 SET QFLAG=1
End DoDot:1
QUIT
+59 ;
+60 IF QFLAG
QUIT
+61 ;
+62 ; Delete current EAG
+63 DO ^XBFMK
+64 SET DIK="^LAB(62.1,"
+65 SET DA=CUREAG
+66 DO ^DIK
+67 ;
+68 WRITE !!,"Current EAG Deleted",!
+69 DO PRESSKEY^BLRGMENU(10)
+70 ;
+71 ; Create NEW EAG
+72 KILL HEADER(2)
+73 SET HEADER(2)="Creating new EAG (Estimated Average Glucose) Delta Check"
+74 DO HEADERDT^BLRGMENU
+75 WRITE !
+76 DO MKDELTA($PIECE(A1CTEST,"^",3),$PIECE(EAGTEST,"^",3),"Interactively Created.")
+77 ;
+78 DO PRESSKEY^BLRGMENU(10)
+79 QUIT
+80 ;
GETF60(MSG,F60TEST,QFLAG) ; EP
+1 NEW DATANAME,TESTDESC,TESTIEN
+2 ;
+3 SET DATANAME=0
+4 FOR
IF DATANAME>1!(QFLAG)
QUIT
Begin DoDot:1
+5 DO HEADERDT^BLRGMENU
+6 DO ^XBFMK
+7 SET DIR(0)="P^60"
+8 SET DIR("A")=MSG
+9 DO ^DIR
+10 IF +$GET(DIRUT)>0!(+$GET(Y)<1)
Begin DoDot:2
+11 SET QFLAG=1
+12 WRITE !,?5,"Exit Selected. Routine ends.",!
+13 DO PRESSKEY^BLRGMENU(10)
End DoDot:2
QUIT
+14 ;
+15 SET TESTIEN=+$PIECE($GET(Y),"^")
+16 SET TESTDESC=$PIECE($GET(Y),"^",2)
+17 SET DATANAME=+$GET(^LAB(60,+$GET(Y),.2))
+18 IF DATANAME<1
Begin DoDot:2
+19 WRITE !,?5,"Test ",TESTDESC," does NOT have a LOCATION (DATA NAME).",!!
+20 DO ^XBFMK
+21 SET DIR(0)="Y"
+22 SET DIR("A")="Try Again."
+23 DO ^DIR
+24 IF +$GET(Y)<1
Begin DoDot:3
+25 SET QFLAG=1
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 IF QFLAG
QUIT "Q"
+28 ;
+29 SET F60TEST=$GET(Y)_"^"_$PIECE($GET(^DD(63.04,DATANAME,0)),"^")
+30 IF 'QFLAG
Begin DoDot:1
+31 SET WOTNAME=$$TRIM^XLFSTR($PIECE($PIECE(MSG,"Enter",2),"Name"))
+32 WRITE !!,?5,TESTDESC," (",TESTIEN,") selected as ",WOTNAME,".",!!
+33 DO PRESSKEY^BLRGMENU(10)
End DoDot:1
+34 ;
+35 QUIT $SELECT(QFLAG:"Q",1:"OK")
+36 ;
DLTAWARN ; EP -- Warning verbiage
+1 ;;1234567890123456789012345678901234567890123456789012345678901234567890
+2 ;;
+3 ;; This routine will allow a user to specify two tests from
+4 ;; the Laboratory Test File (# 60) that will be used to create a
+5 ;; new Estimated Average Glucose (EAG) Delta Check in the Delta
+6 ;; Check File (# 62.1).
+7 ;;
+8 ;; Please note that this will **DELETE** the original EAG
+9 ;; Delta check that was created during the post-install phase of
+10 ;; IHS Lab Patch 1027.
+11 ;;
+12 ;;$$END
