267 lines
7.7 KiB
Mathematica
267 lines
7.7 KiB
Mathematica
LRPXCHK ;SLC/STAFF - Lab PXRMINDX Index Validation ;3/30/04 12:01
|
|
;;5.2;LAB SERVICE;**295**;Sep 27, 1994
|
|
;
|
|
PATS ; select patients for index check
|
|
N DFN,ERR,REPAIR
|
|
D CLEAN
|
|
F D GETPT^LRPXAPPU(.DFN,.ERR) Q:ERR D
|
|
. S ^TMP("LRLOG PATS",$J,DFN)=""
|
|
D
|
|
. I '$O(^TMP("LRLOG PATS",$J,0)) Q
|
|
. D GETREP(.REPAIR,.ERR) I ERR Q
|
|
. D CHECK(REPAIR)
|
|
D CLEAN
|
|
Q
|
|
;
|
|
DATES ; check indexes for a date range of patient collections
|
|
N CNT,DATE1,DATE2,DFN,LRDFN,LRIDT,OK,REPAIR,START,STOP,SUB
|
|
D CLEAN
|
|
D GETDATE^LRPXAPPU(.DATE1,.DATE2,.ERR) I ERR Q
|
|
D GETREP(.REPAIR,.ERR) I ERR Q
|
|
S STOP=$$LRIDT^LRPXAPIU(DATE1)
|
|
S START=$$LRIDT^LRPXAPIU(DATE2)
|
|
S CNT=0
|
|
S LRDFN=0
|
|
F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D
|
|
. S OK=0
|
|
. F SUB="CH","MI","CY","SP","EM" D Q:OK
|
|
.. S LRIDT=START
|
|
.. F S LRIDT=$O(^LR(LRDFN,SUB,LRIDT)) Q:LRIDT<1 Q:LRIDT>STOP D Q:OK
|
|
... S DFN=$$DFN^LRPXAPIU(LRDFN)
|
|
... I 'DFN Q
|
|
... S ^TMP("LRLOG PATS",$J,DFN)=""
|
|
... S OK=1,CNT=CNT+1
|
|
W !,CNT," Patients to check"
|
|
D CHECK(REPAIR)
|
|
D CLEAN
|
|
Q
|
|
;
|
|
CHECK(REPAIR) ;
|
|
N CNT,DFN
|
|
S REPAIR=$G(REPAIR)
|
|
S DFN=0
|
|
F S DFN=$O(^TMP("LRLOG PATS",$J,DFN)) Q:DFN<1 D
|
|
. W !,"DFN: ",DFN," LRDFN: ",$$LRDFN^LRPXAPIU(DFN)
|
|
. D CHKPAT(DFN)
|
|
S CNT=0
|
|
S DFN=0
|
|
F S DFN=$O(^TMP("LRLOG",$J,DFN)) Q:DFN<1 D
|
|
. S CNT=CNT+1
|
|
I 'CNT W !,"Indexes were valid" Q
|
|
W !,CNT," Patients with invalid indexes"
|
|
I REPAIR D REPAIR
|
|
Q
|
|
;
|
|
ALL ; check all patient indexes
|
|
; this takes a very long time
|
|
; to be used in small test accounts
|
|
; START and STOP determine range of DFNs to check
|
|
Q ; for testing
|
|
N DFN,ERR,REPAIR,START,STOP
|
|
D CLEAN
|
|
W !,"WARNING - checking ALL patients",!
|
|
D GETREP(.REPAIR,.ERR) I ERR Q
|
|
S START=1
|
|
S STOP=10000000000000
|
|
S DFN=START-.1
|
|
F S DFN=$O(^DPT(DFN)) Q:DFN<1 Q:DFN>STOP D
|
|
. W !,"DFN: ",DFN," LRDFN: ",$$LRDFN^LRPXAPIU(DFN)
|
|
. D CHKPAT(DFN)
|
|
I REPAIR D REPAIR
|
|
D CLEAN
|
|
Q
|
|
;
|
|
CHKPAT(DFN) ; from LRLOG
|
|
; find bad nodes,
|
|
; store as ^TMP("LRLOG",$J,DFN,DATE,ITEM,INDEX)=NODE
|
|
; only when ^TMP("LRLOG PATS",$J) is present
|
|
; if ^TMP("LRLOG PATS",$J) is not present, write to screen
|
|
N ITEM,LRDFN
|
|
K ^TMP("LRPXCHK",$J)
|
|
S LRDFN=$$LRDFN^LRPXAPIU(DFN)
|
|
I 'LRDFN Q
|
|
M ^TMP("LRPXCHK",$J,"LR",LRDFN)=^LR(LRDFN)
|
|
M ^TMP("LRPXCHK",$J,"PI",DFN)=^PXRMINDX(63,"PI",DFN)
|
|
M ^TMP("LRPXCHK",$J,"PDI",DFN)=^PXRMINDX(63,"PDI",DFN)
|
|
S ITEM=""
|
|
F S ITEM=$O(^PXRMINDX(63,"IP",ITEM)) Q:ITEM="" D
|
|
. I $D(^PXRMINDX(63,"IP",ITEM,DFN)) D
|
|
. M ^TMP("LRPXCHK",$J,"IP",ITEM,DFN)=^PXRMINDX(63,"IP",ITEM,DFN)
|
|
D INTEG(DFN)
|
|
D CHKLR(DFN)
|
|
D CHKPI(DFN,LRDFN)
|
|
K ^TMP("LRPXCHK",$J)
|
|
Q
|
|
;
|
|
INTEG(DFN) ; make sure "PI", "IP", and "PDI" are consistent
|
|
N DATE,ITEM,NODE
|
|
S DATE=0
|
|
F S DATE=$O(^TMP("LRPXCHK",$J,"PDI",DFN,DATE)) Q:DATE<1 D
|
|
. S ITEM="A"
|
|
. F S ITEM=$O(^TMP("LRPXCHK",$J,"PDI",DFN,DATE,ITEM)) Q:ITEM="" D
|
|
.. S NODE=""
|
|
.. F S NODE=$O(^TMP("LRPXCHK",$J,"PDI",DFN,DATE,ITEM,NODE)) Q:NODE="" D
|
|
... I '$D(^TMP("LRPXCHK",$J,"PI",DFN,ITEM,DATE,NODE)) D
|
|
.... D BAD("PDI-PI",DFN,ITEM,DATE,NODE)
|
|
... I '$D(^TMP("LRPXCHK",$J,"IP",ITEM,DFN,DATE,NODE)) D
|
|
.... D BAD("PDI-IP",DFN,ITEM,DATE,NODE)
|
|
S ITEM=""
|
|
F S ITEM=$O(^TMP("LRPXCHK",$J,"PI",DFN,ITEM)) Q:ITEM="" D
|
|
. S DATE=0
|
|
. F S DATE=$O(^TMP("LRPXCHK",$J,"PI",DFN,ITEM,DATE)) Q:DATE<1 D
|
|
.. S NODE=""
|
|
.. F S NODE=$O(^TMP("LRPXCHK",$J,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
|
|
... I '$D(^TMP("LRPXCHK",$J,"IP",ITEM,DFN,DATE,NODE)) D
|
|
.... D BAD("PI-IP",DFN,ITEM,DATE,NODE)
|
|
... I 'ITEM,'$D(^TMP("LRPXCHK",$J,"PDI",DFN,DATE,ITEM,NODE)) D
|
|
.... D BAD("PI-PDI",DFN,ITEM,DATE,NODE)
|
|
S ITEM=""
|
|
F S ITEM=$O(^TMP("LRPXCHK",$J,"IP",ITEM)) Q:ITEM="" D
|
|
. S DATE=0
|
|
. F S DATE=$O(^TMP("LRPXCHK",$J,"IP",ITEM,DFN,DATE)) Q:DATE<1 D
|
|
.. S NODE=""
|
|
.. F S NODE=$O(^TMP("LRPXCHK",$J,"IP",ITEM,DFN,DATE,NODE)) Q:NODE="" D
|
|
... I '$D(^TMP("LRPXCHK",$J,"PI",DFN,ITEM,DATE,NODE)) D
|
|
.... D BAD("IP-PI",DFN,ITEM,DATE,NODE)
|
|
... I 'ITEM,'$D(^TMP("LRPXCHK",$J,"PDI",DFN,DATE,ITEM,NODE)) D
|
|
.... D BAD("IP-PDI",DFN,ITEM,DATE,NODE)
|
|
Q
|
|
;
|
|
CHKLR(DFN) ; go thru "PI" to make sure ^LR is consistent
|
|
N DATE,ITEM,NODE
|
|
S ITEM=""
|
|
F S ITEM=$O(^TMP("LRPXCHK",$J,"PI",DFN,ITEM)) Q:ITEM="" D
|
|
. S DATE=0
|
|
. F S DATE=$O(^TMP("LRPXCHK",$J,"PI",DFN,ITEM,DATE)) Q:DATE<1 D
|
|
.. S NODE=""
|
|
.. F S NODE=$O(^TMP("LRPXCHK",$J,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
|
|
... I '$$REFVAL(NODE) D BAD("LR",DFN,ITEM,DATE,NODE) Q
|
|
Q
|
|
;
|
|
CHKPI(DFN,LRDFN) ; go thru ^LR to make sure "PI" is consistent
|
|
N DATE,ITEM,LRIDT,LRDN,NODE,ZERO
|
|
S LRIDT=0
|
|
F S LRIDT=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"CH",LRIDT)) Q:LRIDT<1 D
|
|
. S ZERO=$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"CH",LRIDT,0))
|
|
. S DATE=+ZERO I 'DATE Q
|
|
. I '$P(ZERO,U,3) Q
|
|
. S LRDN=1
|
|
. F S LRDN=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
|
|
.. S ITEM=$$TEST^LRPXAPIU(LRDN)
|
|
.. I 'ITEM Q
|
|
.. S NODE=LRDFN_";CH;"_LRIDT_";"_LRDN
|
|
.. I '$D(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) D BAD("CH",DFN,ITEM,DATE,NODE)
|
|
D MI^LRPXCHKM(DFN,LRDFN)
|
|
D AP^LRPXCHKA(DFN,LRDFN)
|
|
Q
|
|
;
|
|
TMPCHK(DFN,DATE,ITEM,NODE) ;
|
|
I '$D(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) D BAD(NODE,DFN,ITEM,DATE,NODE)
|
|
Q
|
|
;
|
|
BAD(INDEX,DFN,ITEM,DATE,NODE) ; write error to screen, collect in global
|
|
W !,?5,INDEX," ",DFN," ",ITEM," ",DATE," ",NODE
|
|
S ^TMP("LRLOG",$J,DFN,DATE,ITEM,INDEX)=NODE
|
|
Q
|
|
;
|
|
CLEAN ; clear tmp globals
|
|
; "LRLOG" collects invalid nodes, "LRLOG PATS" are patients checked
|
|
K ^TMP("LRLOG",$J)
|
|
K ^TMP("LRLOG PATS",$J)
|
|
Q
|
|
;
|
|
REFVAL(REF) ; $$(reference location in ^LR) -> if ref exists 1, else 0
|
|
N SUB
|
|
I REF'[";" Q ""
|
|
S SUB=$P(REF,";",2)
|
|
S SUB=""""_SUB_""""
|
|
S $P(REF,";",2)=SUB
|
|
S REF=$TR(REF,";",",")
|
|
S REF="^LR("_REF_")"
|
|
I $D(@REF) Q 1
|
|
Q 0
|
|
;
|
|
REPAIR ; correct invalid indexes
|
|
; kill off bad indexes
|
|
; reset all indexes at date of bad index
|
|
N DATE,DFN,DOD,INDEX,ITEM,NODE,REPAIR K REPAIR
|
|
S DFN=0
|
|
F S DFN=$O(^TMP("LRLOG",$J,DFN)) Q:DFN<1 D
|
|
. S LRDFN=$$LRDFN^LRPXAPIU(DFN)
|
|
. S DOD=$$DOD^LRPXAPIU(DFN)
|
|
. S DATE=0
|
|
. F S DATE=$O(^TMP("LRLOG",$J,DFN,DATE)) Q:DATE<1 D
|
|
.. S LRIDT=$$LRIDT^LRPXAPIU(DATE)
|
|
.. K REPAIR
|
|
.. S ITEM=""
|
|
.. F S ITEM=$O(^TMP("LRLOG",$J,DFN,DATE,ITEM)) Q:ITEM="" D
|
|
... S INDEX=""
|
|
... F S INDEX=$O(^TMP("LRLOG",$J,DFN,DATE,ITEM,INDEX)) Q:INDEX="" D
|
|
.... S NODE=^TMP("LRLOG",$J,DFN,DATE,ITEM,INDEX)
|
|
.... I '$L(NODE) Q
|
|
.... S REPAIR($P(NODE,";",2))=""
|
|
.... D KLAB^LRPX(DFN,DATE,ITEM,NODE)
|
|
.. S SUB=""
|
|
.. F S SUB=$O(REPAIR(SUB)) Q:SUB="" D
|
|
... I SUB="CH" D CH(DFN,LRDFN,DATE,LRIDT) Q
|
|
... I SUB="MI" D MICRO(DFN,LRDFN,DATE,LRIDT) Q
|
|
... D AP(DFN,LRDFN,DATE,LRIDT,SUB)
|
|
.. I DATE=DOD D AU(DFN,LRDFN,DATE) Q
|
|
Q
|
|
;
|
|
CH(DFN,LRDFN,DATE,LRIDT) ;
|
|
N DAT,LRDN,NODE,TEMP,TEST
|
|
I '$$VERIFIED^LRPXAPI(LRDFN,LRIDT) Q
|
|
S DAT=LRDFN_";CH;"_LRIDT
|
|
S LRDN=1
|
|
F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
|
|
. S NODE=DAT_";"_LRDN
|
|
. S TEMP=^LR(LRDFN,"CH",LRIDT,LRDN)
|
|
. S TEST=+$P($P(TEMP,U,3),"!",6)
|
|
. I 'TEST S TEST=$$TEST^LRPXAPIU(LRDN)
|
|
. I 'TEST Q
|
|
. D SLAB^LRPX(DFN,DATE,TEST,NODE)
|
|
Q
|
|
;
|
|
MICRO(DFN,LRDFN,DATE,LRIDT) ;
|
|
K ^TMP("LRPX",$J)
|
|
M ^TMP("LRPX",$J,"AR")=^LR(LRDFN,"MI",LRIDT)
|
|
M ^TMP("LRPX",$J,"B")=^PXRMINDX(63,"PDI",DFN,DATE)
|
|
D MICRO^LRPXRM(DFN,LRDFN,DATE,LRIDT)
|
|
K ^TMP("LRPX",$J)
|
|
Q
|
|
;
|
|
AP(DFN,LRDFN,DATE,LRIDT,SUB) ;
|
|
K ^TMP("LRPX",$J)
|
|
M ^TMP("LRPX",$J,"AR")=^LR(LRDFN,SUB,LRIDT)
|
|
M ^TMP("LRPX",$J,"B")=^PXRMINDX(63,"PDI",DFN,DATE)
|
|
D AP^LRPXRM(DFN,LRDFN,DATE,LRIDT,SUB)
|
|
K ^TMP("LRPX",$J)
|
|
Q
|
|
;
|
|
AU(DFN,LRDFN,DATE) ;
|
|
I '+$G(^LR(LRDFN,"AU")) Q
|
|
I '($P(^LR(LRDFN,"AU"),U,3)&($P(^("AU"),U,15))) Q
|
|
K ^TMP("LRPX",$J)
|
|
M ^TMP("LRPX",$J,"AR","AY")=^LR(LRDFN,"AY")
|
|
M ^TMP("LRPX",$J,"AR",80)=^LR(LRDFN,80)
|
|
M ^TMP("LRPX",$J,"AR",33)=^LR(LRDFN,33)
|
|
M ^TMP("LRPX",$J,"B")=^PXRMINDX(63,"PDI",DFN,DATE)
|
|
D AUTOPSY^LRPXRM(LRDFN)
|
|
K ^TMP("LRPX",$J)
|
|
Q
|
|
;
|
|
GETREP(REPAIR,ERR) ;
|
|
; asks to repair indexes
|
|
N DIR,DIRUT,DTOUT,X,Y K DIR
|
|
S ERR=0,REPAIR=""
|
|
S DIR(0)="YAO"
|
|
S DIR("A")="Repair invalid indexes? "
|
|
S DIR("B")="YES"
|
|
D ^DIR K DIR
|
|
I Y[U!$D(DTOUT) S ERR=1 Q
|
|
S REPAIR=Y
|
|
W !
|
|
Q
|
|
;
|