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

LRPXCHK.m

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