- 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 Mar 13, 2025@21:24:09 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 ;
