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

LRWU9.m

Go to the documentation of this file.
  1. LRWU9 ;DALOI/CKA - TOOL TO DETECT, FIX, AND REPORT BAD DATA NAMES ; 15 Apr 2019 2:27 PM
  1. ;;5.2;LAB SERVICE;**350,427,519**;Sep 27, 1994;Build 16
  1. ;
  1. ;Reference to ^PXRMINDX supported by ICR# 4290
  1. ;Reference to ^DD(63.04 supported by DBIA #7053
  1. ;
  1. EN ; Interactive entry point.
  1. ;
  1. D DT^DICRW
  1. N INSTALL,LRFIX,LRNUM,LRSITE,LRSPACE,LRSUPFLG,XMDUZ,XMY
  1. ;
  1. D INIT
  1. S LRFIX=$$ASK(),XMY(DUZ)="",XMDUZ=DUZ,INSTALL=0
  1. S $P(LRSPACE," ",80)=""
  1. I 'LRFIX Q
  1. S LRFIX=LRFIX-1
  1. D DES^XMA21 ; call to get the email recipients list.
  1. D PREP^XGF ; setup screen
  1. D CHKDD
  1. D CHK63
  1. D SENDMM,CLEAN^XGF
  1. K ^TMP("LR",$J)
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. KIDS ; Entry point for post install run.
  1. ;
  1. N INSTALL,LRFIX,LRNUM,LRSITE,LRSUPFLG,XMY
  1. ;
  1. I $G(^XMB("NETNAME"))["DOMAIN.EXT",$$PROD^XUPROD() S XMY("G.LAB DEV IRMFO@DOMAIN.EXT")="",XMY("G.CSCLIN4@DOMAIN.EXT")=""
  1. S XMY(DUZ)="",XMY("G.LMI")="",INSTALL=1
  1. D INIT
  1. ;S LRFIX=1 ; [ccr-8167] - LRFIX is set to 0 in INIT subroutine.
  1. D CHKDD,CHK63,SENDMM
  1. ;
  1. K ^TMP("LR",$J)
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. LRNIGHT ; Entry point for ^LRNIGHT run.
  1. ;
  1. N INSTALL,LRFIX,LRNUM,LRSITE,LRSUPFLG,XMY
  1. ;
  1. S INSTALL=1
  1. D INIT,CHKDD,CHK63
  1. S (XMY(DUZ),XMY("G.LMI"))=""
  1. I $G(^XMB("NETNAME"))["DOMAIN.EXT",$$PROD^XUPROD() S XMY("G.LAB DEV IRMFO@DOMAIN.EXT")="",XMY("G.CSCLIN4@DOMAIN.EXT")=""
  1. I $O(^TMP("LR",$J,"DD63.04",5))]"" D SENDMM
  1. ;
  1. K ^TMP("LR",$J),^TMP("DD63.04B",$J)
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. INIT ; Initialize variables.
  1. ;
  1. K ^TMP("LR",$J)
  1. D DT^DICRW
  1. S LRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1. S LRFIX=0
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. CHKDD ; CHECK DD FOR BAD DATA NAMES.
  1. ;First check for DDs with the same subscript
  1. N CNT,DA,DIK,LR60CNT,LR60IEN,LRLOC,LRDATA,LRD0,LRPC,LRSUB,LRX,LRDD,LRDDA,LRNOTEST,LRNOFIX,LRSUBCNT
  1. K ^TMP("LR",$J),^TMP("LR63.04B",$J)
  1. S LRNUM=1
  1. ;
  1. S ^TMP("LR",$J,"DD63.04",LRNUM)=$$NAME^XUAF4($$KSP^XUPARAM("INST"))_" ("_$$KSP^XUPARAM("WHERE")_") "_$$FMTE^XLFDT(DT)
  1. S LRNUM=LRNUM+1
  1. S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. ;
  1. S LRD0=1,LRDD=0,LRDDA=0
  1. F CNT=0:1 S LRD0=$O(^DD(63.04,LRD0)) Q:LRD0="" D:$D(^DD(63.04,LRD0,0))
  1. . S LRDATA=$G(^DD(63.04,LRD0,0)) Q:LRDATA=""
  1. . S LRSUB=$P($P(LRDATA,U,4),";")
  1. . S LRPC=$P($P(LRDATA,U,4),";",2)
  1. . S LR60IEN="",LR60CNT=0
  1. . S LRX=0 F S LRX=$O(^LAB(60,"C","CH;"_LRSUB_";"_LRPC,LRX)) Q:'LRX D
  1. . . I $P($G(^LAB(60,LRX,.2)),U,1)=LRD0 D
  1. . . . S LR60IEN=LRX
  1. . . . S ^TMP("LR",$J,"SORT","LD",LRD0,LR60IEN)=""
  1. . . . S LR60CNT=LR60CNT+1
  1. . S LRSUBCNT=$G(^TMP("LR",$J,"SORT",1,LRSUB))+1
  1. . S ^TMP("LR",$J,"SORT",1,LRSUB)=LRSUBCNT
  1. . S ^TMP("LR",$J,"SORT",1,LRSUB,LRD0)=$P(LRDATA,U,1)_U_$P(LRDATA,U,4)_U_LR60IEN
  1. . I 'LR60IEN S ^TMP("LR",$J,"SORT","L",LRSUB,LRD0)=LRSUB ; L subscript used when Data name is not linked to a test
  1. . I LRPC'=1!(LRSUB'=LRD0) S ^TMP("LR",$J,"SORT","C",LRD0)=LRSUB ; C subscript used when Data name has wrong subscript location
  1. . I LRSUBCNT>1 S ^TMP("LR",$J,"SORT","D",LRSUB)="" ; D subscript used when more than one Data name has the same subscript
  1. . I LR60CNT=1 K ^TMP("LR",$J,"SORT","LD",LRD0) ; LD subscript used when there are multiple tests linked to a data name
  1. ;
  1. ; Report issues with duplicate subscript locations
  1. S LRSUB="" F S LRSUB=$O(^TMP("LR",$J,"SORT","D",LRSUB)) Q:LRSUB="" D
  1. . S LRSUPFLG=1
  1. . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. . S ^TMP("LR",$J,"DD63.04",LRNUM)="*WARNING* THE FOLLOWING DATA NAMES ARE ASSIGNED THE SAME SUBSCRIPT #"_LRSUB,LRNUM=LRNUM+1
  1. . S LRD0=0 F S LRD0=$O(^TMP("LR",$J,"SORT",1,LRSUB,LRD0)) Q:LRD0="" D
  1. . . S LRDATA=$G(^TMP("LR",$J,"SORT",1,LRSUB,LRD0))
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" - Data Name '"_$P(LRDATA,U,1)_"' (#"_LRD0_") is assigned location: "_$P(LRDATA,U,2),LRNUM=LRNUM+1
  1. . . I $P(LRDATA,U,3) D
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" (This Data Name is linked to Lab test #"_$P(LRDATA,U,3)_" "_$P(^LAB(60,$P(LRDATA,U,3),0),U)_")",LRNUM=LRNUM+1
  1. . . I '$P(LRDATA,U,3) D
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" (This Data Name is not linked to a Lab test)",LRNUM=LRNUM+1
  1. ;
  1. ; Report issues with multiple tests with the same data name
  1. S LRD0=0 F S LRD0=$O(^TMP("LR",$J,"SORT","LD",LRD0)) Q:'LRD0 D
  1. . S LRSUPFLG=1
  1. . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. . S ^TMP("LR",$J,"DD63.04",LRNUM)="*WARNING* THE DATA NAME '"_$P(^DD(63.04,LRD0,0),U)_"' (#"_LRD0_") IS LINKED TO MORE THAN ONE LAB TEST:",LRNUM=LRNUM+1
  1. . N LRCNT
  1. . S LR60IEN=0 F S LR60IEN=$O(^TMP("LR",$J,"SORT","LD",LRD0,LR60IEN)) Q:'LR60IEN D
  1. . . S LRCNT=$G(LRCNT)+1
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" "_LRCNT_". "_$P($G(^LAB(60,LR60IEN,0)),U,1)_" (#"_LR60IEN_")"
  1. . . S LRNUM=LRNUM+1
  1. ;
  1. ;Check - SUBSCRIPT'=FIELD #
  1. ; NOT IN FIRST PIECE
  1. ; OR BOTH
  1. ;
  1. ;
  1. I 'INSTALL D SAY^XGF(24,1,LRSPACE),SAY^XGF(24,1,"LRD0=")
  1. S LRD0=1
  1. F CNT=0:1 S LRD0=$O(^TMP("LR",$J,"SORT","C",LRD0)) Q:LRD0="" D
  1. . S LRDATA=$G(^DD(63.04,LRD0,0)) Q:LRDATA=""
  1. . S LRSUB=$P($P(LRDATA,U,4),";")
  1. . S LRPC=$P($P(LRDATA,U,4),";",2)
  1. . I $D(^TMP("LR",$J,"SORT","D",LRSUB)) Q
  1. . S LR60IEN=$P($G(^TMP("LR",$J,"SORT",1,LRSUB,LRD0)),U,3)
  1. . I 'INSTALL,'(CNT#100) D SAY^XGF(24,1,"LRD0="_LRD0)
  1. . I LRPC'=1!(LRSUB'=LRD0) D
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data Name Location "_$P(^DD(63.04,LRD0,0),U)_" CH;"_LRSUB_";"_LRPC_" should be CH;"_LRD0_";1"
  1. . . I LRFIX,LR60IEN,'$D(^TMP("LR",$J,"SORT","LD",LRD0)) D FIXDD D
  1. . . . S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***FIXED***"
  1. . . I LRFIX,('LR60IEN!($D(^TMP("LR",$J,"SORT","LD",LRD0)))) D
  1. . . . S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***NOT FIXED***"
  1. . . . S LRSUPFLG=1
  1. . . S LRNUM=LRNUM+1
  1. . . I LR60IEN,$G(^TMP("LR",$J,"DDFIXED",LRSUB)) D
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Lab test # "_LR60IEN_" "_$P(^LAB(60,LR60IEN,0),U)_" DATA NAME (LOCATION) SUBSCRIPT **** FIXED ****"
  1. . . . S LRNUM=LRNUM+1
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" OLD SUBSCRIPT="_LRSUB_" NEW SUBSCRIPT="_LRD0
  1. . . . S LRNUM=LRNUM+1
  1. . . I 'LR60IEN D
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data Name is not linked to a File #60 Laboratory Test"
  1. . . . I LRFIX S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***NOT FIXED***",LRSUPFLG=1
  1. . . . S LRNUM=LRNUM+1
  1. . . I $D(^TMP("LR",$J,"SORT","LD",LRD0)) D
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data Name is linked to more than one File #60 Laboratory Test"
  1. . . . I LRFIX S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***NOT FIXED***",LRSUPFLG=1
  1. . . . S LRNUM=LRNUM+1
  1. ;
  1. ;Check "B" cross reference - LR*5.2*519
  1. D B6304^LRWU9A
  1. Q
  1. ;-------------------------------------------------------
  1. CHK63 ;CHECK FILE 63 FOR TEST DATA WITH NO DATA NAME
  1. ;
  1. N CNT,DATANUM,LRDFN,LRIDT,LRD0,LRNUM1,LRNUM2
  1. I 'INSTALL D SAY^XGF(24,1,LRSPACE),SAY^XGF(24,1,"LRDFN=")
  1. S (LRDFN,LRIDT,LRD0)=0
  1. S LRNUM1=1,LRNUM2=1
  1. F CNT=0:1 S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN D
  1. . S LRIDT=0
  1. . F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:'LRIDT D
  1. . . N LRREPAIR
  1. . . S LRD0=1
  1. . . F S LRD0=$O(^LR(LRDFN,"CH",LRIDT,LRD0)) Q:LRD0'>0 D
  1. . . . I $D(LRREPAIR(LRD0)) Q ;Used to prevent issues when two Data Names use each others subscripts
  1. . . . I 'INSTALL,'(CNT#100) D SAY^XGF(24,1,"LRDFN="_LRDFN)
  1. . . . I '$D(^DD(63.04,LRD0,0)),'$D(^TMP("LR",$J,"SORT",1,LRD0)) D
  1. . . . . S ^TMP("LR",$J,"SORT","W",LRD0,LRNUM2)="^LR("_LRDFN_",""CH"","_LRIDT_","_LRD0_")"
  1. . . . . S LRNUM2=LRNUM2+1
  1. . . . ; Check if there are results that belong to a Data Name that is not linked to a test.
  1. . . . S DATANUM=$O(^TMP("LR",$J,"SORT","L",LRD0,0))
  1. . . . I DATANUM,'$D(^TMP("LR",$J,"SORT","D",LRD0)) D
  1. . . . . ;SORT BY DATA NAME
  1. . . . . S ^TMP("LR",$J,"SORT","T",DATANUM,LRNUM1)="^LR("_LRDFN_",""CH"","_LRIDT_","_LRD0_")"
  1. . . . . S LRNUM1=LRNUM1+1
  1. . . . I LRFIX D FIX63
  1. S LRNUM2=0,DATANUM=0
  1. I $D(^TMP("LR",$J,"SORT","W")) D
  1. . F S DATANUM=$O(^TMP("LR",$J,"SORT","W",DATANUM)) Q:DATANUM'>0 D
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Results in subscript '"_DATANUM_"' without a Data Name at: "
  1. . . S LRNUM=LRNUM+1
  1. . . F S LRNUM2=$O(^TMP("LR",$J,"SORT","W",DATANUM,LRNUM2)) Q:LRNUM2'>0 D
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" "_^TMP("LR",$J,"SORT","W",DATANUM,LRNUM2)
  1. . . . S LRNUM=LRNUM+1
  1. . . . S LRSUPFLG=1
  1. S LRNUM1=0,DATANUM=0
  1. I $D(^TMP("LR",$J,"SORT","T")) D
  1. . F S DATANUM=$O(^TMP("LR",$J,"SORT","T",DATANUM)) Q:DATANUM'>0 D
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Results in Data Name "_$P(^DD(63.04,DATANUM,0),U,1)_" without a test in file 60 at: "
  1. . . S LRNUM=LRNUM+1
  1. . . F S LRNUM1=$O(^TMP("LR",$J,"SORT","T",DATANUM,LRNUM1)) Q:LRNUM1'>0 D
  1. . . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" "_^TMP("LR",$J,"SORT","T",DATANUM,LRNUM1)
  1. . . . S LRNUM=LRNUM+1
  1. . . . S LRSUPFLG=1
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. FIXDD ; FIX DD FOR BAD DATA NAMES.
  1. ;
  1. N DDFIELD,LRNAME,LRTYPE
  1. ;
  1. D FIELD^DID(63.04,LRD0,"","LABEL;TYPE","DDFIELD")
  1. S LRNAME=DDFIELD("LABEL")
  1. S LRTYPE=DDFIELD("TYPE")
  1. S DA=LRD0
  1. D DDFIX^LRWU6
  1. I LR60IEN D
  1. . I $P(^LAB(60,LR60IEN,0),U,5)'="CH;"_LRD0_";1"!($P(^LAB(60,LR60IEN,0),U,12)'="DD(63.04,"_LRD0_",")!(^LAB(60,LR60IEN,.2)'=LRD0) D
  1. . . N LRFDA,LRDIE
  1. . . S LRFDA(1,60,LR60IEN_",",400)=LRD0
  1. . . S LRFDA(1,60,LR60IEN_",",5)="CH;"_LRD0_";1"
  1. . . S LRFDA(1,60,LR60IEN_",",13)="DD(63.04,"_LRD0_","
  1. . . D FILE^DIE("","LRFDA(1)","LRDIE(1)")
  1. . . S ^TMP("LR",$J,"DDFIXED",LRSUB)=LRD0_U_LRPC_U_LR60IEN
  1. UPD624 . . N LR624,LR6243
  1. . . S LR624=0 F S LR624=$O(^LAB(62.4,LR624)) Q:'LR624 D
  1. . . . S LR6243=0 F S LR6243=$O(^LAB(62.4,LR624,3,LR6243)) Q:'LR6243 D
  1. . . . .I $P(^LAB(62.4,LR624,3,LR6243,0),U)=LR60IEN D
  1. . . . . . N LRFDA,LRIENS
  1. . . . . . S LRIENS=LR6243_","_LR624_","
  1. . . . . . S LRFDA(62.41,LRIENS,11)="TV("_LRD0_",1)"
  1. . . . . . D FILE^DIE("","LRFDA")
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. FIX63 ;FIX DATA NODES IN FILE 63
  1. ;
  1. Q:$D(^TMP("LR",$J,"SORT","D",LRD0))
  1. Q:'$D(^TMP("LR",$J,"DDFIXED",LRD0))
  1. Q:($P(^TMP("LR",$J,"DDFIXED",LRD0),U,2)'=1)
  1. S LRLOC=$P(^TMP("LR",$J,"DDFIXED",LRD0),U)
  1. I $D(^DD(63.04,LRD0,0))!($D(^TMP("LR",$J,"SORT",1,LRD0))) S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
  1. I $D(^LR(LRDFN,"CH",LRIDT,LRLOC)) D Q
  1. . S ^TMP("LR",$J,"DD63.04",LRNUM)="*ERROR* MOVING OVER ^LR("_LRDFN_",CH,"_LRIDT_","_LRD0_") TO ^LR("_LRDFN_",CH,"_LRIDT_","_LRLOC_")"
  1. . S LRNUM=LRNUM+1
  1. . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data already exists in ^LR("_LRDFN_",CH,"_LRIDT_","_LRLOC_")"
  1. . S LRNUM=LRNUM+1
  1. . S LRSUPFLG=1
  1. D CHKILLPX(LRDFN,LRIDT,LRD0) ;Kill Clinical Reminders Index
  1. S ^LR(LRDFN,"CH",LRIDT,LRLOC)=^LR(LRDFN,"CH",LRIDT,LRD0)
  1. K ^LR(LRDFN,"CH",LRIDT,LRD0)
  1. S LRREPAIR(LRLOC)=""
  1. D CHSET^LRPX(LRDFN,LRIDT) ;Set Clinical Reminders Index
  1. S ^TMP("LR",$J,"DD63.04",LRNUM)="DATA LOCATION FIXED IN LAB DATA FILE ^LR"
  1. S LRNUM=LRNUM+1
  1. S ^TMP("LR",$J,"DD63.04",LRNUM)="^LR("_LRDFN_",CH,"_LRIDT_","_LRD0_") NOW MOVED TO ^LR("_LRDFN_",CH,"_LRIDT_","_LRLOC_")"
  1. S LRNUM=LRNUM+1
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. CHKILLPX(LRDFN,LRIDT,LRD0) ;Kill Clinical Reminders Index
  1. N LR60IEN,DFN,DATE,OK,DAS,LRDBLCHK
  1. S LR60IEN=$P(^TMP("LR",$J,"DDFIXED",LRD0),U,3)
  1. I 'LR60IEN D
  1. . N DATA
  1. . S DATA=^LR(LRDFN,"CH",LRIDT,LRD0)
  1. . S LR60IEN=+$P($P(DATA,U,3),"!",7)
  1. I 'LR60IEN Q
  1. I '$L($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0))) Q
  1. D PATIENT^LRPX(LRDFN,.DFN,.OK) I 'OK Q
  1. S DATE=9999999-LRIDT
  1. S DAS=LRDFN_";CH;"_LRIDT_";"_LRD0
  1. S LRDBLCHK=0
  1. I '$D(^PXRMINDX(63,"PI",DFN,LR60IEN,DATE,DAS)) S LRDBLCHK=1
  1. D KLAB^LRPX(DFN,DATE,LR60IEN,DAS)
  1. ;
  1. I LRDBLCHK D
  1. . N ITEM,FLAG
  1. . S ITEM=0 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:'ITEM!($D(FLAG)) D
  1. . . I $D(^PXRMINDX(63,"PI",DFN,ITEM,DATE,DAS)) D
  1. . . . D KLAB^LRPX(DFN,DATE,ITEM,DAS)
  1. . . . S FLAG=1
  1. Q
  1. ;-------------------------------------------------------
  1. SENDMM ;SEND MAIL MESSAGE OF ERRORS FOUND AND/OR FIXED.
  1. ;
  1. N XMSUB,DIFROM,XMINSTR
  1. ;
  1. S LRNUM=3
  1. I $O(^TMP("LR",$J,"DD63.04",5)) D ;Errors were found
  1. . ;
  1. . I 'LRFIX!(LRFIX&($G(LRSUPFLG))) D ;not all errors were auto-repaired
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Contact the National Service Desk to request assistance from the Clin 4",LRNUM=LRNUM+1
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Product Support team in resolving the following errors identified in the",LRNUM=LRNUM+1
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="VistA Laboratory package:",LRNUM=LRNUM+1
  1. . ;
  1. . I LRFIX,'$G(LRSUPFLG) D ;all errors were auto-repaired
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="The LAB DATA file (#63) cleanup process has found and repaired the",LRNUM=LRNUM+1
  1. . . S ^TMP("LR",$J,"DD63.04",LRNUM)="following errors:",LRNUM=LRNUM+1
  1. ;
  1. I '$O(^TMP("LR",$J,"DD63.04",5)) D ;No errors were found
  1. . S ^TMP("LR",$J,"DD63.04",LRNUM)=""
  1. . S ^TMP("LR",$J,"DD63.04",(LRNUM+1))="*** NO ERRORS FOUND ***"
  1. ;
  1. S XMSUB="DATA DICTIONARY ^DD(63.04 CHECK REPORT "
  1. S XMSUB=XMSUB_$$FMTE^XLFDT($$NOW^XLFDT,"1S")
  1. S XMINSTR("ADDR FLAGS")="R"
  1. D SENDMSG^XMXAPI(DUZ,XMSUB,"^TMP(""LR"",$J,""DD63.04"")",.XMY,.XMINSTR)
  1. ;
  1. Q
  1. ;-------------------------------------------------------
  1. ASK() ; Run analyze/repair query
  1. ;
  1. N Y,DIR,DIRUT,DTOUT,DUOUT,FIX
  1. ;
  1. S FIX=0
  1. ;
  1. W !,"This process will check the CHEM, HEM, TOX, RIA, SER, etc."
  1. W !,"Sub-file (#63.04) of the LAB DATA file (#63) looking for"
  1. W !,"possible discrepancies in the Data Dictionary. Once the"
  1. W !,"process has completed, a MailMan message will be sent to the"
  1. W !,"user that started this process and any other user selected."
  1. W !!
  1. W !,"The two modes in which this process can be run are ANALYZE"
  1. W !,"and REPAIR. If the ANALYZE option is chosen, the process will"
  1. W !,"only look for discrepancies and report the findings via a"
  1. W !,"MailMan message. If the ANALYZE,REPAIR option is chosen the"
  1. W !,"process will ANALYZE and REPAIR any discrepancies found that"
  1. W !,"can be fixed programmatically and list all those that could"
  1. W !,"not be fixed but need attention."
  1. W !!
  1. ;
  1. S DIR("A")="Do you want to continue with this process",DIR("B")="NO"
  1. S DIR(0)="Y"
  1. D ^DIR
  1. I 'Y Q FIX
  1. ;
  1. K DIR,Y
  1. ;
  1. S DIR(0)="NAO^1:3",DIR("B")=3
  1. S DIR("A",1)="Select the action you wish to take:"
  1. S DIR("A",2)=""
  1. S DIR("A",3)="1. Analyze and Report."
  1. S DIR("A",4)="2. Analyze, Repair, and Report."
  1. S DIR("A",5)="3. Quit - No Action."
  1. S DIR("A",6)=""
  1. S DIR("A")="Enter a number 1 thru 3: "
  1. S DIR("?")="Select a number 1 thru 3 or press <Return> to exit"
  1. ;
  1. D ^DIR
  1. I Y=1 S FIX=1
  1. I Y=2 S FIX=2
  1. I Y=3!(Y=-1)!('Y) S FIX=0 Q FIX
  1. ;
  1. K DIR,Y
  1. S DIR("A")="Are you sure you want to proceed",DIR("B")="NO"
  1. S DIR(0)="Y"
  1. D ^DIR
  1. I 'Y S FIX=0
  1. ;
  1. Q FIX