Routine: APCM13E7

APCM13E7 ;IHS/CMI/LAB - IHS MU;

 ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11

ROIH ;EP

 NEW X

 S X=$O(^APCM13OB("B","S1.010.H",0))

 I '$D(APCMIND(X)) Q  ;don't bother as this measure isn't in the report

 NEW APCMD,APCMX,APCMPAT,X,APCMP

 K APCMECHI

 S X=APCMFAC S APCMECHI(X,1)=""

 S X=APCMFAC S APCMECHI(X,2)=""

 ;LOOP THROUGH ROI AND IF I FIND 1 FOR THE HOSPITAL

 S APCMD=$$FMADD^XLFDT(APCMBD,-1)

 S APCM4D=$$FMADD^XLFDT(APCMED,-4)

 F  S APCMD=$O(^BRNREC("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCM4D)  D

 .S APCMX=0 F  S APCMX=$O(^BRNREC("B",APCMD,APCMX)) Q:APCMX'=+APCMX  D

 ..Q:$P($G(^BRNREC(APCMX,11)),U,1)'="E"  ;not an electronic request

 ..S APCMPAT=$P($G(^BRNREC(APCMX,0)),U,3)

 ..K APCMVSTS,APCMHVTP

 ..D ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMED,-365),APCMED,"APCMVSTS")

 ..S APCMP=APCMFAC  D

 ...S APCMHV=$$HADVH^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMED,-365),APCMED,.APCMVSTS)

 ...Q:'APCMHV

 ...K APCMECHI(APCMP,1)  ;had a visit with this patient and thus had a request, so no exclusion

 Q:'$G(APCMWPP)

 S APCMD=$$FMADD^XLFDT(APCMPBD,-1)

 S APCM4D=$$FMADD^XLFDT(APCMPED,-4)

 F  S APCMD=$O(^BRNREC("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCM4D)  D

 .S APCMX=0 F  S APCMX=$O(^BRNREC("B",APCMD,APCMX)) Q:APCMX'=+APCMX  D

 ..Q:$P($G(^BRNREC(APCMX,11)),U,1)'="E"  ;not an electronic request

 ..S APCMPAT=$P($G(^BRNREC(APCMX,0)),U,3)

 ..K APCMVSTS,APCMHVTP

 ..D ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMPED,-365),APCMPED,"APCMVSTS")

 ..S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D

 ...S APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMPED,-365),APCMPED,.APCMVSTS)

 ...Q:'APCMHV

 ...K APCMECHI(APCMP,2)  ;had a visit with this patient and thus had a request, so no exclusion

LAB ;EP - CALCULATE LAB

 ;for each provider or for the facility count all labs that meet criteria and if it is not written it meets numerator

 K ^TMP($J,"PATSRX")

 K APCMLABS

 D TOTLAB

 NEW APCMP,N,F

 S (APCMD1,APCMN1)=0

 I APCMRPTT=2 S APCMP=APCMFAC  D

 .;I '$P($G(APCMLABS(APCMP)),U,1) S F=$P(^APCM13OB(APCMIC,0),U,11) D S^APCM13E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she did not order any lab tests with results during the time period.",APCMP,APCMRPTT,APCMTIME,F,1) Q

 .;set denominator value into field

 .S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure

 .S N=$P($G(APCMLABS(APCMP)),U,1)  ;returns # of LABS^# not Structured data

 .D S^APCM13E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)

 .;now set patient list for this provider

 .S P=0 F  S P=$O(^TMP($J,"PATSRX",APCMP,P)) Q:P'=+P  D

 ..;Q:'$P(^TMP($J,"PATSRX",APCMP,P),U,1)

 ..I $P(^TMP($J,"PATSRX",APCMP,P),U,1)=$P(^TMP($J,"PATSRX",APCMP,P),U,2) S APCMVALU="# Labs: "_$P(^TMP($J,"PATSRX",APCMP,P),U,1)_"|||"_" # w/structured result: "_+$P(^TMP($J,"PATSRX",APCMP,P),U,2)_"|||1" D  Q

 ...S DFN=P D SETLIST^APCM13E1 Q

 ..S S="",APCMVALU="No Structured Result: "

 ..F  S S=$O(^TMP($J,"PATSRX",APCMP,P,"SCRIPTS",S)) Q:S=""  D

 ...I '$D(^TMP($J,"PATSRX",APCMP,P,"ELEC",S)) D

 ....S APCMVALU=APCMVALU_S_";"

 ..S DFN=P,APCMVALU="# of Labs: "_$P(^TMP($J,"PATSRX",APCMP,P),U,1)_" # w/structured results: "_+$P(^TMP($J,"PATSRX",APCMP,P),U,2)_"|||"_APCMVALU,$P(APCMVALU,"|||",3)=0 D SETLIST^APCM13E1

 .;numerator?

 .S F=$P(^APCM13OB(APCMIC,0),U,9)

 .S N=$P($G(APCMLABS(APCMP)),U,2)

 .D S^APCM13E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)

 K ^TMP($J,"PATSRX")

TOTLAB ;EP -

 ;SET ARRAY APCMLABS to APCMLABS(prov ien)=denom^numer

 ;IF DENOM =0 THEN PROVIDER EXCLUSION

 NEW ID,C,Y,X,D,S,N,A,B,R,PAT,D,APCMLAB1,PAT

 K APCMLAB1

 S C=0,N=0

 S LABSNO=""

 S T=$O(^ATXLAB("B","BGP PAP SMEAR TAX",0))

 S (ID,SD)=$$FMADD^XLFDT(APCMBDAT,-365),ID=ID_".99999"

 F  S ID=$O(^AUPNVSIT("B",ID)) Q:ID'=+ID  D

 .S X=0 F  S X=$O(^AUPNVSIT("B",ID,X)) Q:X'=+X  D

 ..K APCMLAB1

 ..S PAT=$P(^AUPNVSIT(X,0),U,5)

 ..Q:'$D(^AUPNVLAB("AD",X))  ;no labs

 ..Q:$P(^AUPNVSIT(X,0),U,6)'=APCMFAC

 ..I '$$HOSER^APCM13E6(X,APCMFAC),$P(^AUPNVSIT(X,0),U,7)'="I" Q  ;not a H or 30 or I

 ..S D=$$VD^APCLV(X)

 ..S Y=0 F  S Y=$O(^AUPNVLAB("AD",X,Y)) Q:Y'=+Y  D

 ...Q:$P($P($G(^AUPNVLAB(Y,12)),U,1),".")>APCMEDAT  ;ordered after end date

 ...I $P($G(^AUPNVLAB(Y,12)),U,1)]"" Q:$P($P($G(^AUPNVLAB(Y,12)),U,1),".")<APCMBDAT  ;ordered before beg date

 ...S A=$P(^AUPNVLAB(Y,0),U,1)

 ...I T,$D(^ATXLAB(T,21,"B",A)) Q   ;it's a pap smear

 ...I $$UP^XLFSTR($P(^AUPNVLAB(Y,0),U,4))="CANC" Q  ;it's cancelled

 ...S APCMLAB1(Y)=D_"^"_$$VAL^XBDIQ1(9000010.09,Y,.01)_"^"_$$VAL^XBDIQ1(9000010.09,Y,.04)_"^"_Y_"^"_$P(^AUPNVLAB(Y,0),U,3)

 ..;now go back through the labs and count or not count them

 ..S Y=0 F  S Y=$O(APCMLAB1(Y)) Q:Y'=+Y  D

 ...Q:$P(APCMLAB1(Y),U,10)]""  ;already processed this one

 ...;is this a panel and if so do panel check

 ...S PAR=$P($G(^AUPNVLAB(Y,12)),U,8)

 ...I PAR S $P(APCMLAB1(Y),U,10)="HAS PARENT SKIP/EXCL" Q  ;has a parent, will deal with parent

 ...D SETDENL

 ...;now check numerator

 ...;if panel do panel check for 1 test that is resulted

 ...I $O(^LAB(60,A,2,0)) D PANEL Q

 ...Q:$P($G(^AUPNVLAB(Y,11)),U,9)'="R"  ;if status not resulted it doesn't make the numerator

 ...I $$UP^XLFSTR($P(^AUPNVLAB(Y,0),U,4))="COMMENT",'$$HASCOM(Y) Q

 ...S $P(APCMLABS(APCMFAC),U,2)=$P(APCMLABS(APCMFAC),U,2)+1

 ...S $P(^TMP($J,"PATSRX",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,2)+1 S ^TMP($J,"PATSRX",APCMFAC,PAT,"ELEC",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""  ;S N=N+G Q  ;S N=N+G

PANEL ;

 ;find all children and find at least one with a result, if one found set numerator

 NEW X,Z,G,P

 S G=0

 S X=0 F  S X=$O(APCMLAB1(X)) Q:X'=+X!(G)  D

 .S P=$P($G(^AUPNVLAB(X,12)),U,8)

 .I P'=Y Q  ;not a member of this panel

 .I $P($G(^AUPNVLAB(Y,11)),U,9)'="R" S $P(APCMLAB1(X),U,10)="NOT RESULTED" Q

 .I $$UP^XLFSTR($P(^AUPNVLAB(X,0),U,4))="COMMENT",'$$HASCOM(X) S $P(APCMLAB1(X),U,10)="comment/no comments" Q

 .S G=1

 Q:'G

 S $P(APCMLABS(APCMFAC),U,2)=$P(APCMLABS(APCMFAC),U,2)+1

 S $P(^TMP($J,"PATSRX",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,2)+1 S ^TMP($J,"PATSRX",APCMFAC,PAT,"ELEC",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""  ;S N=N+G Q  ;S N=N+G

HASCOM(L) ;ARE THERE ANY COMMENTS

 I '$D(^AUPNVLAB(L,21)) Q 0  ;no comment multiple

 NEW B,G

 S G=0

 S B=0 F  S B=$O(^AUPNVLAB(L,21,B)) Q:B'=+B  I ^AUPNVLAB(L,21,B,0)]"" S G=1  ;has comment

Q G

SETDENL ;

 S $P(APCMLAB1(Y),U,10)=1  ;processed this test

 I '$D(APCMLABS(APCMFAC)) S APCMLABS(APCMFAC)=""

 S $P(APCMLABS(APCMFAC),U,1)=$P(APCMLABS(APCMFAC),U,1)+1

 S $P(^TMP($J,"PATSRX",APCMFAC,PAT),U,1)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,1)+1,^TMP($J,"PATSRX",APCMFAC,PAT,"SCRIPTS",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""

APCM13E7  ;IHS/CMI/LAB - IHS MU;

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11

 +2       ;

ROIH      ;EP

 +1        NEW X

 +2        SET X=$ORDER(^APCM13OB("B","S1.010.H",0))

 +3       ;don't bother as this measure isn't in the report

           IF '$DATA(APCMIND(X))

               QUIT

 +4        NEW APCMD,APCMX,APCMPAT,X,APCMP

 +5        KILL APCMECHI

 +6        SET X=APCMFAC

           SET APCMECHI(X,1)=""

 +7        SET X=APCMFAC

           SET APCMECHI(X,2)=""

 +8       ;LOOP THROUGH ROI AND IF I FIND 1 FOR THE HOSPITAL

 +9        SET APCMD=$$FMADD^XLFDT(APCMBD,-1)

 +10       SET APCM4D=$$FMADD^XLFDT(APCMED,-4)

 +11       FOR

               SET APCMD=$ORDER(^BRNREC("B",APCMD))

               IF APCMD'=+APCMD!(APCMD>APCM4D)

                   QUIT

               Begin DoDot:1

 +12               SET APCMX=0

FOR

                       SET APCMX=$ORDER(^BRNREC("B",APCMD,APCMX))

                       IF APCMX'=+APCMX

                           QUIT

                       Begin DoDot:2

 +13      ;not an electronic request

                           IF $PIECE($GET(^BRNREC(APCMX,11)),U,1)'="E"

                               QUIT

 +14                       SET APCMPAT=$PIECE($GET(^BRNREC(APCMX,0)),U,3)

 +15                       KILL APCMVSTS,APCMHVTP

 +16                       DO ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMED,-365),APCMED,"APCMVSTS")

 +17                       SET APCMP=APCMFAC

                           Begin DoDot:3

 +18                           SET APCMHV=$$HADVH^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMED,-365),APCMED,.APCMVSTS)

 +19                           IF 'APCMHV

                                   QUIT

 +20      ;had a visit with this patient and thus had a request, so no exclusion

                               KILL APCMECHI(APCMP,1)

                           End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       IF '$GET(APCMWPP)

               QUIT

 +22       SET APCMD=$$FMADD^XLFDT(APCMPBD,-1)

 +23       SET APCM4D=$$FMADD^XLFDT(APCMPED,-4)

 +24       FOR

               SET APCMD=$ORDER(^BRNREC("B",APCMD))

               IF APCMD'=+APCMD!(APCMD>APCM4D)

                   QUIT

               Begin DoDot:1

 +25               SET APCMX=0

FOR

                       SET APCMX=$ORDER(^BRNREC("B",APCMD,APCMX))

                       IF APCMX'=+APCMX

                           QUIT

                       Begin DoDot:2

 +26      ;not an electronic request

                           IF $PIECE($GET(^BRNREC(APCMX,11)),U,1)'="E"

                               QUIT

 +27                       SET APCMPAT=$PIECE($GET(^BRNREC(APCMX,0)),U,3)

 +28                       KILL APCMVSTS,APCMHVTP

 +29                       DO ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMPED,-365),APCMPED,"APCMVSTS")

 +30                       SET APCMP=0

FOR

                               SET APCMP=$ORDER(APCMPRV(APCMP))

                               IF APCMP'=+APCMP

                                   QUIT

                               Begin DoDot:3

 +31                               SET APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMPED,-365),APCMPED,.APCMVSTS)

 +32                               IF 'APCMHV

                                       QUIT

 +33      ;had a visit with this patient and thus had a request, so no exclusion

                                   KILL APCMECHI(APCMP,2)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34       QUIT

LAB       ;EP - CALCULATE LAB

 +1       ;for each provider or for the facility count all labs that meet criteria and if it is not written it meets numerator

 +2        KILL ^TMP($JOB,"PATSRX")

 +3        KILL APCMLABS

 +4        DO TOTLAB

 +5        NEW APCMP,N,F

 +6        SET (APCMD1,APCMN1)=0

 +7        IF APCMRPTT=2

               SET APCMP=APCMFAC

               Begin DoDot:1

 +8       ;I '$P($G(APCMLABS(APCMP)),U,1) S F=$P(^APCM13OB(APCMIC,0),U,11) D S^APCM13E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she did not order any lab tests with results during the time period.",APCMP,APCMRPTT,APCMTIME,F,1) Q

 +9       ;set denominator value into field

 +10      ;denom field for this measure

                   SET F=$PIECE(^APCM13OB(APCMIC,0),U,8)

 +11      ;returns # of LABS^# not Structured data

                   SET N=$PIECE($GET(APCMLABS(APCMP)),U,1)

 +12               DO S^APCM13E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)

 +13      ;now set patient list for this provider

 +14               SET P=0

FOR

                       SET P=$ORDER(^TMP($JOB,"PATSRX",APCMP,P))

                       IF P'=+P

                           QUIT

                       Begin DoDot:2

 +15      ;Q:'$P(^TMP($J,"PATSRX",APCMP,P),U,1)

 +16                       IF $PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)=$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)

                               SET APCMVALU="# Labs: "_$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)_"|||"_" # w/structured result: "_+$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)_"|||1"

                               Begin DoDot:3

 +17                               SET DFN=P

                                   DO SETLIST^APCM13E1

                                   QUIT

                               End DoDot:3

                               QUIT

 +18                       SET S=""

                           SET APCMVALU="No Structured Result: "

 +19                       FOR

                               SET S=$ORDER(^TMP($JOB,"PATSRX",APCMP,P,"SCRIPTS",S))

                               IF S=""

                                   QUIT

                               Begin DoDot:3

 +20                               IF '$DATA(^TMP($JOB,"PATSRX",APCMP,P,"ELEC",S))

                                       Begin DoDot:4

 +21                                       SET APCMVALU=APCMVALU_S_";"

                                       End DoDot:4

                               End DoDot:3

 +22                       SET DFN=P

                           SET APCMVALU="# of Labs: "_$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)_" # w/structured results: "_+$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)_"|||"_APCMVALU

                           SET $PIECE(APCMVALU,"|||",3)=0

                           DO SETLIST^APCM13E1

                       End DoDot:2

 +23      ;numerator?

 +24               SET F=$PIECE(^APCM13OB(APCMIC,0),U,9)

 +25               SET N=$PIECE($GET(APCMLABS(APCMP)),U,2)

 +26               DO S^APCM13E1(APCMRPT,APCMIC,+N,APCMP,APCMRPTT,APCMTIME,F)

               End DoDot:1

 +27       KILL ^TMP($JOB,"PATSRX")

 +28       QUIT

TOTLAB    ;EP -

 +1       ;SET ARRAY APCMLABS to APCMLABS(prov ien)=denom^numer

 +2       ;IF DENOM =0 THEN PROVIDER EXCLUSION

 +3        NEW ID,C,Y,X,D,S,N,A,B,R,PAT,D,APCMLAB1,PAT

 +4        KILL APCMLAB1

 +5        SET C=0

           SET N=0

 +6        SET LABSNO=""

 +7        SET T=$ORDER(^ATXLAB("B","BGP PAP SMEAR TAX",0))

 +8        SET (ID,SD)=$$FMADD^XLFDT(APCMBDAT,-365)

           SET ID=ID_".99999"

 +9        FOR

               SET ID=$ORDER(^AUPNVSIT("B",ID))

               IF ID'=+ID

                   QUIT

               Begin DoDot:1

 +10               SET X=0

FOR

                       SET X=$ORDER(^AUPNVSIT("B",ID,X))

                       IF X'=+X

                           QUIT

                       Begin DoDot:2

 +11                       KILL APCMLAB1

 +12                       SET PAT=$PIECE(^AUPNVSIT(X,0),U,5)

 +13      ;no labs

                           IF '$DATA(^AUPNVLAB("AD",X))

                               QUIT

 +14                       IF $PIECE(^AUPNVSIT(X,0),U,6)'=APCMFAC

                               QUIT

 +15      ;not a H or 30 or I

                           IF '$$HOSER^APCM13E6(X,APCMFAC)

                               IF $PIECE(^AUPNVSIT(X,0),U,7)'="I"

                                   QUIT

 +16                       SET D=$$VD^APCLV(X)

 +17                       SET Y=0

FOR

                               SET Y=$ORDER(^AUPNVLAB("AD",X,Y))

                               IF Y'=+Y

                                   QUIT

                               Begin DoDot:3

 +18      ;ordered after end date

                                   IF $PIECE($PIECE($GET(^AUPNVLAB(Y,12)),U,1),".")>APCMEDAT

                                       QUIT

 +19      ;ordered before beg date

                                   IF $PIECE($GET(^AUPNVLAB(Y,12)),U,1)]""

                                       IF $PIECE($PIECE($GET(^AUPNVLAB(Y,12)),U,1),".")<APCMBDAT

                                           QUIT

 +20                               SET A=$PIECE(^AUPNVLAB(Y,0),U,1)

 +21      ;it's a pap smear

                                   IF T

                                       IF $DATA(^ATXLAB(T,21,"B",A))

                                           QUIT

 +22      ;it's cancelled

                                   IF $$UP^XLFSTR($PIECE(^AUPNVLAB(Y,0),U,4))="CANC"

                                       QUIT

 +23                               SET APCMLAB1(Y)=D_"^"_$$VAL^XBDIQ1(9000010.09,Y,.01)_"^"_$$VAL^XBDIQ1(9000010.09,Y,.04)_"^"_Y_"^"_$PIECE(^AUPNVLAB(Y,0),U,3)

                               End DoDot:3

 +24      ;now go back through the labs and count or not count them

 +25                       SET Y=0

FOR

                               SET Y=$ORDER(APCMLAB1(Y))

                               IF Y'=+Y

                                   QUIT

                               Begin DoDot:3

 +26      ;already processed this one

                                   IF $PIECE(APCMLAB1(Y),U,10)]""

                                       QUIT

 +27      ;is this a panel and if so do panel check

 +28                               SET PAR=$PIECE($GET(^AUPNVLAB(Y,12)),U,8)

 +29      ;has a parent, will deal with parent

                                   IF PAR

                                       SET $PIECE(APCMLAB1(Y),U,10)="HAS PARENT SKIP/EXCL"

                                       QUIT

 +30                               DO SETDENL

 +31      ;now check numerator

 +32      ;if panel do panel check for 1 test that is resulted

 +33                               IF $ORDER(^LAB(60,A,2,0))

                                       DO PANEL

                                       QUIT

 +34      ;if status not resulted it doesn't make the numerator

                                   IF $PIECE($GET(^AUPNVLAB(Y,11)),U,9)'="R"

                                       QUIT

 +35                               IF $$UP^XLFSTR($PIECE(^AUPNVLAB(Y,0),U,4))="COMMENT"

                                       IF '$$HASCOM(Y)

                                           QUIT

 +36                               SET $PIECE(APCMLABS(APCMFAC),U,2)=$PIECE(APCMLABS(APCMFAC),U,2)+1

 +37      ;S N=N+G Q  ;S N=N+G

                                   SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,2)+1

                                   SET ^TMP($JOB,"PATSRX",APCMFAC,PAT,"ELEC",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +38       QUIT

PANEL     ;

 +1       ;find all children and find at least one with a result, if one found set numerator

 +2        NEW X,Z,G,P

 +3        SET G=0

 +4        SET X=0

FOR

               SET X=$ORDER(APCMLAB1(X))

               IF X'=+X!(G)

                   QUIT

               Begin DoDot:1

 +5                SET P=$PIECE($GET(^AUPNVLAB(X,12)),U,8)

 +6       ;not a member of this panel

                   IF P'=Y

                       QUIT

 +7                IF $PIECE($GET(^AUPNVLAB(Y,11)),U,9)'="R"

                       SET $PIECE(APCMLAB1(X),U,10)="NOT RESULTED"

                       QUIT

 +8                IF $$UP^XLFSTR($PIECE(^AUPNVLAB(X,0),U,4))="COMMENT"

                       IF '$$HASCOM(X)

                           SET $PIECE(APCMLAB1(X),U,10)="comment/no comments"

                           QUIT

 +9                SET G=1

               End DoDot:1

 +10       IF 'G

               QUIT

 +11       SET $PIECE(APCMLABS(APCMFAC),U,2)=$PIECE(APCMLABS(APCMFAC),U,2)+1

 +12      ;S N=N+G Q  ;S N=N+G

           SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,2)+1

           SET ^TMP($JOB,"PATSRX",APCMFAC,PAT,"ELEC",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""

 +13       QUIT

 +14      ;

HASCOM(L) ;ARE THERE ANY COMMENTS

 +1       ;no comment multiple

           IF '$DATA(^AUPNVLAB(L,21))

               QUIT 0

 +2        NEW B,G

 +3        SET G=0

 +4       ;has comment

           SET B=0

FOR

               SET B=$ORDER(^AUPNVLAB(L,21,B))

               IF B'=+B

                   QUIT

               IF ^AUPNVLAB(L,21,B,0)]""

                   SET G=1

 +5        QUIT G

 +6       ;

SETDENL   ;

 +1       ;processed this test

           SET $PIECE(APCMLAB1(Y),U,10)=1

 +2        IF '$DATA(APCMLABS(APCMFAC))

               SET APCMLABS(APCMFAC)=""

 +3        SET $PIECE(APCMLABS(APCMFAC),U,1)=$PIECE(APCMLABS(APCMFAC),U,1)+1

 +4        SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,1)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,1)+1

           SET ^TMP($JOB,"PATSRX",APCMFAC,PAT,"SCRIPTS",$$VAL^XBDIQ1(9000010.09,Y,1201)_" "_$$VAL^XBDIQ1(9000010.09,Y,.01))=""

 +5        QUIT

APCM13E7.m