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