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

APCM13ER.m

Go to the documentation of this file. 
  1. APCM13ER ;IHS/CMI/LAB - IHS MU REPORT; 
  1.  ;;1.0;IHS MU PERFORMANCE REPORTS;**2,4,5,6**;MAR 26, 2012;Build 65
  1.  ;
  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.  S X3=""
  1.  I X'?.N Q $$LBLK^APCLUTL(X,7)
  1.  D COMMA^%DTC
  1.  S X=$$STRIP^XLFSTR(X," ")
  1.  Q $$LBLK^APCLUTL(X,7)
  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. 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(0)="E" D ^DIR
  1.  Q
  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. 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.  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 ;EP - summary sheet for each provider
  1.  K APCMTOT
  1.  K APCMPROV
  1.  S APCMGPG=0
  1.  S APCMQUIT=""
  1.  I APCMRPTT=2 G SUMHOS
  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 SUM1,W^APCM13EH(" ",0,0,APCMPTYP) D
  1.  ..D W^APCM13EH("* Indicates Public Health Performance Measure.",0,1,APCMPTYP) ;  At least one must be",0,1,APCMPTYP),W^APCM13EH("selected in the Menu Set options.",0,1,APCMPTYP),W^APCM13EH(" ",0,1,APCMPTYP),W^APCM13EH(" ",0,1,APCMPTYP)
  1.  Q
  1. SUMHOS ;
  1.  S APCMPNAM=$P(^DIC(4,APCMFAC,0),U,1)
  1.  S APCMPROV=APCMFAC
  1.  D SUM1 D W^APCM13EH("* Indicates Public Health Performance Measure.",0,1,APCMPTYP) ;,W^APCM13EH("selected in the Menu Set options.",0,1,APCMPTYP),W^APCM13EH(" ",0,1,APCMPTYP)
  1.  Q
  1.  ;
  1. SUM1 ;
  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,10)
  1.  .I O="" Q  ;not on summary sheet
  1.  .S APCMINDO(C,O,X)=""
  1.  S APCMCM="" I APCMPTYP="P" D SUMH
  1.  I APCMPTYP="D" D
  1.  .D W^APCM13EH("Indian Health Service RPMS Suite (BCER) v1.0",0,2,APCMPTYP)
  1.  .S X="STAGE 1 "_$S(APCMRPTT=1:"EP ",1:"HOSPITAL ")_"MEANINGFUL USE PERFORMANCE REPORT SUMMARY" D W^APCM13EH(X,0,1,APCMPTYP)
  1.  .S X="Summary Report for "_APCMPNAM D W^APCM13EH(X,0,2,APCMPTYP)
  1.  .S X="^Excl^#^#^Current^Prev^Stage 1^Attest" D W^APCM13EH(X,0,2,APCMPTYP)
  1.  .S X="Performance Measure^?^Den^Num^Period^Period^Target^?" D W^APCM13EH(X,0,1,APCMPTYP)
  1.  .I APCMRPTT=1 S X=$S(APCMCM="M":"MENU SET MEASURES (EPs must meet 5 out of 10 including at least one public health",1:"CORE SET MEASURES (EPs must meet all 13)") D W^APCM13EH(X,0,2,APCMPTYP)
  1.  .I APCMRPTT=1 S X=$S(APCMCM="M":"measure (*))",1:"") D W^APCM13EH(X,0,1,APCMPTYP)
  1.  .I APCMRPTT=2 S X=$S(APCMCM="M":"MENU SET MEASURES (EHs/CAHs must meet 5 out of 10 including at least one public health",1:"CORE SET MEASURES (EHs/CAHs must meet all 12)") D W^APCM13EH(X,0,2,APCMPTYP)
  1.  .I APCMRPTT=2 S X=$S(APCMCM="M":"measure (*))",1:"") D W^APCM13EH(X,0,1,APCMPTYP)
  1.  S APCMCM="" F  S APCMCM=$O(APCMINDO(APCMCM)) Q:APCMCM=""!(APCMQUIT)  D
  1.  .I APCMCM="M" D  ; W^APCM13EH("MENU SET MEASURES",0,2,APCMPTYP)
  1.  ..I APCMRPTT=1 S X=$S(APCMCM="M":"MENU SET MEASURES (EPs must meet 5 out of 10 including at least one public",1:"CORE SET MEASURES (EPs must meet all 13)") D W^APCM13EH(X,0,2,APCMPTYP)
  1.  ..I APCMRPTT=1 S X=$S(APCMCM="M":"health measure (*))",1:"") D W^APCM13EH(X,0,1,APCMPTYP)
  1.  ..I APCMRPTT=2 S X=$S(APCMCM="M":"MENU SET MEASURES (EHs/CAHs must meet 5 out of 10 including at least one public",1:"CORE SET MEASURES (EHs/CAHs must meet all 12)") D W^APCM13EH(X,0,2,APCMPTYP)
  1.  ..I APCMRPTT=2 S X=$S(APCMCM="M":"health measure (*))",1:"") D W^APCM13EH(X,0,1,APCMPTYP)
  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 SUM2
  1.  D W^APCM13EH(" ",0,1,APCMPTYP)
  1.  Q
  1. SUM2 ;
  1.  I APCMPTYP="P",APCMGPG=0 D SUMH Q:APCMQUIT
  1.  I APCMPTYP="P",$Y>(APCMIOSL-4) D SUMH Q:APCMQUIT
  1.  ;I APCMPTYP="D" D W^APCM13EH(" ",0,2,APCMPTYP)
  1.  S APCMDF=$P(^APCM13OB(APCMIC,0),U,8)
  1.  ;get NUMERATOR 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.  I $P(^APCM13OB(APCMIC,0),U,6)="A" S (APCMPRN,APCMCYN)="" G WSUM
  1.  S APCMNF=$P(^APCM13OB(APCMIC,0),U,9)  ;numerator field
  1.  S APCMNP=$P(^DD(9001301.0311,APCMNF,0),U,4),N=$P(APCMNP,";"),P=$P(APCMNP,";",2)
  1.  D SETN
  1. WSUM ;write out line
  1.  I APCMPTYP="P",$Y>(APCMIOSL-2) D SUMH Q:APCMQUIT
  1.  I APCMPTYP="P" D
  1.  .D W^APCM13EH($S($L(APCMMO)=1:" "_APCMMO,1:APCMMO)_". "_$E($P(^APCM13OB(APCMIC,0),U,14),1,22),0,2,APCMPTYP)
  1.  .S APCMEF=$P(^APCM13OB(APCMIC,0),U,11)
  1.  .I APCMEF]"" D
  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.  ..D W^APCM13EH($S(APCMEV]"":"Yes",1:"No"),0,0,APCMPTYP,,28)
  1.  .I APCMEF="" D W^APCM13EH("N/A",0,0,APCMPTYP,,28)  ;
  1.  .D W^APCM13EH($S($P(^APCM13OB(APCMIC,0),U,6)="A":"    N/A",1:$$C(APCMCYD,0,7)),0,0,APCMPTYP,,33)
  1.  .D W^APCM13EH($S($P(^APCM13OB(APCMIC,0),U,6)="A":"    N/A",1:$$C(APCMCYN,0,7)),0,0,APCMPTYP,,42)
  1.  .D W^APCM13EH($S($P(^APCM13OB(APCMIC,0),U,6)="A":"   N/A",1:$J(APCMCYP,5,1)_"%"),0,0,APCMPTYP,,51)
  1.  .D W^APCM13EH($S($P(^APCM13OB(APCMIC,0),U,6)="A":"   N/A",1:$J(APCMPRP,5,1)_"%"),0,0,APCMPTYP,,59)
  1. TARGET .D W^APCM13EH($G(^APCM13OB(APCMIC,13,1,0)),0,0,APCMPTYP,,68)
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)'="A" D W^APCM13EH("N/A",0,0,APCMPTYP,,76)
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)="A" D W^APCM13EH(APCMCYD,0,0,APCMPTYP,,76)
  1.  I APCMPTYP="D" D
  1.  .S APCMX=APCMMO_". "_$P(^APCM13OB(APCMIC,0),U,14)
  1.  .S APCMEF=$P(^APCM13OB(APCMIC,0),U,11)
  1.  .I APCMEF]"" D
  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.  ..;S $P(APCMX,U,2)=$S(APCMRPTT=1:"Yes",1:"No")
  1.  ..S $P(APCMX,U,2)=$S(APCMEV]"":"Yes",1:"No")   ;IHS/CMI/LAB - fix display
  1.  .I APCMEF="" S $P(APCMX,U,2)="N/A"
  1.  .S $P(APCMX,U,3)=$S($P(^APCM13OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYD)
  1.  .S $P(APCMX,U,4)=$S($P(^APCM13OB(APCMIC,0),U,6)="A":"N/A",1:+APCMCYN)  ;$S($P(^APCM13OB(APCMIC,0),U,6)="A":APCMCYD,1:$$SB($J(APCMCYP,5,1))_"%")
  1.  .S $P(APCMX,U,5)=$S($P(^APCM13OB(APCMIC,0),U,6)="A":"N/A",1:$$SB($J(APCMCYP,5,1))_"%")
  1.  .S $P(APCMX,U,6)=$S($P(^APCM13OB(APCMIC,0),U,6)="A":"N/A",1:$$SB($J(APCMPRP,5,1))_"%")
  1. TARG .S $P(APCMX,U,7)=$G(^APCM13OB(APCMIC,13,1,0))
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)'="A" S $P(APCMX,U,8)="N/A"
  1.  .I $P(^APCM13OB(APCMIC,0),U,6)="A" S $P(APCMX,U,8)=APCMCYD
  1.  .D W^APCM13EH(APCMX,0,2,APCMPTYP,1)
  1.  Q
  1. SUMH ;
  1.  G:'APCMGPG SUMH1
  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. SUMH1 ;
  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: "_$P(^DIC(4,APCMPROV,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.  D W^APCM13EH("STAGE 1 "_$S(APCMRPTT=1:"EP ",1:"HOSPITAL ")_"MEANINGFUL USE PERFORMANCE REPORT SUMMARY",1,1,APCMPTYP)
  1.  ;I '$G(APCMTOT) D W^APCM13EH("Provider: "_APCMPNAM,0,2,APCMPTYP)
  1.  I $G(APCMTOT) D
  1.  .K K S X=0 F  S X=$O(APCMPRV(X)) Q:X'=+X  S K($P(^VA(200,X,0),U,1))=""
  1.  .S C=0,T=3,X="",Y=""
  1.  .F  S X=$O(K(X)) Q:X=""  D
  1.  ..I Y="" S $E(Y,3)=X Q
  1.  ..I Y]"" S $E(Y,40)=X D W^APCM13EH(Y,0,1,APCMPTYP) S Y=""
  1.  .I Y]"" D W^APCM13EH(Y,0,1,APCMPTYP)
  1.  S X=$$REPEAT^XLFSTR("-",80) D W^APCM13EH(X,0,1,APCMPTYP)
  1.  ;S X="",$E(X,40)="Current",$E(X,52)="Previous",$E(X,64)="Stage 1" D W^APCM13EH(X,0,1,APCMPTYP)
  1.  S X="",$E(X,28)="Excl",$E(X,37)="#",$E(X,46)="#",$E(X,51)="Current",$E(X,61)="Prev",$E(X,67)="Stage 1",$E(X,75)="Attest" D W^APCM13EH(X,0,1,APCMPTYP)
  1.  S X="",X="Performance Measures",$E(X,30)="?",$E(X,36)="Den",$E(X,45)="Num",$E(X,51)="Period",$E(X,60)="Period",$E(X,67)="Target",$E(X,77)="?" D W^APCM13EH(X,0,1,APCMPTYP)
  1.  D W^APCM13EH($$REPEAT^XLFSTR("-",80),0,1,APCMPTYP)
  1.  I APCMRPTT=1 S X=$S(APCMCM="M":"MENU SET MEASURES (EPs must meet 5 out of 10 including at least one public",1:"CORE SET MEASURES (EPs must meet all 13)") D W^APCM13EH(X,0,1,APCMPTYP)
  1.  I APCMRPTT=1 S X=$S(APCMCM="M":"health measure (*))",1:"") D W^APCM13EH(X,0,1,APCMPTYP)
  1.  I APCMRPTT=2 S X=$S(APCMCM="M":"MENU SET MEASURES (EHs/CAHs must meet 5 out of 10 including at least one public",1:"CORE SET MEASURES (EHs/CAHs must meet all 12)") D W^APCM13EH(X,0,1,APCMPTYP)
  1.  I APCMRPTT=2 S X=$S(APCMCM="M":"health measure (*))",1:"") D W^APCM13EH(X,0,1,APCMPTYP)
  1.  Q