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

LRPXCHKM.m

Go to the documentation of this file.
LRPXCHKM ;VA/SLC/STAFF - Lab PXRMINDX Index Validation Micro ;10/15/03  09:15
 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994;Build 5
 ;
MI(DFN,LRDFN) ; from LRPXCHK
 N DATE,LRIDT,ZERO
 S LRIDT=0
 F  S LRIDT=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT)) Q:LRIDT<1  D
 . S ZERO=$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,0))
 . S DATE=+ZERO I 'DATE Q
 . I '$$MIVER^LRPXRM(LRDFN,LRIDT) Q
 . D MICRO(DFN,LRDFN,DATE,LRIDT)
 Q
 ;
MICRO(DFN,LRDFN,DATE,LRIDT) ;
 N AB,ABDN,ACC,ITEM,NODE,ORG,ORGNUM,SPEC,SUB,TB,TBDN,TEST,TESTS K TESTS
 S SPEC=+$P(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,0),U,5)
 I 'SPEC Q
 S ITEM="M;S;"_SPEC
 S NODE=LRDFN_";MI;"_LRIDT_";0"
 D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
 S ACC=$P(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,0),U,6)
 I $L(ACC) D
 . D ACCY^LRPXAPI(.TESTS,ACC,DATE)
 . I $O(TESTS(0)) D
 .. S TEST=0
 .. F  S TEST=+$O(TESTS(TEST)) Q:TEST<1  D
 ... S ITEM="M;T;"_TEST
 ... D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
 I $G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,1)) D
 . S ORGNUM=0
 . F  S ORGNUM=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,3,ORGNUM)) Q:ORGNUM<1  D
 .. S ORG=+$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,3,ORGNUM,0))
 .. I 'ORG Q
 .. S ITEM="M;O;"_ORG
 .. S NODE=LRDFN_";MI;"_LRIDT_";3;"_ORGNUM_";0"
 .. D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
 .. S ABDN=1
 .. F  S ABDN=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,3,ORGNUM,ABDN)) Q:ABDN<1  D
 ... S AB=$$AB^LRPXAPIU(ABDN)
 ... I 'AB Q
 ... S ITEM="M;A;"_AB
 ... S NODE=LRDFN_";MI;"_LRIDT_";3;"_ORGNUM_";"_ABDN
 ... D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
 F SUB=6,9,12,17 D
 . I '$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,(SUB-1))) Q
 . S ORGNUM=0
 . F  S ORGNUM=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,SUB,ORGNUM)) Q:ORGNUM<1  D
 .. S ORG=+$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,SUB,ORGNUM,0))
 .. I 'ORG Q
 .. S ITEM="M;O;"_ORG
 .. S NODE=LRDFN_";MI;"_LRIDT_";"_SUB_";"_ORGNUM_";0"
 .. D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
 .. I SUB'=12 Q
 .. S TBDN=2
 .. F  S TBDN=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,12,ORGNUM,TBDN)) Q:TBDN<2  D
 ... S TB=$$TB^LRPXAPIU(TBDN)
 ... I '$L(TB) Q
 ... S ITEM="M;M;"_TB
 ... S NODE=LRDFN_";MI;"_LRIDT_";12;"_ORGNUM_";"_TBDN
 ... D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
 Q
 ;