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

BDMDF1V.m

Go to the documentation of this file. 
  1. BDMDF1V ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 22 Feb 2014 3:43 PM ; 
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
  1.  ;
  1.  ;
  1. QUALCHK ;EP
  1.  ;print QUALITY DATA CHECK
  1.  ;
  1.  ;
  1. PRINT ;
  1.  ;S BDMPG=0
  1.  S BDMQUIT=0
  1.  K BDMSUM
  1.  D HEADER
  1.  I '$D(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS")) W !,"No Errors to Report." Q
  1.  D PRINT1 ;print each indicator
  1.  D EXIT
  1.  Q
  1.  ;
  1. PRINT1 ;
  1.  S BDMS1="" F  S BDMS1=$O(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",BDMS1)) Q:BDMS1=""!(BDMQUIT)  D
  1.  .S DFN="" F  S DFN=$O(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",BDMS1,DFN)) Q:DFN=""!(BDMQUIT)  D PRINT2
  1.  ;NOW PRINT SUMMARY
  1.  I $Y>IOSL-11 D HEADER Q:BDMQUIT
  1.  W !!!,$$CTR("SUMMARY OF POTENTIAL ERRORS",80),!
  1.  W !,"ERROR MESSAGE",?40,"# OF POTENTIAL ERRORS",!
  1.  S BDMX="" F  S BDMX=$O(BDMSUM(BDMX)) Q:BDMX=""  D
  1.  .W !,BDMX,?40,BDMSUM(BDMX)
  1.  W !
  1.  Q
  1. PRINT2 ;
  1.  S BDME=0 F  S BDME=$O(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",BDMS1,DFN,BDME)) Q:BDME'=+BDME!(BDMQUIT)  D
  1.  .I $Y>(BDMIOSL-4) D HEADER Q:BDMQUIT
  1.  .S T=^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",BDMS1,DFN,BDME)
  1.  .W $E($P(^DPT(DFN,0),U,1),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?34,$$DATE^BDMS9B1($$DOB^AUPNPAT(DFN)),?46,$P(^DPT(DFN,0),U,2),?50,$$AGE^AUPNPAT(DFN,BDMADAT),?59,$P(T,U,4),?71,$P(T,U,2),! ;,!?5,"ERROR:  ",$P(T,U,1),!
  1.  .;FMWP
  1.  .S X="ERROR: "_$P(T,U,1)_"-"_$P(T,U,3)
  1.  .K ^UTILITY($J,"W") S DIWL=0,DIWR=72 D ^DIWP
  1.  .W ?5,$G(^UTILITY($J,"W",0,1,0)),!
  1.  .S Y=1 F  S Y=$O(^UTILITY($J,"W",0,Y)) Q:Y'=+Y  W ?5,$G(^UTILITY($J,"W",0,Y,0)),!
  1.  .K ^UTILITY($J,"W")
  1.  .S BDMSUM($P(T,U,1))=$G(BDMSUM($P(T,U,1)))+1
  1.  Q
  1. EXIT ;
  1.  I '$G(BDMGUI) I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO",DIR("A")="End of report.  Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1.  G:'BDMPG HEADER1
  1.  W !
  1.  K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQUIT=1 Q
  1. HEADER1 ;
  1.  I BDMPG W:$D(IOF) @IOF
  1.  S BDMPG=BDMPG+1
  1.  I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"
  1.  I $G(BDMGUI) W !!
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BDMPG,!
  1.  W !,$$CTR("DIABETES AUDIT EXPORT DATA QUALITY CHECK REPORT",80),!
  1.  N BDMDHDR
  1.  S BDMDHDR="Audit Date "_$$DATE^BDMS9B1(BDMADAT)_" ("_$$DATE^BDMS9B1(BDMBDAT)_" to "_$$DATE^BDMS9B1(BDMADAT)_")"
  1.  W $$CTR(BDMDHDR,80),!
  1.  ;W $$CTR("AUDIT REPORT FOR 2018 (Audit Period "_$$DATE^BDMS9B1(BDMBDAT)_" to "_$$DATE^BDMS9B1(BDMADAT)_")"),!
  1.  S X="Facility: "_$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U) W $$CTR(X,80),!
  1.  W !,"PATIENT NAME",?22,"HRN",?34,"DOB",?46,"SEX",?50,"AGE",?59,"VALUE",?71,"ERR TYPE",!
  1.  W $TR($J("",80)," ","-"),!
  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. 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 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")
  1.  ;----------