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

APCM24NP.m

Go to the documentation of this file. 
  1. APCM24NP ;IHS/CMI/LAB - MU PRINT;
  1.  ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
  1.  ;
  1. LIST ;EP
  1.  S APCMQUIT="",APCMGPG=0
  1.  S APCMINDB=0,APCMCOUN=0
  1.  S APCMINDB=0 F  S APCMINDB=$O(APCMINDL(APCMINDB)) Q:APCMINDB'=+APCMINDB  D
  1.  .S APCMORD=$P($G(^APCM24OB(APCMINDB,0)),U,4)
  1.  .S APCMLIEN=0 F  S APCMLIEN=$O(APCMINDL(APCMINDB,APCMLIEN)) Q:APCMLIEN'=+APCMLIEN  D
  1.  ..S APCMLORD=$S(APCMRPTT=1:$P(^APCMM24L(APCMLIEN,0),U,5),1:$P(^APCMM24L(APCMLIEN,0),U,6))
  1.  ..S APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD,APCMLIEN)=""
  1.  S APCMORD=0 F  S APCMORD=$O(APCMINDL("AOI",APCMORD)) Q:APCMORD=""!(APCMQUIT)  D
  1.  .S APCMINDB=$O(APCMINDL("AOI",APCMORD,0))
  1.  .S APCMLORD=0 F  S APCMLORD=$O(APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD)) Q:APCMLORD=""!(APCMQUIT)  D
  1.  ..S APCMLIEN=$O(APCMINDL("AOI",APCMORD,APCMINDB,APCMLORD,0))
  1.  ..I '$O(APCMINDL(APCMINDB,APCMLIEN,0)) D NONE Q
  1.  ..;I '$$ANYPATS(APCMINDB,APCMINDII) D HEADER W !!,"No Patients to Report.",! Q
  1.  ..D NPL11 ;F  S APCMINDB=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMINDB)) Q:APCMINDB'=+APCMINDB!(APCMQUIT)  D NPL1
  1.  Q
  1. NONE ;
  1.  I APCMPTYP="P" D HEADER
  1.  I APCMPTYP="D" D HEADER1
  1.  D H1
  1.  D W^APCM24EH(" ",0,0,APCMPTYP)
  1.  D W^APCM24EH("Total # of patients on list: 0",0,0,APCMPTYP)
  1.  Q
  1. NPL11 ;
  1.  D
  1. NEXT .;
  1.  .;S APCMX=0 F  S APCMX=$O(^APCMM24L(APCMLIEN,11,APCMX)) Q:APCMX'=+APCMX  D
  1.  .;.I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT
  1.  .;.D W^APCM24EH(^APCMM24L(APCMLIEN,11,APCMX,0),0,1,APCMPTYP)
  1.  .D:APCMPTYP="P" HEADER D H1
  1.  .S APCMP="" F  S APCMP=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP)) Q:APCMP=""  D NEXT1
  1.  Q
  1. NEXT1 ;
  1.  S APCMPIEN=$S(APCMRPTT=1:$O(^VA(200,"B",APCMP,0)),1:$O(^DIC(4,"B",APCMP,0)))
  1.  S APCMCOUN=0,APCMPCNT=0
  1.  ;I APCMPTYP="P" D HEADER Q:APCMQUIT
  1.  S APCMCNT=APCMINDL(APCMINDB,APCMLIEN,APCMPIEN)
  1.  I APCMCNT<11!(APCMLIST'="R") S APCMCNT=1 G GO
  1.  I APCMCNT<100 S APCMCNT=APCMCNT\10 G GO
  1.  S APCMCNT=10
  1. GO ;
  1.  ;D W^APCM24EH($P(^APCM24OB(APCMINDB,0),U,5),0,1,APCMPTYP)
  1.  S APCMCOM="" F  S APCMCOM=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM)) Q:APCMCOM=""!(APCMQUIT)  D
  1.  .S APCMSEX="" F  S APCMSEX=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX)) Q:APCMSEX=""!(APCMQUIT)  D
  1.  ..S APCMAGE="" F  S APCMAGE=$O(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE)) Q:APCMAGE=""!(APCMQUIT)  D
  1.  ...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
  1.  I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT  D H1
  1.  D W^APCM24EH("Total # of patients on list: "_+$G(APCMPCNT),0,2,APCMPTYP)
  1.  D W^APCM24EH("",0,1,APCMPTYP)
  1.  Q
  1.  ;
  1. PRINTL ;print one line
  1.  Q:(APCMCOUN#APCMCNT)
  1.  I APCMPTYP="P",$Y>(APCMIOSL-3) D HEADER Q:APCMQUIT  D
  1.  .;S X=0 F  S X=$O(^APCMM24L(APCMLIEN,11,X)) Q:X'=+X  W !,^APCMM24L(APCMLIEN,11,X,0)
  1.  .D H1
  1.  Q:APCMQUIT
  1.  S APCMPCNT=APCMPCNT+1
  1.  D
  1.  .D W^APCM24EH($E($P(^DPT(DFN,0),U),1,22),0,1,APCMPTYP)
  1.  .D W^APCM24EH($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,APCMPTYP,2,24)
  1.  .D W^APCM24EH($E(APCMP,1,24),0,0,APCMPTYP,3,31)
  1.  .D W^APCM24EH(APCMCOM,0,0,APCMPTYP,4,57)
  1.  .D W^APCM24EH(APCMSEX,0,0,APCMPTYP,5,70)
  1.  .D W^APCM24EH(APCMAGE,0,0,APCMPTYP,6,75)
  1.  .D W^APCM24EH($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)
  1.  .D W^APCM24EH($P(^XTMP("APCM1D",APCMJ,APCMH,"LIST",APCMORD,APCMINDB,APCMLORD,APCMLIEN,APCMP,APCMCOM,APCMSEX,APCMAGE,DFN),"|||",2),0,0,APCMPTYP,8,40)
  1. PRINTL1 .;D W^APCM24EH(" ",0,1,APCMPTYP)
  1.  K ^TMP($J,"A")
  1.  Q
  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. HEADER1 ;
  1.  I APCMPTYP="P" W:$D(IOF) @IOF S APCMGPG=APCMGPG+1
  1.  D W^APCM24EH($$CTR("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",80),0,1,APCMPTYP)
  1.  I APCMPTYP="P" W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCMGPG,!
  1.  I APCMRPTT=1 D W^APCM24EH($$CTR("** IHS 2014/2015 Stage 2 Meaningful Use Performance Measure Report for EPs **",80),0,1,APCMPTYP)
  1.  I APCMRPTT=2 D W^APCM24EH($$CTR("** IHS 2014/2015 Stage 2 MU Performance Report for Eligible Hospitals/CAHs **",80),0,1,APCMPTYP)
  1.  D W^APCM24EH($$CTR($P(^DIC(4,DUZ(2),0),U),80),0,1,APCMPTYP)
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(APCMBD)_" to "_$$FMTE^XLFDT(APCMED) D W^APCM24EH($$CTR(X,80),0,1,APCMPTYP)
  1.  ;W !,$$CTR($P(^APCM24OB(APCMINDB,0),U,5))
  1.  D W^APCM24EH($TR($J("",80)," ","-"),0,1,APCMPTYP)
  1.  Q
  1. H1 ;
  1.  ;S X=$S(APCMLIST="A":"Entire Patient List",APCMLIST="R":"Random Patient List",1:"Patient List by Provider: "_APCMLPROV) D W^APCM24EH(X,0,1,APCMPTYP)
  1.  D W^APCM24EH($P(^APCM24OB(APCMINDB,0),U,5),0,$S(APCMPTYP="D":3,1:1),APCMPTYP)
  1.  S X=0 F  S X=$O(^APCMM24L(APCMLIEN,11,X)) Q:X'=+X  D W^APCM24EH(^APCMM24L(APCMLIEN,11,X,0),0,1,APCMPTYP)
  1.  ;S N=$S(APCMCOUN<2:22,1:22) S X=0 F  S X=$O(^APCM24OB(APCMINDB,N,X)) Q:X'=+X  D W^APCM24EH(^APCM24OB(APCMINDB,N,X,0),0,1,APCMPTYP)
  1.  D W^APCM24EH("PATIENT NAME",0,2,APCMPTYP)
  1.  D W^APCM24EH("HRN",0,0,APCMPTYP,2,24)
  1.  D W^APCM24EH($S(APCMRPTT=1:"EP",1:"HOSPITAL/CAH"),0,0,APCMPTYP,3,31)
  1.  D W^APCM24EH("COMMUNITY",0,0,APCMPTYP,4,57)
  1.  D W^APCM24EH("SEX",0,0,APCMPTYP,5,70)
  1.  D W^APCM24EH("AGE",0,0,APCMPTYP,6,75)
  1.  D W^APCM24EH("DENOM",0,$S(APCMPTYP="P":1,1:0),APCMPTYP,7,3)
  1.  D W^APCM24EH("NUMERATOR",0,0,APCMPTYP,8,40)
  1.  D W^APCM24EH($TR($J("",80)," ","-"),0,1,APCMPTYP)
  1.  Q
  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. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")