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

BDPPLBC.m

Go to the documentation of this file. 
  1. BDPPLBC ; IHS/CMI/TMJ - LISTING OF RECORDS BY DATE RANGE & CATEGORY ;
  1.  ;;2.0;IHS PCC SUITE;**2,20**;MAY 14, 2009;Build 25
  1.  ;
  1.  ;
  1.  ;
  1.  D INFORM ;Report Explanation
  1. CAT ;
  1.  W !
  1.  K BDPPROVC
  1.  S DIR(0)="SO^O:One Provider Category;A:All Provider Categories",DIR("A")="Do you want to report on ",DIR("B")="O" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D END Q
  1.  I Y="A" G ZIS
  1.  S DIC="^BDPTCAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA
  1.  I Y=-1 G CAT
  1.  S BDPPROVC=+Y
  1. ZIS ;
  1.  S XBRC="PROC^BDPPLBC",XBRP="PRINT^BDPPLBC",XBNS="BDP",XBRX="END^BDPPLBC"
  1.  D ^XBDBQUE
  1.  D END
  1.  Q
  1. PROC ;
  1.  ;loop through file and tally by catgegory, skip inactive patients
  1.  S BDPJ=$J,BDPH=$H,BDPTCNT=0 K BDPSCNT
  1.  K ^XTMP("BDPPLBC",BDPJ,BDPH)
  1.  D XTMP^APCLOSUT("BDPPLBC","DESG PROVIDER REPORT")
  1.  S BDPX=0 F  S BDPX=$O(^BDPRECN("B",BDPX)) Q:BDPX=""  D
  1.  .I $D(BDPPROVC),BDPX'=BDPPROVC Q
  1.  .S BDPIEN=0 F  S BDPIEN=$O(^BDPRECN("B",BDPX,BDPIEN)) Q:BDPIEN=""  D
  1.  ..S DFN=$P(^BDPRECN(BDPIEN,0),U,2)
  1.  ..Q:$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)  ;inactive patients
  1.  ..S BDPD=$$VAL^XBDIQ1(90360.1,BDPIEN,.01)
  1.  ..Q:$$VAL^XBDIQ1(90360.1,BDPIEN,.03)=""
  1.  ..S ^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",$$VAL^XBDIQ1(90360.1,BDPIEN,.01),$$VAL^XBDIQ1(90360.1,BDPIEN,.03),BDPIEN)=""
  1.  ..S BDPTCNT=BDPTCNT+1 S BDPSCNT(BDPD)=$G(BDPSCNT(BDPD))+1
  1.  ..Q
  1.  .Q
  1.  Q
  1. PRINT ;PRINT RECORDS BY DATE
  1.  S BDPPG=0 K BDPQUIT
  1.  D PAGEHEAD
  1.  I '$D(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS")) W !,"No data to report." D END Q
  1.  S BDPD="" F  S BDPD=$O(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD)) Q:BDPD=""!($D(BDPQUIT))  D
  1.  .S BDPPN=0 F  S BDPPN=$O(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD,BDPPN)) Q:BDPPN=""!($D(BDPQUIT))  D
  1.  ..S BDPI=0 F  S BDPI=$O(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD,BDPPN,BDPI)) Q:BDPI=""!($D(BDPQUIT))  D
  1.  ...I $Y>(IOSL-3) D PAGEHEAD Q:$D(BDPQUIT)
  1.  ...W !,$E($$VAL^XBDIQ1(90360.1,BDPI,.01),1,20),?22,$E($$VAL^XBDIQ1(90360.1,BDPI,.02),1,20),?44,$E($$VAL^XBDIQ1(90360.1,BDPI,.03),1,20),?68,$$DATE^BDPLMDSP($$VALI^XBDIQ1(90360.1,BDPI,.05))
  1.  .I $Y>(IOSL-3) D PAGEHEAD Q:$D(BDPQUIT)
  1.  .W !,"Subcount: ",BDPSCNT(BDPD),!
  1.  I $D(BDPQUIT) G DONE
  1. DONE ;
  1.  K ^XTMP("BDPPLBC",BDPJ,BDPH)
  1.  D END
  1.  Q
  1. END ;
  1.  D EN^XBVK("BDP")
  1.  Q
  1.  ;
  1.  G:$D(BDPDEM)!($D(BDPDEMM)) HEAD2
  1.  I 'BDPPG G HEAD1
  1. HEAD2 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDPQUIT="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S BDPPG=BDPPG+1
  1.  W !,$$FMTE^XLFDT(DT),?70,"Page: ",BDPPG
  1.  W !,$$CTR("******************************************************",80)
  1.  W !,$$CTR("*        DESIGNATED PROVIDER LIST BY CATEGORY        *",80)
  1.  W !,$$CTR("******************************************************",80)
  1.  W !!,"PROVIDER CATEGORY",?22,"PATIENT NAME",?44,"LAST CURRENT PROVIDER",?68,"UPDATE DT"
  1.  W !,$$REPEAT^XLFSTR("-",79)
  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. INFORM ;Report Explanation
  1.  ;
  1.  W !,?25,"******************************",!
  1.  W ?10,"This Report prints a Listing of patients by the provider category."
  1.  W !?10,"The report output includes:",!,?10,"Category Type-Patient Name-Current Provider-Date of Last Update.",!
  1.  W ?25,"*****************************",!
  1.  Q