LRWU9A ;HPS/DSK - TOOL TO DETECT, FIX, AND REPORT BAD DATA NAMES ;Apr 11, 2019@16:00
;;5.2;LAB SERVICE;**519,543,549,554**;Sep 27, 1994;Build 13
;
;Reference to ^DD(63.04 supported by DBIA #7053
;Reference to ^ORD(101.43 supported by DBIA #2843
;
Q
;
B6304 ;check "B" cross reference
;
;LRNUM = Current MailMessage line number
;
N LRA,LRB,LRMISNM,LRCOUNT
S (LRA,LRB)="",LRMISNM=0
F S LRA=$O(^DD(63.04,"B",LRA)) Q:LRA="" D
. S LRCOUNT=0
. F S LRB=$O(^DD(63.04,"B",LRA,LRB)) Q:LRB="" D
. . S LRCOUNT=LRCOUNT+1
. . I LRCOUNT>1 M ^TMP("LR63.04B",$J,LRA)=^DD(63.04,"B",LRA)
;
;Check whether issues were found. If so, add to MailMan ^TMP from LRWU9
I $D(^TMP("LR63.04B",$J)) D BMAIL
Q
;
BMAIL ;Generate MailMan message for "B" cross ref issues
N LRSPACE,LRDASH,LRSTR,LRHIT,LRA,LRB
S LRSPACE=" "
S LRDASH="------------------------------------------------------------"
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)=" "
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)="**** The following issue(s) were found in ^DD(63.04. ****"
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)="Please submit a ServiceNow ticket with the assignment group"
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)="of NTL SUP CLIN2 for assistance with correcting the issue(s)."
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)=" "
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)="NOTE: Names such as ""not in use"", etc. which do not appear to"
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)=" pertain to active tests do not warrant correction."
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)=" "
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)="Name(s) With Multiple IENs"
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)="Name IEN"
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)=LRDASH
S (LRA,LRB)=""
F S LRA=$O(^TMP("LR63.04B",$J,LRA)) Q:LRA="" D
. S LRB=$O(^TMP("LR63.04B",$J,LRA,"")) D
. . S LRNUM=LRNUM+1
. . S ^TMP("LR",$J,"DD63.04",LRNUM)=$E(LRA,1,23)_$E(LRSPACE,1,25-$L(LRA))_LRB
. F S LRB=$O(^TMP("LR63.04B",$J,LRA,LRB)) Q:LRB="" D
. . S LRNUM=LRNUM+1
. . S ^TMP("LR",$J,"DD63.04",LRNUM)=$E(LRSPACE,1,25)_LRB
. ;
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)=" "
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)="**** End of issue(s) found in ^DD(63.04 ****"
S LRNUM=LRNUM+1
S ^TMP("LR",$J,"DD63.04",LRNUM)=" "
Q
;
LRNIGHT ;
;LR*5.2*543: Check for OI's pointing to non-existent Lab tests.
; Entries which do not have names beginning with "ZZ" and/or
; inactive dates are captured.
N LRSPACE,LRNAME,LROI,LRTST,LRSEQ,LRNAMX
K ^TMP("LR OI CHECK")
S LRSPACE=" "
S (LRNAME,LROI)="",LRSEQ=11
F S LRNAME=$O(^ORD(101.43,"S.LAB",LRNAME)) Q:LRNAME="" D
. F S LROI=$O(^ORD(101.43,"S.LAB",LRNAME,LROI)) Q:LROI="" D
. . ;Do not list if name starts with ZZ and inactive date is populated
. . I $E(LRNAME,1,2)="ZZ",$P($G(^ORD(101.43,LROI,.1)),"^")]"" Q
. . S LRTST=$P($P($G(^ORD(101.43,LROI,0)),"^",2),";99LRT")
. . I LRTST]"",'$D(^LAB(60,LRTST,0)) D
. . . S LRSEQ=LRSEQ+1
. . . S LRNAMX=$E(LRNAME,1,30)
. . . S ^TMP("LR OI CHECK",LRSEQ)=LRNAMX_" (#"_LROI_")"_$E(LRSPACE,1,37-($L(LRNAMX)+$L(LROI)))_LRTST
I $O(^TMP("LR OI CHECK",11)) D XTMP,MAIL
K ^TMP("LR OI CHECK")
;
;LR*5.2*549 Add check for invalid values in ORGANISM data
D LRORG
Q
;
XTMP ;Generate MailMan message
S ^TMP("LR OI CHECK",1)=" "
S ^TMP("LR OI CHECK",2)="The NIGHTLY CLEANUP task found "_(LRSEQ-11)_" entries in the ORDERABLE ITEMS (#101.43)"
S ^TMP("LR OI CHECK",3)="file of concern that reference non-existent Laboratory tests. Listed below"
S ^TMP("LR OI CHECK",4)="are such entries which have a name not prefixed with ""ZZ"" and/or no date in"
S ^TMP("LR OI CHECK",5)="the INACTIVATED (#.1) field."
S ^TMP("LR OI CHECK",6)=" "
S ^TMP("LR OI CHECK",7)="The following should be edited in the ORDERABLE ITEMS (#101.43) file so the"
S ^TMP("LR OI CHECK",8)="name is prefixed with ""ZZ"" and a date entered into the INACTIVATED (#.1) field."
S ^TMP("LR OI CHECK",9)=" "
S ^TMP("LR OI CHECK",10)="Orderable Item/IEN Non-Existent Laboratory Test IEN"
S ^TMP("LR OI CHECK",11)="-------------------------- --------------------------------"
Q
;
MAIL ;
N LRMIN,LRMY,LRMSUB,LRMTEXT
S LRMIN("FROM")="NIGHTLY TASK CLEANUP"
S LRMY("G.LMI")=""
S LRMY("G.OR CACS")=""
S LRMSUB="ORDERABLE ITEMS POINTING TO NON-EXISTENT LAB TESTS"
S LRMTEXT="^TMP(""LR OI CHECK"")"
D SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
Q
;
LRORG ;
; LR*5.2*549 Check for missing Organism zero node or null organism pointer
N LRDFN,LRDTM,LRSEQ,LRSQ,LRDATA
K ^TMP("LR ORG CHECK")
S LRSPACE=" "
S LRDFN=0,LRSEQ=7
F S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN D
. S LRDTM=0 F S LRDTM=$O(^LR(LRDFN,"MI",LRDTM)) Q:'LRDTM D
. . S LRSQ=0 F S LRSQ=$O(^LR(LRDFN,"MI",LRDTM,3,LRSQ)) Q:'LRSQ D
. . . I $P($G(^LR(LRDFN,"MI",LRDTM,3,LRSQ,0)),U)'="" Q
. . . S LRDATA=$G(^LR(LRDFN,"MI",LRDTM,0))
. . . S LRDATA="^LR("_LRDFN_","_"""MI"""_","_LRDTM_",0)="_LRDATA
. . . S LRSEQ=LRSEQ+1,^TMP("LR ORG CHECK",LRSEQ)=LRDATA
. . . S LRSEQ=LRSEQ+1,^TMP("LR ORG CHECK",LRSEQ)=" "
I $O(^TMP("LR ORG CHECK",6)) D XTMPORG,MAILORG
K ^TMP("LR ORG CHECK")
Q
;
XTMPORG ;Generate MailMan message
S ^TMP("LR ORG CHECK",1)=" "
S ^TMP("LR ORG CHECK",2)="The following entries in the LAB DATA file (#63) have corrupted organism"
S ^TMP("LR ORG CHECK",3)="nodes and require repair. Please enter a YourIT ticket requesting regional"
S ^TMP("LR ORG CHECK",4)="support for the Laboratory package."
S ^TMP("LR ORG CHECK",5)="----------------------------------------------------------------------------"
S ^TMP("LR ORG CHECK",6)=" "
Q
;
MAILORG ;
N LRMIN,LRMY,LRMSUB,LRMTEXT
S LRMIN("FROM")="ORGANISM NIGHTLY TASK REVIEW"
S LRMY("G.LMI")=""
S LRMSUB="CORRUPT ORGANISM DATA REPORT"
S LRMTEXT="^TMP(""LR ORG CHECK"")"
D SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
Q
;
LRHOWDY ;
;LR*5.2*554 Purge 69.87 records older than 9 years old
N LRPDT,LRSTDT,LRDA,DA,DIK,LRUID
;SET PURGE DATE TO 9 YEARS AGO
S LRPDT=DT-90000,LRUID=""
F S LRUID=$O(^LRHY(69.87,"B",LRUID)) Q:LRUID="" D
. ;Loop thru just in case there could ever have been multiple records for a UID
. S LRDA=0 F S LRDA=$O(^LRHY(69.87,"B",LRUID,LRDA)) Q:'LRDA D
. . S LRSTDT=$P($G(^LRHY(69.87,LRDA,2)),".") ;INITIAL SCAN TIME
. . I 'LRSTDT S LRSTDT=$P($G(^LRHY(69.87,LRDA,8)),".") ;COLLECTION TIME
. . I 'LRSTDT S LRSTDT=$P($G(^LRHY(69.87,LRDA,4)),".") ;TIME LABEL PRINTED
. . I LRSTDT'<LRPDT Q
. . S DIK="^LRHY(69.87,",DA=LRDA D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWU9A 6872 printed Apr 09, 2024@21:11:08 Page 2
LRWU9A ;HPS/DSK - TOOL TO DETECT, FIX, AND REPORT BAD DATA NAMES ;Apr 11, 2019@16:00
+1 ;;5.2;LAB SERVICE;**519,543,549,554**;Sep 27, 1994;Build 13
+2 ;
+3 ;Reference to ^DD(63.04 supported by DBIA #7053
+4 ;Reference to ^ORD(101.43 supported by DBIA #2843
+5 ;
+6 QUIT
+7 ;
B6304 ;check "B" cross reference
+1 ;
+2 ;LRNUM = Current MailMessage line number
+3 ;
+4 NEW LRA,LRB,LRMISNM,LRCOUNT
+5 SET (LRA,LRB)=""
SET LRMISNM=0
+6 FOR
SET LRA=$ORDER(^DD(63.04,"B",LRA))
if LRA=""
QUIT
Begin DoDot:1
+7 SET LRCOUNT=0
+8 FOR
SET LRB=$ORDER(^DD(63.04,"B",LRA,LRB))
if LRB=""
QUIT
Begin DoDot:2
+9 SET LRCOUNT=LRCOUNT+1
+10 IF LRCOUNT>1
MERGE ^TMP("LR63.04B",$JOB,LRA)=^DD(63.04,"B",LRA)
End DoDot:2
End DoDot:1
+11 ;
+12 ;Check whether issues were found. If so, add to MailMan ^TMP from LRWU9
+13 IF $DATA(^TMP("LR63.04B",$JOB))
DO BMAIL
+14 QUIT
+15 ;
BMAIL ;Generate MailMan message for "B" cross ref issues
+1 NEW LRSPACE,LRDASH,LRSTR,LRHIT,LRA,LRB
+2 SET LRSPACE=" "
+3 SET LRDASH="------------------------------------------------------------"
+4 SET LRNUM=LRNUM+1
+5 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=" "
+6 SET LRNUM=LRNUM+1
+7 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)="**** The following issue(s) were found in ^DD(63.04. ****"
+8 SET LRNUM=LRNUM+1
+9 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)="Please submit a ServiceNow ticket with the assignment group"
+10 SET LRNUM=LRNUM+1
+11 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)="of NTL SUP CLIN2 for assistance with correcting the issue(s)."
+12 SET LRNUM=LRNUM+1
+13 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=" "
+14 SET LRNUM=LRNUM+1
+15 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)="NOTE: Names such as ""not in use"", etc. which do not appear to"
+16 SET LRNUM=LRNUM+1
+17 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=" pertain to active tests do not warrant correction."
+18 SET LRNUM=LRNUM+1
+19 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=" "
+20 SET LRNUM=LRNUM+1
+21 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)="Name(s) With Multiple IENs"
+22 SET LRNUM=LRNUM+1
+23 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)="Name IEN"
+24 SET LRNUM=LRNUM+1
+25 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=LRDASH
+26 SET (LRA,LRB)=""
+27 FOR
SET LRA=$ORDER(^TMP("LR63.04B",$JOB,LRA))
if LRA=""
QUIT
Begin DoDot:1
+28 SET LRB=$ORDER(^TMP("LR63.04B",$JOB,LRA,""))
Begin DoDot:2
+29 SET LRNUM=LRNUM+1
+30 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=$EXTRACT(LRA,1,23)_$EXTRACT(LRSPACE,1,25-$LENGTH(LRA))_LRB
End DoDot:2
+31 FOR
SET LRB=$ORDER(^TMP("LR63.04B",$JOB,LRA,LRB))
if LRB=""
QUIT
Begin DoDot:2
+32 SET LRNUM=LRNUM+1
+33 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=$EXTRACT(LRSPACE,1,25)_LRB
End DoDot:2
+34 ;
End DoDot:1
+35 SET LRNUM=LRNUM+1
+36 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=" "
+37 SET LRNUM=LRNUM+1
+38 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)="**** End of issue(s) found in ^DD(63.04 ****"
+39 SET LRNUM=LRNUM+1
+40 SET ^TMP("LR",$JOB,"DD63.04",LRNUM)=" "
+41 QUIT
+42 ;
LRNIGHT ;
+1 ;LR*5.2*543: Check for OI's pointing to non-existent Lab tests.
+2 ; Entries which do not have names beginning with "ZZ" and/or
+3 ; inactive dates are captured.
+4 NEW LRSPACE,LRNAME,LROI,LRTST,LRSEQ,LRNAMX
+5 KILL ^TMP("LR OI CHECK")
+6 SET LRSPACE=" "
+7 SET (LRNAME,LROI)=""
SET LRSEQ=11
+8 FOR
SET LRNAME=$ORDER(^ORD(101.43,"S.LAB",LRNAME))
if LRNAME=""
QUIT
Begin DoDot:1
+9 FOR
SET LROI=$ORDER(^ORD(101.43,"S.LAB",LRNAME,LROI))
if LROI=""
QUIT
Begin DoDot:2
+10 ;Do not list if name starts with ZZ and inactive date is populated
+11 IF $EXTRACT(LRNAME,1,2)="ZZ"
IF $PIECE($GET(^ORD(101.43,LROI,.1)),"^")]""
QUIT
+12 SET LRTST=$PIECE($PIECE($GET(^ORD(101.43,LROI,0)),"^",2),";99LRT")
+13 IF LRTST]""
IF '$DATA(^LAB(60,LRTST,0))
Begin DoDot:3
+14 SET LRSEQ=LRSEQ+1
+15 SET LRNAMX=$EXTRACT(LRNAME,1,30)
+16 SET ^TMP("LR OI CHECK",LRSEQ)=LRNAMX_" (#"_LROI_")"_$EXTRACT(LRSPACE,1,37-($LENGTH(LRNAMX)+$LENGTH(LROI)))_LRTST
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF $ORDER(^TMP("LR OI CHECK",11))
DO XTMP
DO MAIL
+18 KILL ^TMP("LR OI CHECK")
+19 ;
+20 ;LR*5.2*549 Add check for invalid values in ORGANISM data
+21 DO LRORG
+22 QUIT
+23 ;
XTMP ;Generate MailMan message
+1 SET ^TMP("LR OI CHECK",1)=" "
+2 SET ^TMP("LR OI CHECK",2)="The NIGHTLY CLEANUP task found "_(LRSEQ-11)_" entries in the ORDERABLE ITEMS (#101.43)"
+3 SET ^TMP("LR OI CHECK",3)="file of concern that reference non-existent Laboratory tests. Listed below"
+4 SET ^TMP("LR OI CHECK",4)="are such entries which have a name not prefixed with ""ZZ"" and/or no date in"
+5 SET ^TMP("LR OI CHECK",5)="the INACTIVATED (#.1) field."
+6 SET ^TMP("LR OI CHECK",6)=" "
+7 SET ^TMP("LR OI CHECK",7)="The following should be edited in the ORDERABLE ITEMS (#101.43) file so the"
+8 SET ^TMP("LR OI CHECK",8)="name is prefixed with ""ZZ"" and a date entered into the INACTIVATED (#.1) field."
+9 SET ^TMP("LR OI CHECK",9)=" "
+10 SET ^TMP("LR OI CHECK",10)="Orderable Item/IEN Non-Existent Laboratory Test IEN"
+11 SET ^TMP("LR OI CHECK",11)="-------------------------- --------------------------------"
+12 QUIT
+13 ;
MAIL ;
+1 NEW LRMIN,LRMY,LRMSUB,LRMTEXT
+2 SET LRMIN("FROM")="NIGHTLY TASK CLEANUP"
+3 SET LRMY("G.LMI")=""
+4 SET LRMY("G.OR CACS")=""
+5 SET LRMSUB="ORDERABLE ITEMS POINTING TO NON-EXISTENT LAB TESTS"
+6 SET LRMTEXT="^TMP(""LR OI CHECK"")"
+7 DO SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
+8 QUIT
+9 ;
LRORG ;
+1 ; LR*5.2*549 Check for missing Organism zero node or null organism pointer
+2 NEW LRDFN,LRDTM,LRSEQ,LRSQ,LRDATA
+3 KILL ^TMP("LR ORG CHECK")
+4 SET LRSPACE=" "
+5 SET LRDFN=0
SET LRSEQ=7
+6 FOR
SET LRDFN=$ORDER(^LR(LRDFN))
if 'LRDFN
QUIT
Begin DoDot:1
+7 SET LRDTM=0
FOR
SET LRDTM=$ORDER(^LR(LRDFN,"MI",LRDTM))
if 'LRDTM
QUIT
Begin DoDot:2
+8 SET LRSQ=0
FOR
SET LRSQ=$ORDER(^LR(LRDFN,"MI",LRDTM,3,LRSQ))
if 'LRSQ
QUIT
Begin DoDot:3
+9 IF $PIECE($GET(^LR(LRDFN,"MI",LRDTM,3,LRSQ,0)),U)'=""
QUIT
+10 SET LRDATA=$GET(^LR(LRDFN,"MI",LRDTM,0))
+11 SET LRDATA="^LR("_LRDFN_","_"""MI"""_","_LRDTM_",0)="_LRDATA
+12 SET LRSEQ=LRSEQ+1
SET ^TMP("LR ORG CHECK",LRSEQ)=LRDATA
+13 SET LRSEQ=LRSEQ+1
SET ^TMP("LR ORG CHECK",LRSEQ)=" "
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF $ORDER(^TMP("LR ORG CHECK",6))
DO XTMPORG
DO MAILORG
+15 KILL ^TMP("LR ORG CHECK")
+16 QUIT
+17 ;
XTMPORG ;Generate MailMan message
+1 SET ^TMP("LR ORG CHECK",1)=" "
+2 SET ^TMP("LR ORG CHECK",2)="The following entries in the LAB DATA file (#63) have corrupted organism"
+3 SET ^TMP("LR ORG CHECK",3)="nodes and require repair. Please enter a YourIT ticket requesting regional"
+4 SET ^TMP("LR ORG CHECK",4)="support for the Laboratory package."
+5 SET ^TMP("LR ORG CHECK",5)="----------------------------------------------------------------------------"
+6 SET ^TMP("LR ORG CHECK",6)=" "
+7 QUIT
+8 ;
MAILORG ;
+1 NEW LRMIN,LRMY,LRMSUB,LRMTEXT
+2 SET LRMIN("FROM")="ORGANISM NIGHTLY TASK REVIEW"
+3 SET LRMY("G.LMI")=""
+4 SET LRMSUB="CORRUPT ORGANISM DATA REPORT"
+5 SET LRMTEXT="^TMP(""LR ORG CHECK"")"
+6 DO SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
+7 QUIT
+8 ;
LRHOWDY ;
+1 ;LR*5.2*554 Purge 69.87 records older than 9 years old
+2 NEW LRPDT,LRSTDT,LRDA,DA,DIK,LRUID
+3 ;SET PURGE DATE TO 9 YEARS AGO
+4 SET LRPDT=DT-90000
SET LRUID=""
+5 FOR
SET LRUID=$ORDER(^LRHY(69.87,"B",LRUID))
if LRUID=""
QUIT
Begin DoDot:1
+6 ;Loop thru just in case there could ever have been multiple records for a UID
+7 SET LRDA=0
FOR
SET LRDA=$ORDER(^LRHY(69.87,"B",LRUID,LRDA))
if 'LRDA
QUIT
Begin DoDot:2
+8 ;INITIAL SCAN TIME
SET LRSTDT=$PIECE($GET(^LRHY(69.87,LRDA,2)),".")
+9 ;COLLECTION TIME
IF 'LRSTDT
SET LRSTDT=$PIECE($GET(^LRHY(69.87,LRDA,8)),".")
+10 ;TIME LABEL PRINTED
IF 'LRSTDT
SET LRSTDT=$PIECE($GET(^LRHY(69.87,LRDA,4)),".")
+11 IF LRSTDT'<LRPDT
QUIT
+12 SET DIK="^LRHY(69.87,"
SET DA=LRDA
DO ^DIK
End DoDot:2
End DoDot:1
+13 QUIT
