- APCHS3E ; IHS/CMI/LAB - PART 3 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- MIC ; ******************** MIC DATA * 9000010.09 *******
- I '$D(^AUPNVMIC("AE",APCHSPAT)) G MICX
- W !?3,"See the Lab Package for More Complete Microbiology Information than ",!,"contained below."
- X APCHSCKP Q:$D(APCHSQIT) I APCHSNPG W ?34,"RESULT",?58,"COLL DATE",?68,"COMP DATE",!
- X:'APCHSNPG APCHSBRK
- ; <SETUP>
- K ^TMP($J,"APCHSMICP"),^TMP($J,"APCHMICA")
- ; <PROCESS>
- D LBLD,LPRT
- ; <CLEANUP>
- MICX K X,Y,C,D,T,O,P,A,N
- K APCHSIVD,APCHSLT,APCHSIEN,APCHSACC,APCHS01,APCHSORG,APCHSANT,APCHSVL
- K ^TMP($J,"APCHSMICP"),^TMP($J,"APCHMICA")
- Q
- ; <BUILD>
- LBLD ;
- S APCHSIVD="" F S APCHSIVD=$O(^AUPNVMIC("AE",APCHSPAT,APCHSIVD)) Q:'APCHSIVD!(APCHSIVD>APCHSDLM) D LDATE
- Q
- LDATE S APCHSLT="" F S APCHSLT=$O(^AUPNVMIC("AE",APCHSPAT,APCHSIVD,APCHSLT)) Q:APCHSLT'=+APCHSLT D
- .S APCHSIEN=0 F S APCHSIEN=$O(^AUPNVMIC("AE",APCHSPAT,APCHSIVD,APCHSLT,APCHSIEN)) Q:APCHSIEN'=+APCHSIEN D LSET
- Q
- LSET ;
- S N=$G(^AUPNVMIC(APCHSIEN,0))
- S D=$P($P($G(^AUPNVMIC(APCHSIEN,12)),U),".") I D]"" S D=9999999-D
- S P=$P($G(^AUPNVMIC(APCHSIEN,12)),U,8)
- S O=$P(N,U,4),A=$P(N,U,5),C=$P(N,U,6),T=$P(N,U,1)
- S:O="" O=0 S:A="" A=0 S:C="" C=0
- Q:T=""
- I P="" S ^TMP($J,"APCHSMICP",$S(D]"":D,1:APCHSIVD),C,T,APCHSIEN)=""
- S ^TMP($J,"APCHMICA",C,T,O,A,APCHSIEN)=""
- Q
- ; <PRINT>
- LPRT ;
- Q:'$D(^TMP($J,"APCHSMICP"))
- W ?34,"RESULT",?58,"COLL DATE",?68,"COMP DATE",!
- S APCHSIVD="" F S APCHSIVD=$O(^TMP($J,"APCHSMICP",APCHSIVD)) Q:APCHSIVD'=+APCHSIVD!($D(APCHSQIT)) D
- .S APCHSACC="" F S APCHSACC=$O(^TMP($J,"APCHSMICP",APCHSIVD,APCHSACC)) Q:APCHSACC=""!($D(APCHSQIT)) D
- ..S APCHS01=0 F S APCHS01=$O(^TMP($J,"APCHSMICP",APCHSIVD,APCHSACC,APCHS01)) Q:APCHS01'=+APCHS01!($D(APCHSQIT)) D
- ...S APCHSIEN=0 F S APCHSIEN=$O(^TMP($J,"APCHSMICP",APCHSIVD,APCHSACC,APCHS01,APCHSIEN)) Q:APCHSIEN'=+APCHSIEN!($D(APCHSQIT)) D LPRT2
- ...Q
- ..Q
- .Q
- Q
- LPRT2 ;
- ;print all from this acc,.01
- S APCHSORG="" F S APCHSORG=$O(^TMP($J,"APCHMICA",APCHSACC,APCHS01,APCHSORG)) Q:APCHSORG=""!($D(APCHSQIT)) D
- .S APCHSANT="" F S APCHSANT=$O(^TMP($J,"APCHMICA",APCHSACC,APCHS01,APCHSORG,APCHSANT)) Q:APCHSANT=""!($D(APCHSQIT)) D
- ..S APCHSVL=0 F S APCHSVL=$O(^TMP($J,"APCHMICA",APCHSACC,APCHS01,APCHSORG,APCHSANT,APCHSVL)) Q:APCHSVL'=+APCHSVL!($D(APCHSQIT)) D LPRT3
- Q
- LPRT3 ;write out line
- S APCHSN=^AUPNVMIC(APCHSVL,0)
- X APCHSCKP Q:$D(APCHSQIT) I APCHSNPG W ?34,"RESULT",?58,"COLL DATE",?68,"COMP DATE",!
- ;write name
- K ^TMP($J,"APCHMICA",APCHSACC,APCHS01,APCHSORG,APCHSANT,APCHSVL)
- ;I APCHSANT=0,APCHSORG'=0 W !?3,$$VAL^XBDIQ1(9000010.25,APCHSVL,.04)," ",$$ORGR(APCHSPAT,APCHSACC,$P($G(^AUPNVMIC(APCHSVL,12)),U),APCHSVL) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,?79,$E($P($G(^AUPNVMIC(APCHSVL,11)),U,9)),! Q
- I APCHSANT=0,APCHSORG'=0 W !?2,$$VAL^XBDIQ1(9000010.25,APCHSVL,.04)," ",?34,$$ORGR(APCHSPAT,APCHSACC,$P($G(^AUPNVMIC(APCHSVL,12)),U),APCHSVL) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,! Q
- ;I APCHSANT>0 W ?3,$$VAL^XBDIQ1(9000010.25,APCHSVL,.05),?34,$P(APCHSN,U,7) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,?79,$E($P($G(^AUPNVMIC(APCHSVL,11)),U,9)),! Q
- I APCHSANT>0 W ?3,$$VAL^XBDIQ1(9000010.25,APCHSVL,.05),?34,$P(APCHSN,U,7) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,! Q
- ;W:'APCHSNPG ! W $P(^LAB(60,$P(APCHSN,U),0),U) S Y=(9999999-APCHSIVD) X APCHSCVD W ?58,Y,?47,$P(APCHSN,U,7) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,?79,$E($P($G(^AUPNVMIC(APCHSVL,11)),U,9)),! D
- W:'APCHSNPG ! W $P(^LAB(60,$P(APCHSN,U),0),U) S Y=(9999999-APCHSIVD) X APCHSCVD D
- .W:$P(^LAB(60,$P(APCHSN,U),0),U)["GRAM " ?34,$$GSR(APCHSPAT,APCHSACC,$P($G(^AUPNVMIC(APCHSVL,12)),U),APCHSVL)
- .W ?58,Y S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,! D
- ..W ?2,"Site/Specimen: ",$$SITE(APCHSPAT,APCHSACC,$P($G(^AUPNVMIC(APCHSVL,12)),U),APCHSVL),!?2,"Collection Sample: ",$$COL(APCHSPAT,APCHSACC,$P($G(^AUPNVMIC(APCHSVL,12)),U),APCHSVL),!
- Q
- SITE(P,A,D,V) ;return site/specimen
- I $G(P)="" Q ""
- I $G(A)="" Q ""
- I $G(D)="" Q ""
- I $G(V)="" Q ""
- I $P($G(^AUPNVMIC(V,11)),U,3)]"" Q $$VAL^XBDIQ1(9000010.25,V,1103)
- NEW APCHLRDF,APCHIVD,X
- S APCHLRDF=$P($G(^DPT(P,"LR")),U)
- I APCHLRDF="" Q ""
- S APCHIVD=9999999-D
- I '$D(^LR(APCHLRDF,"MI",APCHIVD,0)) Q ""
- I $P(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A Q ""
- S X=$P(^LR(APCHLRDF,"MI",APCHIVD,0),U,5)
- I 'X Q ""
- I '$D(^LAB(61,X,0)) Q ""
- Q $P(^LAB(61,X,0),U)
- ;
- COL(P,A,D,V) ;
- I $G(P)="" Q ""
- I $G(A)="" Q ""
- I $G(D)="" Q ""
- I $G(V)="" Q ""
- I $P($G(^AUPNVMIC(V,0)),U,8)]"" Q $$VAL^XBDIQ1(9000010.25,V,.08)
- NEW APCHLRDF,APCHIVD,X
- S APCHLRDF=$P($G(^DPT(P,"LR")),U)
- I APCHLRDF="" Q ""
- S APCHIVD=9999999-D
- I '$D(^LR(APCHLRDF,"MI",APCHIVD,0)) Q ""
- I $P(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A Q ""
- S X=$P(^LR(APCHLRDF,"MI",APCHIVD,0),U,11)
- I 'X Q ""
- I '$D(^LAB(62,X,0)) Q ""
- Q $P(^LAB(62,X,0),U)
- ;
- GSR(P,A,D,V) ;
- I $G(P)="" Q ""
- I $G(A)="" Q ""
- I $G(D)="" Q ""
- I $G(V)="" Q ""
- NEW APCHLRDF,APCHIVD,X,R
- S R=$$VAL^XBDIQ1(9000010.25,V,.07)
- S APCHLRDF=$P($G(^DPT(P,"LR")),U)
- I APCHLRDF="" Q ""
- S APCHIVD=9999999-D
- I '$D(^LR(APCHLRDF,"MI",APCHIVD,0)) Q ""
- I $P(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A Q ""
- S X=$G(^LR(APCHLRDF,"MI",APCHIVD,2,1,0))
- I X="" Q ""
- ;
- Q X
- ORGR(P,A,D,V) ;
- I $G(P)="" Q ""
- I $G(A)="" Q ""
- I $G(D)="" Q ""
- I $G(V)="" Q ""
- NEW APCHLRDF,APCHIVD,X,R
- S R=$$VAL^XBDIQ1(9000010.25,V,.07)
- S APCHLRDF=$P($G(^DPT(P,"LR")),U)
- I APCHLRDF="" Q ""
- S APCHIVD=9999999-D
- I '$D(^LR(APCHLRDF,"MI",APCHIVD,0)) Q ""
- I $P(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A Q ""
- S X=$P($G(^LR(APCHLRDF,"MI",APCHIVD,3,1,0)),U,2)
- I X="" Q ""
- ;
- Q X
- APCHS3E ; IHS/CMI/LAB - PART 3 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- MIC ; ******************** MIC DATA * 9000010.09 *******
- +1 IF '$DATA(^AUPNVMIC("AE",APCHSPAT))
- GOTO MICX
- +2 WRITE !?3,"See the Lab Package for More Complete Microbiology Information than ",!,"contained below."
- +3 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- IF APCHSNPG
- WRITE ?34,"RESULT",?58,"COLL DATE",?68,"COMP DATE",!
- +4 IF 'APCHSNPG
- XECUTE APCHSBRK
- +5 ; <SETUP>
- +6 KILL ^TMP($JOB,"APCHSMICP"),^TMP($JOB,"APCHMICA")
- +7 ; <PROCESS>
- +8 DO LBLD
- DO LPRT
- +9 ; <CLEANUP>
- MICX KILL X,Y,C,D,T,O,P,A,N
- +1 KILL APCHSIVD,APCHSLT,APCHSIEN,APCHSACC,APCHS01,APCHSORG,APCHSANT,APCHSVL
- +2 KILL ^TMP($JOB,"APCHSMICP"),^TMP($JOB,"APCHMICA")
- +3 QUIT
- +4 ; <BUILD>
- LBLD ;
- +1 SET APCHSIVD=""
- FOR
- SET APCHSIVD=$ORDER(^AUPNVMIC("AE",APCHSPAT,APCHSIVD))
- IF 'APCHSIVD!(APCHSIVD>APCHSDLM)
- QUIT
- DO LDATE
- +2 QUIT
- LDATE SET APCHSLT=""
- FOR
- SET APCHSLT=$ORDER(^AUPNVMIC("AE",APCHSPAT,APCHSIVD,APCHSLT))
- IF APCHSLT'=+APCHSLT
- QUIT
- Begin DoDot:1
- +1 SET APCHSIEN=0
- FOR
- SET APCHSIEN=$ORDER(^AUPNVMIC("AE",APCHSPAT,APCHSIVD,APCHSLT,APCHSIEN))
- IF APCHSIEN'=+APCHSIEN
- QUIT
- DO LSET
- End DoDot:1
- +2 QUIT
- LSET ;
- +1 SET N=$GET(^AUPNVMIC(APCHSIEN,0))
- +2 SET D=$PIECE($PIECE($GET(^AUPNVMIC(APCHSIEN,12)),U),".")
- IF D]""
- SET D=9999999-D
- +3 SET P=$PIECE($GET(^AUPNVMIC(APCHSIEN,12)),U,8)
- +4 SET O=$PIECE(N,U,4)
- SET A=$PIECE(N,U,5)
- SET C=$PIECE(N,U,6)
- SET T=$PIECE(N,U,1)
- +5 IF O=""
- SET O=0
- IF A=""
- SET A=0
- IF C=""
- SET C=0
- +6 IF T=""
- QUIT
- +7 IF P=""
- SET ^TMP($JOB,"APCHSMICP",$SELECT(D]"":D,1:APCHSIVD),C,T,APCHSIEN)=""
- +8 SET ^TMP($JOB,"APCHMICA",C,T,O,A,APCHSIEN)=""
- +9 QUIT
- +10 ; <PRINT>
- LPRT ;
- +1 IF '$DATA(^TMP($JOB,"APCHSMICP"))
- QUIT
- +2 WRITE ?34,"RESULT",?58,"COLL DATE",?68,"COMP DATE",!
- +3 SET APCHSIVD=""
- FOR
- SET APCHSIVD=$ORDER(^TMP($JOB,"APCHSMICP",APCHSIVD))
- IF APCHSIVD'=+APCHSIVD!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +4 SET APCHSACC=""
- FOR
- SET APCHSACC=$ORDER(^TMP($JOB,"APCHSMICP",APCHSIVD,APCHSACC))
- IF APCHSACC=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +5 SET APCHS01=0
- FOR
- SET APCHS01=$ORDER(^TMP($JOB,"APCHSMICP",APCHSIVD,APCHSACC,APCHS01))
- IF APCHS01'=+APCHS01!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:3
- +6 SET APCHSIEN=0
- FOR
- SET APCHSIEN=$ORDER(^TMP($JOB,"APCHSMICP",APCHSIVD,APCHSACC,APCHS01,APCHSIEN))
- IF APCHSIEN'=+APCHSIEN!($DATA(APCHSQIT))
- QUIT
- DO LPRT2
- +7 QUIT
- End DoDot:3
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 QUIT
- LPRT2 ;
- +1 ;print all from this acc,.01
- +2 SET APCHSORG=""
- FOR
- SET APCHSORG=$ORDER(^TMP($JOB,"APCHMICA",APCHSACC,APCHS01,APCHSORG))
- IF APCHSORG=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:1
- +3 SET APCHSANT=""
- FOR
- SET APCHSANT=$ORDER(^TMP($JOB,"APCHMICA",APCHSACC,APCHS01,APCHSORG,APCHSANT))
- IF APCHSANT=""!($DATA(APCHSQIT))
- QUIT
- Begin DoDot:2
- +4 SET APCHSVL=0
- FOR
- SET APCHSVL=$ORDER(^TMP($JOB,"APCHMICA",APCHSACC,APCHS01,APCHSORG,APCHSANT,APCHSVL))
- IF APCHSVL'=+APCHSVL!($DATA(APCHSQIT))
- QUIT
- DO LPRT3
- End DoDot:2
- End DoDot:1
- +5 QUIT
- LPRT3 ;write out line
- +1 SET APCHSN=^AUPNVMIC(APCHSVL,0)
- +2 XECUTE APCHSCKP
- IF $DATA(APCHSQIT)
- QUIT
- IF APCHSNPG
- WRITE ?34,"RESULT",?58,"COLL DATE",?68,"COMP DATE",!
- +3 ;write name
- +4 KILL ^TMP($JOB,"APCHMICA",APCHSACC,APCHS01,APCHSORG,APCHSANT,APCHSVL)
- +5 ;I APCHSANT=0,APCHSORG'=0 W !?3,$$VAL^XBDIQ1(9000010.25,APCHSVL,.04)," ",$$ORGR(APCHSPAT,APCHSACC,$P($G(^AUPNVMIC(APCHSVL,12)),U),APCHSVL) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,?79,$E($P($G(^AUPNVMIC(APCHSVL,11)),U,9)),! Q
- +6 IF APCHSANT=0
- IF APCHSORG'=0
- WRITE !?2,$$VAL^XBDIQ1(9000010.25,APCHSVL,.04)," ",?34,$$ORGR(APCHSPAT,APCHSACC,$PIECE($GET(^AUPNVMIC(APCHSVL,12)),U),APCHSVL)
- SET Y=$PIECE(APCHSN,U,9)
- XECUTE APCHSCVD
- WRITE ?68,Y,!
- QUIT
- +7 ;I APCHSANT>0 W ?3,$$VAL^XBDIQ1(9000010.25,APCHSVL,.05),?34,$P(APCHSN,U,7) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,?79,$E($P($G(^AUPNVMIC(APCHSVL,11)),U,9)),! Q
- +8 IF APCHSANT>0
- WRITE ?3,$$VAL^XBDIQ1(9000010.25,APCHSVL,.05),?34,$PIECE(APCHSN,U,7)
- SET Y=$PIECE(APCHSN,U,9)
- XECUTE APCHSCVD
- WRITE ?68,Y,!
- QUIT
- +9 ;W:'APCHSNPG ! W $P(^LAB(60,$P(APCHSN,U),0),U) S Y=(9999999-APCHSIVD) X APCHSCVD W ?58,Y,?47,$P(APCHSN,U,7) S Y=$P(APCHSN,U,9) X APCHSCVD W ?68,Y,?79,$E($P($G(^AUPNVMIC(APCHSVL,11)),U,9)),! D
- +10 IF 'APCHSNPG
- WRITE !
- WRITE $PIECE(^LAB(60,$PIECE(APCHSN,U),0),U)
- SET Y=(9999999-APCHSIVD)
- XECUTE APCHSCVD
- Begin DoDot:1
- +11 IF $PIECE(^LAB(60,$PIECE(APCHSN,U),0),U)["GRAM "
- WRITE ?34,$$GSR(APCHSPAT,APCHSACC,$PIECE($GET(^AUPNVMIC(APCHSVL,12)),U),APCHSVL)
- +12 WRITE ?58,Y
- SET Y=$PIECE(APCHSN,U,9)
- XECUTE APCHSCVD
- WRITE ?68,Y,!
- Begin DoDot:2
- +13 WRITE ?2,"Site/Specimen: ",$$SITE(APCHSPAT,APCHSACC,$PIECE($GET(^AUPNVMIC(APCHSVL,12)),U),APCHSVL),!?2,"Collection Sample: ",$$COL(APCHSPAT,APCHSACC,$PIECE($GET(^AUPNVMIC(APCHSVL,12)),U),APCHSVL),!
- End DoDot:2
- End DoDot:1
- +14 QUIT
- SITE(P,A,D,V) ;return site/specimen
- +1 IF $GET(P)=""
- QUIT ""
- +2 IF $GET(A)=""
- QUIT ""
- +3 IF $GET(D)=""
- QUIT ""
- +4 IF $GET(V)=""
- QUIT ""
- +5 IF $PIECE($GET(^AUPNVMIC(V,11)),U,3)]""
- QUIT $$VAL^XBDIQ1(9000010.25,V,1103)
- +6 NEW APCHLRDF,APCHIVD,X
- +7 SET APCHLRDF=$PIECE($GET(^DPT(P,"LR")),U)
- +8 IF APCHLRDF=""
- QUIT ""
- +9 SET APCHIVD=9999999-D
- +10 IF '$DATA(^LR(APCHLRDF,"MI",APCHIVD,0))
- QUIT ""
- +11 IF $PIECE(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A
- QUIT ""
- +12 SET X=$PIECE(^LR(APCHLRDF,"MI",APCHIVD,0),U,5)
- +13 IF 'X
- QUIT ""
- +14 IF '$DATA(^LAB(61,X,0))
- QUIT ""
- +15 QUIT $PIECE(^LAB(61,X,0),U)
- +16 ;
- COL(P,A,D,V) ;
- +1 IF $GET(P)=""
- QUIT ""
- +2 IF $GET(A)=""
- QUIT ""
- +3 IF $GET(D)=""
- QUIT ""
- +4 IF $GET(V)=""
- QUIT ""
- +5 IF $PIECE($GET(^AUPNVMIC(V,0)),U,8)]""
- QUIT $$VAL^XBDIQ1(9000010.25,V,.08)
- +6 NEW APCHLRDF,APCHIVD,X
- +7 SET APCHLRDF=$PIECE($GET(^DPT(P,"LR")),U)
- +8 IF APCHLRDF=""
- QUIT ""
- +9 SET APCHIVD=9999999-D
- +10 IF '$DATA(^LR(APCHLRDF,"MI",APCHIVD,0))
- QUIT ""
- +11 IF $PIECE(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A
- QUIT ""
- +12 SET X=$PIECE(^LR(APCHLRDF,"MI",APCHIVD,0),U,11)
- +13 IF 'X
- QUIT ""
- +14 IF '$DATA(^LAB(62,X,0))
- QUIT ""
- +15 QUIT $PIECE(^LAB(62,X,0),U)
- +16 ;
- GSR(P,A,D,V) ;
- +1 IF $GET(P)=""
- QUIT ""
- +2 IF $GET(A)=""
- QUIT ""
- +3 IF $GET(D)=""
- QUIT ""
- +4 IF $GET(V)=""
- QUIT ""
- +5 NEW APCHLRDF,APCHIVD,X,R
- +6 SET R=$$VAL^XBDIQ1(9000010.25,V,.07)
- +7 SET APCHLRDF=$PIECE($GET(^DPT(P,"LR")),U)
- +8 IF APCHLRDF=""
- QUIT ""
- +9 SET APCHIVD=9999999-D
- +10 IF '$DATA(^LR(APCHLRDF,"MI",APCHIVD,0))
- QUIT ""
- +11 IF $PIECE(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A
- QUIT ""
- +12 SET X=$GET(^LR(APCHLRDF,"MI",APCHIVD,2,1,0))
- +13 IF X=""
- QUIT ""
- +14 ;
- +15 QUIT X
- ORGR(P,A,D,V) ;
- +1 IF $GET(P)=""
- QUIT ""
- +2 IF $GET(A)=""
- QUIT ""
- +3 IF $GET(D)=""
- QUIT ""
- +4 IF $GET(V)=""
- QUIT ""
- +5 NEW APCHLRDF,APCHIVD,X,R
- +6 SET R=$$VAL^XBDIQ1(9000010.25,V,.07)
- +7 SET APCHLRDF=$PIECE($GET(^DPT(P,"LR")),U)
- +8 IF APCHLRDF=""
- QUIT ""
- +9 SET APCHIVD=9999999-D
- +10 IF '$DATA(^LR(APCHLRDF,"MI",APCHIVD,0))
- QUIT ""
- +11 IF $PIECE(^LR(APCHLRDF,"MI",APCHIVD,0),U,6)'=A
- QUIT ""
- +12 SET X=$PIECE($GET(^LR(APCHLRDF,"MI",APCHIVD,3,1,0)),U,2)
- +13 IF X=""
- QUIT ""
- +14 ;
- +15 QUIT X
