LRPXCHKM ;SLC/STAFF - Lab PXRMINDX Index Validation Micro ;10/15/03 09:15
;;5.2;LAB SERVICE;**295**;Sep 27, 1994
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXCHKM 2240 printed Apr 09, 2024@21:06:55 Page 2
LRPXCHKM ;SLC/STAFF - Lab PXRMINDX Index Validation Micro ;10/15/03 09:15
+1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
+2 ;
MI(DFN,LRDFN) ; from LRPXCHK
+1 NEW DATE,LRIDT,ZERO
+2 SET LRIDT=0
+3 FOR
SET LRIDT=$ORDER(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT))
if LRIDT<1
QUIT
Begin DoDot:1
+4 SET ZERO=$GET(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,0))
+5 SET DATE=+ZERO
IF 'DATE
QUIT
+6 IF '$$MIVER^LRPXRM(LRDFN,LRIDT)
QUIT
+7 DO MICRO(DFN,LRDFN,DATE,LRIDT)
End DoDot:1
+8 QUIT
+9 ;
MICRO(DFN,LRDFN,DATE,LRIDT) ;
+1 NEW AB,ABDN,ACC,ITEM,NODE,ORG,ORGNUM,SPEC,SUB,TB,TBDN,TEST,TESTS
KILL TESTS
+2 SET SPEC=+$PIECE(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,0),U,5)
+3 IF 'SPEC
QUIT
+4 SET ITEM="M;S;"_SPEC
+5 SET NODE=LRDFN_";MI;"_LRIDT_";0"
+6 DO TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
+7 SET ACC=$PIECE(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,0),U,6)
+8 IF $LENGTH(ACC)
Begin DoDot:1
+9 DO ACCY^LRPXAPI(.TESTS,ACC,DATE)
+10 IF $ORDER(TESTS(0))
Begin DoDot:2
+11 SET TEST=0
+12 FOR
SET TEST=+$ORDER(TESTS(TEST))
if TEST<1
QUIT
Begin DoDot:3
+13 SET ITEM="M;T;"_TEST
+14 DO TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF $GET(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,1))
Begin DoDot:1
+16 SET ORGNUM=0
+17 FOR
SET ORGNUM=$ORDER(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,3,ORGNUM))
if ORGNUM<1
QUIT
Begin DoDot:2
+18 SET ORG=+$GET(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,3,ORGNUM,0))
+19 IF 'ORG
QUIT
+20 SET ITEM="M;O;"_ORG
+21 SET NODE=LRDFN_";MI;"_LRIDT_";3;"_ORGNUM_";0"
+22 DO TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
+23 SET ABDN=1
+24 FOR
SET ABDN=$ORDER(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,3,ORGNUM,ABDN))
if ABDN<1
QUIT
Begin DoDot:3
+25 SET AB=$$AB^LRPXAPIU(ABDN)
+26 IF 'AB
QUIT
+27 SET ITEM="M;A;"_AB
+28 SET NODE=LRDFN_";MI;"_LRIDT_";3;"_ORGNUM_";"_ABDN
+29 DO TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
End DoDot:3
End DoDot:2
End DoDot:1
+30 FOR SUB=6,9,12,17
Begin DoDot:1
+31 IF '$GET(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,(SUB-1)))
QUIT
+32 SET ORGNUM=0
+33 FOR
SET ORGNUM=$ORDER(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,SUB,ORGNUM))
if ORGNUM<1
QUIT
Begin DoDot:2
+34 SET ORG=+$GET(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,SUB,ORGNUM,0))
+35 IF 'ORG
QUIT
+36 SET ITEM="M;O;"_ORG
+37 SET NODE=LRDFN_";MI;"_LRIDT_";"_SUB_";"_ORGNUM_";0"
+38 DO TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
+39 IF SUB'=12
QUIT
+40 SET TBDN=2
+41 FOR
SET TBDN=$ORDER(^TMP("LRPXCHK",$JOB,"LR",LRDFN,"MI",LRIDT,12,ORGNUM,TBDN))
if TBDN<2
QUIT
Begin DoDot:3
+42 SET TB=$$TB^LRPXAPIU(TBDN)
+43 IF '$LENGTH(TB)
QUIT
+44 SET ITEM="M;M;"_TB
+45 SET NODE=LRDFN_";MI;"_LRIDT_";12;"_ORGNUM_";"_TBDN
+46 DO TMPCHK^LRPXCHK(DFN,DATE,ITEM,NODE)
End DoDot:3
End DoDot:2
End DoDot:1
+47 QUIT
+48 ;
