source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRPXCHKM.m@ 683

Last change on this file since 683 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1LRPXCHKM ;SLC/STAFF - Lab PXRMINDX Index Validation Micro ;10/15/03 09:15
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4MI(DFN,LRDFN) ; from LRPXCHK
5 N DATE,LRIDT,ZERO
6 S LRIDT=0
7 F S LRIDT=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT)) Q:LRIDT<1 D
8 . S ZERO=$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,0))
9 . S DATE=+ZERO I 'DATE Q
10 . I '$$MIVER^LRPXRM(LRDFN,LRIDT) Q
11 . D MICRO(DFN,LRDFN,DATE,LRIDT)
12 Q
13 ;
14MICRO(DFN,LRDFN,DATE,LRIDT) ;
15 N AB,ABDN,ACC,ITEM,NODE,ORG,ORGNUM,SPEC,SUB,TB,TBDN,TEST,TESTS K TESTS
16 S SPEC=+$P(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,0),U,5)
17 I 'SPEC Q
18 S ITEM="M;S;"_SPEC
19 S NODE=LRDFN_";MI;"_LRIDT_";0"
20 D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
21 S ACC=$P(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,0),U,6)
22 I $L(ACC) D
23 . D ACCY^LRPXAPI(.TESTS,ACC,DATE)
24 . I $O(TESTS(0)) D
25 .. S TEST=0
26 .. F S TEST=+$O(TESTS(TEST)) Q:TEST<1 D
27 ... S ITEM="M;T;"_TEST
28 ... D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
29 I $G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,1)) D
30 . S ORGNUM=0
31 . F S ORGNUM=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,3,ORGNUM)) Q:ORGNUM<1 D
32 .. S ORG=+$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,3,ORGNUM,0))
33 .. I 'ORG Q
34 .. S ITEM="M;O;"_ORG
35 .. S NODE=LRDFN_";MI;"_LRIDT_";3;"_ORGNUM_";0"
36 .. D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
37 .. S ABDN=1
38 .. F S ABDN=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,3,ORGNUM,ABDN)) Q:ABDN<1 D
39 ... S AB=$$AB^LRPXAPIU(ABDN)
40 ... I 'AB Q
41 ... S ITEM="M;A;"_AB
42 ... S NODE=LRDFN_";MI;"_LRIDT_";3;"_ORGNUM_";"_ABDN
43 ... D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
44 F SUB=6,9,12,17 D
45 . I '$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,(SUB-1))) Q
46 . S ORGNUM=0
47 . F S ORGNUM=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,SUB,ORGNUM)) Q:ORGNUM<1 D
48 .. S ORG=+$G(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,SUB,ORGNUM,0))
49 .. I 'ORG Q
50 .. S ITEM="M;O;"_ORG
51 .. S NODE=LRDFN_";MI;"_LRIDT_";"_SUB_";"_ORGNUM_";0"
52 .. D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
53 .. I SUB'=12 Q
54 .. S TBDN=2
55 .. F S TBDN=$O(^TMP("LRPXCHK",$J,"LR",LRDFN,"MI",LRIDT,12,ORGNUM,TBDN)) Q:TBDN<2 D
56 ... S TB=$$TB^LRPXAPIU(TBDN)
57 ... I '$L(TB) Q
58 ... S ITEM="M;M;"_TB
59 ... S NODE=LRDFN_";MI;"_LRIDT_";12;"_ORGNUM_";"_TBDN
60 ... D TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
61 Q
62 ;
Note: See TracBrowser for help on using the repository browser.