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

PXRMISE.m

Go to the documentation of this file. 
  1. PXRMISE ; SLC/PKR - Index size estimating routines. ;11/02/2009
  1.  ;;2.0;CLINICAL REMINDERS;**6,12,17**;Feb 04, 2005;Build 102
  1.  ;
  1.  ;========================================================
  1. EST ;Driver for making index counts.
  1.  N BLOCKS,FROM,FUNCTION,GBL,GLIST,IND,NE,NL,NUMGBL,RTN
  1.  N SF,TASKIT,TBLOCKS,TO,XMSUB
  1.  D SETDATA(.GBL,.GLIST,.NUMGBL,.RTN,.SF)
  1.  I +SF=-1 D ERRORMSG^PXRMISF(SF)  Q
  1.  S (NL,TBLOCKS)=0
  1.  S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Start time "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1.  S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Size Estimate for ^PXRMINDX"
  1.  F IND=1:1:NUMGBL D
  1.  . S FUNCTION="S NE=$$"_RTN(GBL(IND))
  1.  . X FUNCTION
  1.  . S BLOCKS=NE*SF(GBL(IND))
  1.  . S BLOCKS=$FN(BLOCKS,"","")+1
  1.  . S TBLOCKS=TBLOCKS+BLOCKS
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Estimates for "_GLIST(IND)
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Number of entries: "_NE
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Number of blocks: "_BLOCKS
  1.  S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Total estimated blocks: "_TBLOCKS
  1.  S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1.  S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="End time "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1.  S XMSUB="Size estimate for index global"
  1.  S FROM=$$GET1^DIQ(200,DUZ,.01)
  1.  S TO(DUZ)=""
  1.  D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
  1.  S ZTREQ="@"
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. ESTTASK ;Task the index size estimation.
  1.  N DIR,DTOUT,DUOUT,MINDT,SDTIME,X,Y
  1.  S MINDT=$$NOW^XLFDT
  1.  W !,"Queue the Clinical Reminders index size estimation."
  1.  S DIR("A",1)="Enter the date and time you want the job to start."
  1.  S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
  1.  S DIR("A")="Start the task at: "
  1.  S DIR(0)="DAU"_U_MINDT_"::RSX"
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q
  1.  S SDTIME=Y
  1.  K DIR
  1.  ;Put the task into the queue.
  1.  S ZTRTN="EST^PXRMISE"
  1.  S ZTDESC="Clinical Reminders index size estimation"
  1.  S ZTDTH=SDTIME
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  W !,"Task number ",ZTSK," queued."
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. NEOR() ;Return number of entries in OR.
  1.  ;DBIA #4180
  1.  Q $P(^OR(100,0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEPROB() ;Return number of entries in PROBLEM LIST.
  1.  ;DBIA #3837
  1.  Q $P(^AUPNPROB(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEPS() ;Return number of entries in PS(55).
  1.  N ADD,DA,DA1,DFN,DRUG,IND,NE,SDATE,SOL,STARTD,TEMP
  1.  ;DBIA #4181
  1.  S (DFN,IND,NE)=0
  1.  F  S DFN=+$O(^PS(55,DFN)) Q:DFN=0  D
  1.  .;Process Unit Dose.
  1.  . S DA=0
  1.  . F  S DA=+$O(^PS(55,DFN,5,DA)) Q:DA=0  D
  1.  .. S TEMP=$G(^PS(55,DFN,5,DA,2))
  1.  .. S STARTD=$P(TEMP,U,2)
  1.  .. I STARTD="" Q
  1.  ..;If the order is purged then SDATE is 1.
  1.  .. S SDATE=$P(TEMP,U,4)
  1.  .. I SDATE=1 Q
  1.  .. S DA1=0
  1.  .. F  S DA1=+$O(^PS(55,DFN,5,DA,1,DA1)) Q:DA1=0  D
  1.  ... S DRUG=$P(^PS(55,DFN,5,DA,1,DA1,0),U,1)
  1.  ... I DRUG="" Q
  1.  ... S NE=NE+1
  1.  .;Process the IV mutiple.
  1.  . S DA=0
  1.  . F  S DA=+$O(^PS(55,DFN,"IV",DA)) Q:DA=0  D
  1.  .. S TEMP=$G(^PS(55,DFN,"IV",DA,0))
  1.  .. S STARTD=$P(TEMP,U,2)
  1.  .. I STARTD="" Q
  1.  .. S SDATE=$P(TEMP,U,3)
  1.  .. I SDATE=1 Q
  1.  ..;Process Additives
  1.  .. S DA1=0
  1.  .. F  S DA1=+$O(^PS(55,DFN,"IV",DA,"AD",DA1)) Q:DA1=0  D
  1.  ... S ADD=$P(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1)
  1.  ... I ADD="" Q
  1.  ... S DRUG=$P($G(^PS(52.6,ADD,0)),U,2)
  1.  ... I DRUG="" Q
  1.  ... S NE=NE+1
  1.  ..;Process Solutions
  1.  .. S DA1=0
  1.  .. F  S DA1=+$O(^PS(55,DFN,"IV",DA,"SOL",DA1)) Q:DA1=0  D
  1.  ... S SOL=$P(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1)
  1.  ... I SOL="" Q
  1.  ... S DRUG=$P($G(^PS(52.7,SOL,0)),U,2)
  1.  ... I DRUG="" Q
  1.  ... S NE=NE+1
  1.  Q NE
  1.  ;
  1.  ;===============================================================
  1. NEPSRX() ;Return number of entries in PSRX
  1.  N DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP
  1.  ;DBIA #4182
  1.  S (DA,NE)=0
  1.  F  S DA=+$O(^PSRX(DA)) Q:DA=0  D
  1.  . S TEMP=$G(^PSRX(DA,0))
  1.  . S DFN=$P(TEMP,U,2)
  1.  . I DFN="" Q
  1.  . S DRUG=$P(TEMP,U,6)
  1.  . I DRUG="" Q
  1.  . S DSUP=$P(TEMP,U,8)
  1.  . I DSUP="" Q
  1.  . S RDATE=+$P($G(^PSRX(DA,2)),U,13)
  1.  . I RDATE>0 S NE=NE+1
  1.  .;Process the refill mutiple.
  1.  . S DA1=0
  1.  . F  S DA1=+$O(^PSRX(DA,1,DA1)) Q:DA1=0  D
  1.  .. S TEMP=$G(^PSRX(DA,1,DA1,0))
  1.  .. S DSUP=+$P(TEMP,U,10)
  1.  .. S RDATE=+$P(TEMP,U,18)
  1.  .. I RDATE>0 S NE=NE+1
  1.  .;Process the partial fill multiple.
  1.  . S DA1=0
  1.  . F  S DA1=+$O(^PSRX(DA,"P",DA1)) Q:DA1=0  D
  1.  .. S TEMP=$G(^PSRX(DA,"P",DA1,0))
  1.  .. S DSUP=+$P(TEMP,U,10)
  1.  .. S RDATE=+$P(TEMP,U,19)
  1.  .. I RDATE>0 S NE=NE+1
  1.  Q NE
  1.  ;
  1.  ;===============================================================
  1. NEPTF() ;Return number of entries in PTF.
  1.  N D1,DA,DATE,DFN,ICD0,ICD9,JND,NE0,NE9,TEMP70,TEMP0,TEMPP,TEMPS
  1.  ;DBIA #4177
  1.  S (DA,NE0,NE9)=0
  1.  F  S DA=+$O(^DGPT(DA)) Q:DA=0  D
  1.  . S TEMP0=$G(^DGPT(DA,0))
  1.  . S DFN=$P(TEMP0,U,1)
  1.  . I DFN="" Q
  1.  . S D1=0
  1.  . F  S D1=+$O(^DGPT(DA,"S",D1)) Q:D1=0  D
  1.  .. S TEMPS=$G(^DGPT(DA,"S",D1,0))
  1.  .. S DATE=$P(TEMPS,U,1)
  1.  .. I DATE="" Q
  1.  .. F JND=8,9,10,11,12 D
  1.  ... S ICD0=$P(TEMPS,U,JND)
  1.  ... I (ICD0'=""),$D(^ICD0(ICD0)) S NE0=NE0+1
  1.  .;
  1.  . S D1=0
  1.  . F  S D1=+$O(^DGPT(DA,"P",D1)) Q:D1=0  D
  1.  .. S TEMPP=$G(^DGPT(DA,"P",D1,0))
  1.  .. S DATE=$P(TEMPP,U,1)
  1.  .. I DATE="" Q
  1.  .. F JND=5,6,7,8,9 D
  1.  ... S ICD0=$P(TEMPP,U,JND)
  1.  ... I (ICD0'=""),$D(^ICD0(ICD0)) S NE0=NE0+1
  1.  .;
  1.  .;Discharge ICD9 codes
  1.  . I $D(^DGPT(DA,70)) D
  1.  .. S TEMP70=$G(^DGPT(DA,70))
  1.  .. F JND=10,11,16,17,18,19,20,21,22,23,24 D
  1.  ... S ICD9=$P(TEMP70,U,JND)
  1.  ... I (ICD9'=""),$D(^ICD9(ICD9)) S NE9=NE9+1
  1.  .;
  1.  .;Movement ICD9 codes
  1.  . I '$D(^DGPT(DA,"M")) Q
  1.  . S D1=0
  1.  . F  S D1=$O(^DGPT(DA,"M",D1)) Q:+D1=0  D
  1.  .. S TEMPS=$G(^DGPT(DA,"M",D1,0))
  1.  .. S DATE=$P(TEMPS,U,10)
  1.  .. I DATE="" Q
  1.  .. F JND=5,6,7,8,9,11,12,13,14,15 D
  1.  ... S ICD9=$P(TEMPS,U,JND)
  1.  ... I (ICD9'=""),$D(^ICD9(ICD9)) S NE9=NE9+1
  1.  Q NE0+NE9
  1.  ;
  1.  ;===============================================================
  1. NERAD() ;Return number of entries in RAD/NUC MED PATIENT.
  1.  N IEN,NE
  1.  ;DBIA #4183
  1.  S (IEN,NE)=0
  1.  F  S IEN=$O(^RADPT(IEN)) Q:+IEN=0  S NE=NE+$P($G(^RADPT(IEN,"DT",0)),U,4)
  1.  Q NE
  1.  ;
  1.  ;===============================================================
  1. NEVCPT() ;Return number of entries in V CPT.
  1.  ;DBIA #4176
  1.  Q $P(^AUPNVCPT(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEVHF() ;Return number of entries in V HEALTH FACTORS.
  1.  ;DBIA #4176
  1.  Q $P(^AUPNVHF(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEVIMM() ;Return number of entries in V IMMUNIZATION
  1.  ;DBIA #4176
  1.  Q $P(^AUPNVIMM(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEVIT() ;Return number of entries in GMRV VITAL MEASUREMENT
  1.  ;DBIA #4178
  1.  Q $P(^GMR(120.5,0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEVPED() ;Return number of entries in V PATIENT ED.
  1.  ;DBIA #4176
  1.  Q $P(^AUPNVPED(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEVPOV() ;Return number of entries in V POV.
  1.  ;DBIA #4176
  1.  Q $P(^AUPNVPOV(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEVSK() ;Return number of entries in V SKIN TEST.
  1.  ;DBIA #4176
  1.  Q $P(^AUPNVSK(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEVXAM() ;Return number of entries in V EXAM.
  1.  ;DBIA #4176
  1.  Q $P(^AUPNVXAM(0),U,4)
  1.  ;
  1.  ;===============================================================
  1. NEYTD() ;Return number of entries in PSYCH INSTRUMENT PATIENT
  1.  N DATE,DFN,NE,TEST
  1.  ;DBIA #4184
  1.  S (DFN,NE)=0
  1.  F  S DFN=$O(^YTD(601.2,DFN)) Q:+DFN=0  D
  1.  . S TEST=0
  1.  . F  S TEST=$O(^YTD(601.2,DFN,1,TEST)) Q:+TEST=0  D
  1.  .. S DATE=0
  1.  .. F  S DATE=$O(^YTD(601.2,DFN,1,TEST,1,DATE)) Q:+DATE=0  S NE=NE+1
  1.  Q NE
  1.  ;
  1.  ;===============================================================
  1. SETDATA(GBL,GLIST,NUMGBL,RTN,SF) ;
  1.  S NUMGBL=16
  1.  S GLIST(1)="LABORATORY TEST (CH, Anatomic Path, Micro)",GBL(1)=63
  1.  S GLIST(2)="MENTAL HEALTH",GBL(2)=601.2
  1.  S GLIST(3)="ORDER",GBL(3)=100
  1.  S GLIST(4)="PTF",GBL(4)=45
  1.  S GLIST(5)="PHARMACY PATIENT",GBL(5)=55
  1.  S GLIST(6)="PRESCRIPTION",GBL(6)=52
  1.  S GLIST(7)="PROBLEM LIST",GBL(7)=9000011
  1.  S GLIST(8)="RADIOLOGY",GBL(8)=70
  1.  S GLIST(9)="V CPT",GBL(9)=9000010.18
  1.  S GLIST(10)="V EXAM",GBL(10)=9000010.13
  1.  S GLIST(11)="V HEALTH FACTORS",GBL(11)=9000010.23
  1.  S GLIST(12)="V IMMUNIZATION",GBL(12)=9000010.11
  1.  S GLIST(13)="V PATIENT ED",GBL(13)=9000010.16
  1.  S GLIST(14)="V POV",GBL(14)=9000010.07
  1.  S GLIST(15)="V SKIN TEST",GBL(15)=9000010.12
  1.  S GLIST(16)="VITAL MEASUREMENT",GBL(16)=120.5
  1.  S RTN(45)="NEPTF^PXRMISE"
  1.  S RTN(52)="NEPSRX^PSO52CLR"
  1.  S RTN(55)="NEPS^PSSCLINR"
  1.  S RTN(63)="NELR^PXRMLABS"
  1.  S RTN(70)="NERAD^PXRMISE"
  1.  S RTN(100)="NEOR^PXRMISE"
  1.  S RTN(120.5)="NEVIT^PXRMISE"
  1.  S RTN(601.2)="NEYTD^PXRMISE"
  1.  S RTN(9000011)="NEPROB^PXRMISE"
  1.  S RTN(9000010.07)="NEVPOV^PXRMISE"
  1.  S RTN(9000010.11)="NEVIMM^PXRMISE"
  1.  S RTN(9000010.12)="NEVSK^PXRMISE"
  1.  S RTN(9000010.13)="NEVXAM^PXRMISE"
  1.  S RTN(9000010.16)="NEVPED^PXRMISE"
  1.  S RTN(9000010.18)="NEVCPT^PXRMISE"
  1.  S RTN(9000010.23)="NEVHF^PXRMISE"
  1.  D LSF^PXRMISF(.SF)
  1.  Q
  1.  ;