APCM13NP ;IHS/CMI/LAB - MU PRINT;
;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11
;
LIST ;EP
S APCMQUIT="",APCMGPG=0
S APCMINDB=0,APCMCOUN=0
S APCMINDB=0 F S APCMINDB=$O(APCMINDL(APCMINDB)) Q:APCMINDB'=+APCMINDB D
.S APCMORD=$P($G(^APCM13OB(APCMINDB,0)),U,4)
.S APCMLIEN=0 F S APCMLIEN=$O(APCMINDL(APCMINDB,APCMLIEN)) Q:APCMLIEN'=+APCMLIEN D
..S APCMLORD=$S(APCMRPTT=1:$P(^APCMM13L(APCMLIEN,0),U,5),1:$P(^APCMM13L(APCMLIEN,0),U,6))
..S APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD,APCMLIEN)=""
S APCMORD=0 F S APCMORD=$O(APCMINDL("AOI",APCMORD)) Q:APCMORD=""!(APCMQUIT) D
.S APCMINDB=$O(APCMINDL("AOI",APCMORD,0))
.S APCMLORD=0 F S APCMLORD=$O(APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD)) Q:APCMLORD=""!(APCMQUIT) D
..S APCMLIEN=$O(APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD,0))
..I '$O(APCMINDL(APCMINDB,APCMLIEN,0)) D NONE Q
..;I '$$ANYPATS(APCMINDB,APCMINDII) D HEADER W !!,"No Patients to Report.",! Q
..D NPL11 ;F S APCMINDB=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMINDB)) Q:APCMINDB'=+APCMINDB!(APCMQUIT) D NPL1
Q
NONE ;
I APCMPTYP="P" D HEADER
I APCMPTYP="D" D HEADER1
D H1
D W^APCM13EH(" ",0,0,APCMPTYP)
D W^APCM13EH("Total # of patients on list: 0",0,0,APCMPTYP)
Q
NPL11 ;
D
NEXT .;
.;S APCMX=0 F S APCMX=$O(^APCMM13L(APCMLIEN,11,APCMX)) Q:APCMX'=+APCMX D
.;.I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT
.;.D W^APCM13EH(^APCMM13L(APCMLIEN,11,APCMX,0),0,1,APCMPTYP)
.D:APCMPTYP="P" HEADER D H1
.S APCMP="" F S APCMP=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP)) Q:APCMP="" D NEXT1
Q
NEXT1 ;
S APCMPIEN=$S(APCMRPTT=1:$O(^VA(200,"B",APCMP,0)),1:$O(^DIC(4,"B",APCMP,0)))
S APCMCOUN=0,APCMPCNT=0
;I APCMPTYP="P" D HEADER Q:APCMQUIT
S APCMCNT=APCMINDL(APCMINDB,APCMLIEN,APCMPIEN)
I APCMCNT<11!(APCMLIST'="R") S APCMCNT=1 G GO
I APCMCNT<100 S APCMCNT=APCMCNT\10 G GO
S APCMCNT=10
GO ;
;D W^APCM13EH($P(^APCM13OB(APCMINDB,0),U,5),0,1,APCMPTYP)
S APCMCOM="" F S APCMCOM=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM)) Q:APCMCOM=""!(APCMQUIT) D
.S APCMSEX="" F S APCMSEX=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX)) Q:APCMSEX=""!(APCMQUIT) D
..S APCMAGE="" F S APCMAGE=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE)) Q:APCMAGE=""!(APCMQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE,DFN)) Q:DFN'=+DFN!(APCMQUIT) S APCMCOUN=APCMCOUN+1 D PRINTL
I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT D H1
D W^APCM13EH("Total # of patients on list: "_+$G(APCMPCNT),0,2,APCMPTYP)
D W^APCM13EH("",0,1,APCMPTYP)
Q
;
PRINTL ;print one line
Q:(APCMCOUN#APCMCNT)
I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT D
.;S X=0 F S X=$O(^APCMM13L(APCMLIEN,11,X)) Q:X'=+X W !,^APCMM13L(APCMLIEN,11,X,0)
.D H1
Q:APCMQUIT
S APCMPCNT=APCMPCNT+1
D
.D W^APCM13EH($E($P(^DPT(DFN,0),U),1,22),0,1,APCMPTYP)
.D W^APCM13EH($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,APCMPTYP,2,24)
.D W^APCM13EH($E(APCMP,1,24),0,0,APCMPTYP,3,31)
.D W^APCM13EH(APCMCOM,0,0,APCMPTYP,4,57)
.D W^APCM13EH(APCMSEX,0,0,APCMPTYP,5,70)
.D W^APCM13EH(APCMAGE,0,0,APCMPTYP,6,75)
.D W^APCM13EH($P(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE,DFN),"|||",1),0,$S(APCMPTYP="P":1,1:0),APCMPTYP,7,1)
.D W^APCM13EH($P(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE,DFN),"|||",2),0,0,APCMPTYP,8,40)
PRINTL1 .;D W^APCM13EH(" ",0,1,APCMPTYP)
K ^TMP($J,"A")
Q
;
G:'APCMGPG HEADER1
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
I APCMPTYP="P" W:$D(IOF) @IOF S APCMGPG=APCMGPG+1
D W^APCM13EH($$CTR("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",80),0,1,APCMPTYP)
I APCMPTYP="P" W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCMGPG,!
I APCMRPTT=1 D W^APCM13EH($$CTR("** IHS 2013 Stage 1 Meaningful Use Performance Measure Report for EPs **",80),0,1,APCMPTYP)
I APCMRPTT=2 D W^APCM13EH($$CTR("** IHS 2013 Stage 1 MU Performance Report for Eligible Hospitals/CAHs **",80),0,1,APCMPTYP)
D W^APCM13EH($$CTR($P(^DIC(4,DUZ(2),0),U),80),0,1,APCMPTYP)
S X="Reporting Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED) D W^APCM13EH($$CTR(X,80),0,1,APCMPTYP)
;W !,$$CTR($P(^APCM13OB(APCMINDB,0),U,5))
D W^APCM13EH($TR($J("",80)," ","-"),0,1,APCMPTYP)
Q
H1 ;
;S X=$S(APCMLIST="A":"Entire Patient List",APCMLIST="R":"Random Patient List",1:"Patient List by Provider: "_APCMLPROV) D W^APCM13EH(X,0,1,APCMPTYP)
D W^APCM13EH($P(^APCM13OB(APCMINDB,0),U,5),0,$S(APCMPTYP="D":3,1:1),APCMPTYP)
S X=0 F S X=$O(^APCMM13L(APCMLIEN,11,X)) Q:X'=+X D W^APCM13EH(^APCMM13L(APCMLIEN,11,X,0),0,1,APCMPTYP)
;S N=$S(APCMCOUN<2:22,1:22) S X=0 F S X=$O(^APCM13OB(APCMINDB,N,X)) Q:X'=+X D W^APCM13EH(^APCM13OB(APCMINDB,N,X,0),0,1,APCMPTYP)
D W^APCM13EH("PATIENT NAME",0,2,APCMPTYP)
D W^APCM13EH("HRN",0,0,APCMPTYP,2,24)
D W^APCM13EH($S(APCMRPTT=1:"EP",1:"HOSPITAL/CAH"),0,0,APCMPTYP,3,31)
D W^APCM13EH("COMMUNITY",0,0,APCMPTYP,4,57)
D W^APCM13EH("SEX",0,0,APCMPTYP,5,70)
D W^APCM13EH("AGE",0,0,APCMPTYP,6,75)
D W^APCM13EH("DENOM",0,$S(APCMPTYP="P":1,1:0),APCMPTYP,7,3)
D W^APCM13EH("NUMERATOR",0,0,APCMPTYP,8,40)
D W^APCM13EH($TR($J("",80)," ","-"),0,1,APCMPTYP)
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
APCM13NP ;IHS/CMI/LAB - MU PRINT;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11
+2 ;
LIST ;EP
+1 SET APCMQUIT=""
SET APCMGPG=0
+2 SET APCMINDB=0
SET APCMCOUN=0
+3 SET APCMINDB=0
FOR
SET APCMINDB=$ORDER(APCMINDL(APCMINDB))
IF APCMINDB'=+APCMINDB
QUIT
Begin DoDot:1
+4 SET APCMORD=$PIECE($GET(^APCM13OB(APCMINDB,0)),U,4)
+5 SET APCMLIEN=0
FOR
SET APCMLIEN=$ORDER(APCMINDL(APCMINDB,APCMLIEN))
IF APCMLIEN'=+APCMLIEN
QUIT
Begin DoDot:2
+6 SET APCMLORD=$SELECT(APCMRPTT=1:$PIECE(^APCMM13L(APCMLIEN,0),U,5),1:$PIECE(^APCMM13L(APCMLIEN,0),U,6))
+7 SET APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD,APCMLIEN)=""
End DoDot:2
End DoDot:1
+8 SET APCMORD=0
FOR
SET APCMORD=$ORDER(APCMINDL("AOI",APCMORD))
IF APCMORD=""!(APCMQUIT)
QUIT
Begin DoDot:1
+9 SET APCMINDB=$ORDER(APCMINDL("AOI",APCMORD,0))
+10 SET APCMLORD=0
FOR
SET APCMLORD=$ORDER(APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD))
IF APCMLORD=""!(APCMQUIT)
QUIT
Begin DoDot:2
+11 SET APCMLIEN=$ORDER(APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD,0))
+12 IF '$ORDER(APCMINDL(APCMINDB,APCMLIEN,0))
DO NONE
QUIT
+13 ;I '$$ANYPATS(APCMINDB,APCMINDII) D HEADER W !!,"No Patients to Report.",! Q
+14 ;F S APCMINDB=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMINDB)) Q:APCMINDB'=+APCMINDB!(APCMQUIT) D NPL1
DO NPL11
End DoDot:2
End DoDot:1
+15 QUIT
NONE ;
+1 IF APCMPTYP="P"
DO HEADER
+2 IF APCMPTYP="D"
DO HEADER1
+3 DO H1
+4 DO W^APCM13EH(" ",0,0,APCMPTYP)
+5 DO W^APCM13EH("Total # of patients on list: 0",0,0,APCMPTYP)
+6 QUIT
NPL11 ;
+1 Begin DoDot:1
NEXT ;
+1 ;S APCMX=0 F S APCMX=$O(^APCMM13L(APCMLIEN,11,APCMX)) Q:APCMX'=+APCMX D
+2 ;.I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT
+3 ;.D W^APCM13EH(^APCMM13L(APCMLIEN,11,APCMX,0),0,1,APCMPTYP)
+4 IF APCMPTYP="P"
DO HEADER
DO H1
+5 SET APCMP=""
FOR
SET APCMP=$ORDER(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP))
IF APCMP=""
QUIT
DO NEXT1
End DoDot:1
+6 QUIT
NEXT1 ;
+1 SET APCMPIEN=$SELECT(APCMRPTT=1:$ORDER(^VA(200,"B",APCMP,0)),1:$ORDER(^DIC(4,"B",APCMP,0)))
+2 SET APCMCOUN=0
SET APCMPCNT=0
+3 ;I APCMPTYP="P" D HEADER Q:APCMQUIT
+4 SET APCMCNT=APCMINDL(APCMINDB,APCMLIEN,APCMPIEN)
+5 IF APCMCNT<11!(APCMLIST'="R")
SET APCMCNT=1
GOTO GO
+6 IF APCMCNT<100
SET APCMCNT=APCMCNT\10
GOTO GO
+7 SET APCMCNT=10
GO ;
+1 ;D W^APCM13EH($P(^APCM13OB(APCMINDB,0),U,5),0,1,APCMPTYP)
+2 SET APCMCOM=""
FOR
SET APCMCOM=$ORDER(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM))
IF APCMCOM=""!(APCMQUIT)
QUIT
Begin DoDot:1
+3 SET APCMSEX=""
FOR
SET APCMSEX=$ORDER(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX))
IF APCMSEX=""!(APCMQUIT)
QUIT
Begin DoDot:2
+4 SET APCMAGE=""
FOR
SET APCMAGE=$ORDER(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE))
IF APCMAGE=""!(APCMQUIT)
QUIT
Begin DoDot:3
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE,DFN))
IF DFN'=+DFN!(APCMQUIT)
QUIT
SET APCMCOUN=APCMCOUN+1
DO PRINTL
End DoDot:3
End DoDot:2
End DoDot:1
+6 IF APCMPTYP="P"
IF $Y>(APCMIOSL-3)
DO HEADER
IF APCMQUIT
QUIT
DO H1
+7 DO W^APCM13EH("Total # of patients on list: "_+$GET(APCMPCNT),0,2,APCMPTYP)
+8 DO W^APCM13EH("",0,1,APCMPTYP)
+9 QUIT
+10 ;
PRINTL ;print one line
+1 IF (APCMCOUN#APCMCNT)
QUIT
+2 IF APCMPTYP="P"
IF $Y>(APCMIOSL-3)
DO HEADER
IF APCMQUIT
QUIT
Begin DoDot:1
+3 ;S X=0 F S X=$O(^APCMM13L(APCMLIEN,11,X)) Q:X'=+X W !,^APCMM13L(APCMLIEN,11,X,0)
+4 DO H1
End DoDot:1
+5 IF APCMQUIT
QUIT
+6 SET APCMPCNT=APCMPCNT+1
+7 Begin DoDot:1
+8 DO W^APCM13EH($EXTRACT($PIECE(^DPT(DFN,0),U),1,22),0,1,APCMPTYP)
+9 DO W^APCM13EH($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,APCMPTYP,2,24)
+10 DO W^APCM13EH($EXTRACT(APCMP,1,24),0,0,APCMPTYP,3,31)
+11 DO W^APCM13EH(APCMCOM,0,0,APCMPTYP,4,57)
+12 DO W^APCM13EH(APCMSEX,0,0,APCMPTYP,5,70)
+13 DO W^APCM13EH(APCMAGE,0,0,APCMPTYP,6,75)
+14 DO W^APCM13EH($PIECE(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE,DFN),"|||",1),0,$SELECT(APCMPTYP="P":1,1:0),APCMPTYP,7,1)
+15 DO W^APCM13EH($PIECE(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE,DFN),"|||",2),0,0,APCMPTYP,8,40)
PRINTL1 ;D W^APCM13EH(" ",0,1,APCMPTYP)
End DoDot:1
+1 KILL ^TMP($JOB,"A")
+2 QUIT
+3 ;
+1 IF 'APCMGPG
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCMQUIT=1
QUIT
+1 IF APCMPTYP="P"
IF $DATA(IOF)
WRITE @IOF
SET APCMGPG=APCMGPG+1
+2 DO W^APCM13EH($$CTR("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",80),0,1,APCMPTYP)
+3 IF APCMPTYP="P"
WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCMGPG,!
+4 IF APCMRPTT=1
DO W^APCM13EH($$CTR("** IHS 2013 Stage 1 Meaningful Use Performance Measure Report for EPs **",80),0,1,APCMPTYP)
+5 IF APCMRPTT=2
DO W^APCM13EH($$CTR("** IHS 2013 Stage 1 MU Performance Report for Eligible Hospitals/CAHs **",80),0,1,APCMPTYP)
+6 DO W^APCM13EH($$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),0,1,APCMPTYP)
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED)
DO W^APCM13EH($$CTR(X,80),0,1,APCMPTYP)
+8 ;W !,$$CTR($P(^APCM13OB(APCMINDB,0),U,5))
+9 DO W^APCM13EH($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,APCMPTYP)
+10 QUIT
H1 ;
+1 ;S X=$S(APCMLIST="A":"Entire Patient List",APCMLIST="R":"Random Patient List",1:"Patient List by Provider: "_APCMLPROV) D W^APCM13EH(X,0,1,APCMPTYP)
+2 DO W^APCM13EH($PIECE(^APCM13OB(APCMINDB,0),U,5),0,$SELECT(APCMPTYP="D":3,1:1),APCMPTYP)
+3 SET X=0
FOR
SET X=$ORDER(^APCMM13L(APCMLIEN,11,X))
IF X'=+X
QUIT
DO W^APCM13EH(^APCMM13L(APCMLIEN,11,X,0),0,1,APCMPTYP)
+4 ;S N=$S(APCMCOUN<2:22,1:22) S X=0 F S X=$O(^APCM13OB(APCMINDB,N,X)) Q:X'=+X D W^APCM13EH(^APCM13OB(APCMINDB,N,X,0),0,1,APCMPTYP)
+5 DO W^APCM13EH("PATIENT NAME",0,2,APCMPTYP)
+6 DO W^APCM13EH("HRN",0,0,APCMPTYP,2,24)
+7 DO W^APCM13EH($SELECT(APCMRPTT=1:"EP",1:"HOSPITAL/CAH"),0,0,APCMPTYP,3,31)
+8 DO W^APCM13EH("COMMUNITY",0,0,APCMPTYP,4,57)
+9 DO W^APCM13EH("SEX",0,0,APCMPTYP,5,70)
+10 DO W^APCM13EH("AGE",0,0,APCMPTYP,6,75)
+11 DO W^APCM13EH("DENOM",0,$SELECT(APCMPTYP="P":1,1:0),APCMPTYP,7,3)
+12 DO W^APCM13EH("NUMERATOR",0,0,APCMPTYP,8,40)
+13 DO W^APCM13EH($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,APCMPTYP)
+14 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
