Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCM13EP

APCM13EP.m

Go to the documentation of this file. 
  1. APCM13EP ; IHS/CMI/LAB - IHS MU ;
  1.  ;;1.0;IHS MU PERFORMANCE REPORTS;**2,4,5,6**;MAR 26, 2012;Build 65
  1.  ;
  1.  ;
  1. PRINT ;EP
  1.  K ^TMP($J)
  1.  S APCMIOSL=$S($G(APCMGUI):55,1:IOSL)
  1.  S APCMQUIT=""
  1.  S ^TMP($J,"APCMDEL",0)=0
  1.  I APCMROT="D" G DEL
  1.  S APCMPTYP="P"
  1.  D ^APCM13EH
  1.  S APCMGPG=0
  1.  S APCMQUIT=""
  1.  I APCMSUM="F" D PRINT1
  1.  D SUMEOP
  1.  D SUM
  1.  D W^APCM13EH(" ",0,2,APCMPTYP)
  1.  D LIST^APCM13NP
  1.  D W^APCM13EH(" ",0,2,APCMPTYP)
  1.  K ^TMP($J)
  1.  I APCMROT="P" K ^XTMP("APCM1D",APCMJ,APCMH) D EOP Q
  1.  ;
  1. DEL ;create delimited output file
  1.  D ^%ZISC
  1.  K ^TMP($J)
  1.  S ^TMP($J,"APCMDEL",0)=0
  1.  S APCMPTYP="D"
  1.  D ^APCM13EH
  1.  S APCMQUIT=""
  1.  I APCMSUM="F" D PRINT1
  1.  Q:APCMQUIT
  1.  D SUM
  1.  Q:APCMQUIT
  1.  D LIST^APCM13NP
  1.  Q:APCMQUIT
  1.  D SAVEDEL^APCM13EQ
  1.  K ^XTMP("APCM1D",APCMJ,APCMH)
  1.  K ^TMP($J)
  1.  D EOP
  1.  Q
  1. WP ;
  1.  K ^UTILITY($J,"W")
  1.  S APCMZ=0,APCMLCNT=0
  1.  S DIWL=1,DIWR=APCMCOL,DIWF="",APCMZ=0 F  S APCMZ=$O(^APCM13OB(APCMIC,APCMNODE,APCMY,1,APCMZ)) Q:APCMZ'=+APCMZ  D
  1.  .S APCMLCNT=APCMLCNT+1
  1.  .S X=^APCM13OB(APCMIC,APCMNODE,APCMY,1,APCMZ,0) S:APCMLCNT=1 X=" - "_X D ^DIWP
  1.  .Q
  1. WPS ;
  1.  S Z=0 F  S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z  D
  1.  .I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT
  1.  .D W^APCM13EH(^UTILITY($J,"W",DIWL,Z,0),0,1,APCMPTYP)
  1.  K DIWL,DIWR,DIWF,Z
  1.  K ^UTILITY($J,"W"),X
  1.  Q
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!(IOT'["TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="End of Report.  Press Enter",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;
  1. SUMEOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!(IOT'["TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="End of Full Report.  Press Enter to continue to the Summary Report.",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;
  1. PRINT1 ;EP
  1.  ;REORDER THE PROVIDERS ALPHABETICALLY
  1.  K APCMINDO
  1.  S X=0 F  S X=$O(APCMIND(X)) Q:X'=+X  D
  1.  .S C=$P(^APCM13OB(X,0),U,3)
  1.  .S O=$P(^APCM13OB(X,0),U,4)
  1.  .S APCMINDO(C,O,X)=""
  1.  I APCMRPTT=2 G PRINT1H
  1.  K APCMPROV
  1.  S X=0 F  S X=$O(APCMPRV(X)) Q:X'=+X  S APCMPROV($P(^VA(200,X,0),U),X)=""
  1.  S APCMPNAM="" F  S APCMPNAM=$O(APCMPROV(APCMPNAM)) Q:APCMPNAM=""!(APCMQUIT)  D
  1.  .S APCMPROV=0 F  S APCMPROV=$O(APCMPROV(APCMPNAM,APCMPROV)) Q:APCMPROV=""!(APCMQUIT)  D PRINT1N
  1.  Q
  1. PRINT1H ;
  1.  S APCMPNAM=$P(^DIC(4,APCMFAC,0),U,1)
  1.  S APCMPROV=APCMFAC
  1.  D PRINT1N
  1.  Q
  1. PRINT1N ;REORDER THE PRINT BY CORE,ORDER THEN MENU,ORDER
  1.  I APCMPTYP="D" D HEADER1
  1.  S APCMCM="" F  S APCMCM=$O(APCMINDO(APCMCM)) Q:APCMCM=""!(APCMQUIT)  D
  1.  .S APCMMO=0 F  S APCMMO=$O(APCMINDO(APCMCM,APCMMO)) Q:APCMMO=""!(APCMQUIT)  D
  1.  ..S APCMIC=0 F  S APCMIC=$O(APCMINDO(APCMCM,APCMMO,APCMIC)) Q:APCMIC=""!(APCMQUIT)  D PRINT2
  1.  Q
  1. PRINT2 ;
  1.  I APCMPTYP="P" D HEADER Q:APCMQUIT
  1.  ;I APCMPTYP="D" D W^APCM13EH(" ",0,$S(APCMPTYP="D":2,1:1),APCMPTYP)
  1.  D W^APCM13EH("#"_$P(^APCM13OB(APCMIC,0),U,15)_"  "_$P(^APCM13OB(APCMIC,0),U,5)_", "_$$VAL^XBDIQ1(9001301.02,APCMIC,.03),0,1,APCMPTYP)
  1.  I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  D W^APCM13EH("Objective:",0,2,APCMPTYP)
  1.  S APCMNODE=11
  1.  S APCMX=0 F  S APCMX=$O(^APCM13OB(APCMIC,APCMNODE,APCMX)) Q:APCMX'=+APCMX!(APCMQUIT)  D
  1.  .I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  .D W^APCM13EH(^APCM13OB(APCMIC,APCMNODE,APCMX,0),0,1,APCMPTYP)
  1.  Q:APCMQUIT
  1.  I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  S APCMNODE=21
  1.  D W^APCM13EH("Stage 1 Measure:",0,2,APCMPTYP)
  1.  S APCMX=0 F  S APCMX=$O(^APCM13OB(APCMIC,APCMNODE,APCMX)) Q:APCMX'=+APCMX!(APCMQUIT)  D
  1.  .I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  .D W^APCM13EH(^APCM13OB(APCMIC,APCMNODE,APCMX,0),0,1,APCMPTYP)
  1.  Q:APCMQUIT
  1.  I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  D W^APCM13EH("CMS Denominator:",0,2,APCMPTYP)
  1.  S APCMNODE=14
  1.  S APCMX=0 F  S APCMX=$O(^APCM13OB(APCMIC,APCMNODE,APCMX)) Q:APCMX'=+APCMX!(APCMQUIT)  D
  1.  .I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  .D W^APCM13EH(^APCM13OB(APCMIC,APCMNODE,APCMX,0),0,1,APCMPTYP)
  1.  Q:APCMQUIT
  1.  I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  S APCMNODE=16
  1.  D W^APCM13EH("CMS Numerator:",0,2,APCMPTYP)
  1.  S APCMX=0 F  S APCMX=$O(^APCM13OB(APCMIC,APCMNODE,APCMX)) Q:APCMX'=+APCMX!(APCMQUIT)  D
  1.  .I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  .D W^APCM13EH(^APCM13OB(APCMIC,APCMNODE,APCMX,0),0,1,APCMPTYP)
  1.  Q:APCMQUIT
  1.  I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  S APCMNODE=18
  1.  D W^APCM13EH("IHS Logic:",0,2,APCMPTYP)
  1.  S APCMX=0 F  S APCMX=$O(^APCM13OB(APCMIC,APCMNODE,APCMX)) Q:APCMX'=+APCMX!(APCMQUIT)  D
  1.  .I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  .D W^APCM13EH(^APCM13OB(APCMIC,APCMNODE,APCMX,0),0,1,APCMPTYP)
  1.  Q:APCMQUIT
  1.  D W^APCM13EH("",0,1,APCMPTYP)
  1.  D PRNTM
  1.  Q
  1.  ;
  1. SCREEN ;
  1.  S X=0 F  S X=$O(^TMP($J,"APCMDEL",X)) Q:X'=+X  W !,^TMP($J,"APCMDEL",X)
  1.  Q
  1. EXIT ;
  1.  I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO",DIR("A")="End of report.  Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1.  ;
  1. CALC(N,O) ;ENTRY POINT
  1.  NEW Z
  1.  S Z=N-O,Z=$FN(Z,"+,",1)
  1.  Q Z
  1.  ;
  1. SB(X) ;EP - Strip 
  1.  NEW %
  1.  X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)
  1.  Q X
  1.  ;
  1. C(X,X2,X3) ;
  1.  I X'?.N Q $$RBLK^APCLUTL(X,10)
  1.  D COMMA^%DTC
  1.  Q X
  1.  ;
  1. H2 ;EP
  1.  I APCMPTYP="P" D
  1.  .D W^APCM13EH($$C(APCMCYN,0,8),0,0,APCMPTYP,,26)
  1.  .D W^APCM13EH($J(APCMCYP,5,1)_"%",0,0,APCMPTYP,,36)
  1.  .D W^APCM13EH($$C(APCMPRN,0,8),0,0,APCMPTYP,,44)
  1.  .D W^APCM13EH($J(APCMPRP,5,1)_"%",0,0,APCMPTYP,,55)
  1.  .D W^APCM13EH($G(^APCM13OB(APCMIC,13,1,0)),0,0,APCMPTYP,,64)
  1.  I APCMPTYP="D" D
  1.  .S APCMX=""
  1.  .S APCMX=+APCMCYN
  1.  .S $P(APCMX,U,2)=$$SB($J(APCMCYP,5,1))
  1.  .S $P(APCMX,U,3)=+APCMPRN
  1.  .S $P(APCMX,U,4)=$$SB($J(APCMPRP,5,1))
  1.  .S $P(APCMX,U,5)=$G(^APCM13OB(APCMIC,13,1,0))
  1.  .D W^APCM13EH(APCMX,0,0,APCMPTYP,2)
  1.  Q
  1.  ;
  1. H1 ;EP
  1.  D W^APCM13EH("Current",0,2,APCMPTYP,2,26)
  1.  D W^APCM13EH("Previous",0,0,APCMPTYP,4,44)
  1.  D W^APCM13EH("Stage 1",0,0,APCMPTYP,6,64)
  1.  D W^APCM13EH("Period",0,1,APCMPTYP,2,26)
  1.  I $P(^APCM13OB(APCMIC,0),U,6)="R" D W^APCM13EH("%",0,0,APCMPTYP,3,38)
  1.  D W^APCM13EH("Period",0,0,APCMPTYP,4,44)
  1.  I $P(^APCM13OB(APCMIC,0),U,6)="R" D W^APCM13EH("%",0,0,APCMPTYP,5,57)
  1.  D W^APCM13EH("Target",0,0,APCMPTYP,6,64)
  1.  Q
  1.  ;
  1.  ;
  1.  G:'APCMGPG HEADER1
  1.  K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCMQUIT=1 Q
  1.  ;
  1. HEADER1 ;
  1.  I APCMPTYP="P" W:$D(IOF) @IOF S APCMGPG=APCMGPG+1
  1.  I APCMPTYP="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_APCMGPG D W^APCM13EH(X,0,1,APCMPTYP)
  1.  D W^APCM13EH("Indian Health Service RPMS Suite (BCER) v1.0",1,2,APCMPTYP)
  1.  I APCMRPTT=1 D W^APCM13EH("** IHS 2013 Stage 1 Meaningful Use Performance Measure Report for EPs **",1,1,APCMPTYP)
  1.  I APCMRPTT=2 D W^APCM13EH("** IHS 2013 Stage 1 MU Performance Report for Eligible Hospitals/CAHs **",1,1,APCMPTYP)
  1.  I $G(APCMPROV),APCMRPTT=1 S X="Provider Name: "_$$SN^APCM13EH($P(^VA(200,APCMPROV,0),U,1)) D W^APCM13EH(X,1,1,APCMPTYP)
  1.  I $G(APCMPROV),APCMRPTT=2 S X="Facility Name: "_$P(^DIC(4,APCMPROV,0),U,1) D W^APCM13EH(X,1,1,APCMPTYP)
  1.  I $G(APCMTOT) S X="Aggregate Report for all Selected Providers" D W^APCM13EH(X,1,1,APCMPTYP)
  1.  I APCMRPTT=1 S X="Facility Name: "_$P(^DIC(4,DUZ(2),0),U,1) D W^APCM13EH(X,1,1,APCMPTYP)
  1.  S X="Report Period:  "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED) D W^APCM13EH(X,1,1,APCMPTYP)
  1.  I $G(APCMWPP) S X="Previous Period:  "_$$FMTE^XLFDT(APCMPBD)_" to "_$$FMTE^XLFDT(APCMPED) D W^APCM13EH(X,1,1,APCMPTYP)
  1.  S X=$$REPEAT^XLFSTR("-",80) D W^APCM13EH(X,0,1,APCMPTYP)
  1.  Q
  1.  ;
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1.  ;----------
  1. USR() ;EP - Return name .
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. PRNTM ;print 1 measure
  1.  ;APCMPROV=provider
  1.  ;APCMIC=measure ien
  1.  I APCMPTYP="P",$Y>(APCMIOSL-14) D HEADER Q:APCMQUIT
  1.  D H1
  1. PI1 ;EP
  1.  ;check exclusion field and print value if any and quit
  1.  S APCMDF=$P(^APCM13OB(APCMIC,0),U,8)
  1.  ;get DENOMINATOR value
  1.  S APCMNP=$P(^DD(9001301.0311,APCMDF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
  1.  S APCMCYD=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
  1.  S APCMPRD=$$V(2,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
  1.  ;write out DENOMINATOR
  1.  K ^UTILITY($J,"W")
  1.  S APCMZ=0
  1.  S DIWL=1,DIWR=20 F  S APCMZ=$O(^APCM13OB(APCMIC,15,APCMZ)) Q:APCMZ'=+APCMZ  D
  1.  .S (X,APCMX)=^APCM13OB(APCMIC,15,APCMZ,0) D ^DIWP
  1.  .Q
  1.  ;
  1.  I APCMPTYP="P" S APCMZ=0 F  S APCMZ=$O(^UTILITY($J,"W",DIWL,APCMZ)) Q:APCMZ'=+APCMZ  D W^APCM13EH(^UTILITY($J,"W",DIWL,APCMZ,0),0,1,APCMPTYP,1)
  1.  I APCMPTYP="D" D W^APCM13EH(APCMX,0,1,APCMPTYP)
  1.  K DIWL,DIWR,DIWF,APCMZ
  1.  K ^UTILITY($J,"W")
  1.  I APCMPTYP="P" D
  1.  .D W^APCM13EH($$C(APCMCYD,0,8),0,0,APCMPTYP,1,26)
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)'="A" D W^APCM13EH($$C(APCMPRD,0,8),0,0,APCMPTYP,1,44)
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)="A" D W^APCM13EH($$C("N/A"),0,0,APCMPTYP,1,44)
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)="A" D W^APCM13EH($G(^APCM13OB(APCMIC,13,1,0)),0,0,APCMPTYP,,64)
  1.  .D W^APCM13EH("",0,1,APCMPTYP)
  1.  I APCMPTYP="D" D
  1.  .I APCMCYD="" S APCMCYD=0
  1.  .I APCMPRD="" S APCMPRD=0
  1.  .S Y=APCMCYD_"^^"_APCMPRD
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)="A" S $P(Y,U,3)="N/A",Y=Y_U_U_$G(^APCM13OB(APCMIC,13,1,0)) D W^APCM13EH(Y,0,0,APCMPTYP,2),W^APCM13EH(" ",0,1,APCMPTYP)
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)'="A" D W^APCM13EH(Y,0,0,APCMPTYP,2)
  1. DENOMO ;
  1.  I $P(^APCM13OB(APCMIC,0),U,6)="A" G EXCL
  1.  S APCMNF=$P(^APCM13OB(APCMIC,0),U,9)
  1.  I APCMNF="" Q
  1.  S APCMNP=$P(^DD(9001301.0311,APCMNF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
  1.  D SETN
  1.  ;write header
  1.  K ^UTILITY($J,"W")
  1.  S APCMZ=0
  1.  S DIWL=1,DIWR=20 F  S APCMZ=$O(^APCM13OB(APCMIC,17,APCMZ)) Q:APCMZ'=+APCMZ  D
  1.  .S (X,APCMX)=^APCM13OB(APCMIC,17,APCMZ,0) D ^DIWP
  1.  .Q
  1.  ;
  1.  I APCMPTYP="P" S APCMZ=0 F  S APCMZ=$O(^UTILITY($J,"W",DIWL,APCMZ)) Q:APCMZ'=+APCMZ  D W^APCM13EH(^UTILITY($J,"W",DIWL,APCMZ,0),0,1,APCMPTYP,1)
  1.  I APCMPTYP="D" D W^APCM13EH(APCMX,0,1,APCMPTYP,1)
  1.  K DIWL,DIWR,DIWF,APCMZ
  1.  K ^UTILITY($J,"W")
  1.  D H2
  1. EXCL ;
  1.  S APCMZ=0 F  S APCMZ=$O(APCMADDQ("ANS",APCMIC,APCMZ)) Q:APCMZ'=+APCMZ  D
  1.  .D W^APCM13EH(" ",0,1,APCMPTYP)
  1.  .;S V=$G(APCMADDQ(APCMIC,APCMZ))
  1.  .S APCM1=0 F  S APCM1=$O(^APCM13OB(APCMIC,APCMZ,APCM1)) Q:APCM1'=+APCM1  D
  1.  ..D W^APCM13EH(^APCM13OB(APCMIC,APCMZ,APCM1,0),0,1,APCMPTYP)
  1.  .D W^APCM13EH("  "_APCMADDQ("ANS",APCMIC,APCMZ,APCMPROV),0,0,APCMPTYP,2)
  1.  S APCMEF=$P(^APCM13OB(APCMIC,0),U,11) I APCMEF]"" D
  1.  .;D H1
  1.  .S APCMNP=$P(^DD(9001301.0311,APCMEF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
  1.  .S APCMEV=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT)
  1.  .I APCMEV]"" D
  1.  ..I APCMPTYP="P",$Y>(APCMIOSL-4) D HEADER Q:APCMQUIT
  1.  ..K ^UTILITY($J,"W")
  1.  ..D W^APCM13EH(" ",0,1,APCMPTYP)
  1.  ..I APCMPTYP="P" D
  1.  ...S DIWL=1,DIWR=78,X=APCMEV
  1.  ...D ^DIWP
  1.  ...S APCMZ=0 F  S APCMZ=$O(^UTILITY($J,"W",DIWL,APCMZ)) Q:APCMZ'=+APCMZ  D W^APCM13EH(^UTILITY($J,"W",DIWL,APCMZ,0),0,1,APCMPTYP,1,0)
  1.  ...K DIWL,DIWR,DIWF,APCMZ
  1.  ..I APCMPTYP="D" D W^APCM13EH(APCMEV,0,1,APCMPTYP,2)
  1.  ..K ^UTILITY($J,"W")
  1.  D W^APCM13EH(" ",0,1,APCMPTYP)
  1.  Q
  1.  ;
  1. SETN ;EP - set numerator fields
  1.  S APCMCYN=$$V(1,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT) ;SPDX
  1.  S APCMPRN=$$V(2,APCMRPT,N,P,APCMPROV,$S($G(APCMTOT):"T",1:"I"),APCMRPTT) ;SPDX
  1.  I APCMCYN="" S APCMCYN=0
  1.  I APCMPRN="" S APCMPRN=0
  1.  Q:$P(^APCM13OB(APCMIC,0),U,6)="A"  ;no % on attestation measures
  1.  S APCMCYP=$S(APCMCYD:((APCMCYN/APCMCYD)*100),1:"")
  1.  S APCMPRP=$S(APCMPRD:((APCMPRN/APCMPRD)*100),1:"")
  1.  Q
  1.  ;
  1. V(T,R,N,P,PROV,K,RT) ;EP ;SPDX
  1.  NEW X,Y,Z,I,J
  1.  I RT=1 S I=PROV_";VA(200,"
  1.  I RT=2 S I=PROV_";AUTTLOC("
  1.  I K="T" S I="TOTAL"
  1.  I T=1 D  Q X
  1.  .S J=$O(^APCMM13C(R,$S(K="I":11,1:12),"B",I,0))
  1.  .I 'J S X=0 Q
  1.  .S X=$P($G(^APCMM13C(R,$S(K="I":11,1:12),J,N)),U,P)
  1.  I T=2 D  Q X
  1.  .S J=$O(^APCMM13P(R,$S(K="I":11,1:12),"B",I,0))
  1.  .I 'J S X=0 Q
  1.  .S X=$P($G(^APCMM13P(R,$S(K="I":11,1:12),J,N)),U,P)
  1.  Q ""
  1. SUM ;summary sheet for each provider
  1.  D SUM^APCM13ER
  1.  Q