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