Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXAPHA2.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• DSS_EXTRACTS-ECX/ECXAPHA2.m (modified) (2 diffs)

FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXAPHA2.m

@@ -1 @@
-ECXAPHA2 ;ALB/TMD-Pharmacy Extracts Unusual Volumes Report ; 10/18/07 2:10pm
- ;;3.0;DSS EXTRACTS;**40,49,84,104,105**;Dec 22, 1997;Build 70
+ECXAPHA2 ;ALB/TMD-Pharmacy Extracts Unusual Volumes Report ; 2/06/07 10:36am
+ ;;3.0;DSS EXTRACTS;**40,49,84,104**;Dec 22, 1997;Build 8
  ;
 EN ; entry point
@@ -12 +12 @@
  ;
 PRE ; entry point for PRE data
- N ECRFL,ECRX,ECREF,ECDATA,ECDATA1,ECPRC,IEN
- K ^TMP($J,"ECXDSS")
- ;call pharmacy api pso52ex
- D EXTRACT^PSO52EX(ECD,ECED,"ECXDSS")
- S ECREF="RF"
- ;order thru fills and refills; refill values 0 thru 11
- ;     Note:  refill 0 = original fill
- F  S ECD=$O(^TMP($J,"ECXDSS","AL",ECD)),IEN=0 Q:'ECD  Q:ECD>ECED  Q:ECXERR  F  S IEN=$O(^(ECD,IEN)),ECRFL=""  Q:'IEN  Q:ECXERR  F  S ECRFL=$O(^(IEN,ECRFL)) Q:'ECRFL  Q:ECXERR  D PRE2
- ;
- ;order thru partial fills
+ ; order through fills, refills and partial refills
+ N ECRFL,ECRX,ECREF,ECDATA,ECDATA1,ECPRC
+ S ECREF=1
+ F  S ECD=$O(^PSRX("AL",ECD)),ECRX=0 Q:'ECD  Q:ECD>ECED  Q:ECXERR  F  S ECRX=$O(^PSRX("AL",ECD,ECRX)),ECRFL="" Q:'ECRX  Q:ECXERR  F  S ECRFL=$O(^PSRX("AL",ECD,ECRX,ECRFL)) Q:ECRFL=""  Q:ECXERR  D PRE2
  S ECD=ECSD1,ECREF="P"
- F  S ECD=$O(^TMP($J,"ECXDSS","AM",ECD)),IEN=0 Q:'ECD  Q:ECD>ECED  Q:ECXERR  F  S IEN=$O(^(ECD,IEN)),ECRFL=""  Q:'IEN  Q:ECXERR  F  S ECRFL=$O(^(IEN,ECRFL)) Q:'ECRFL  Q:ECXERR  D PRE2
- K ^TMP($J,"ECXDSS")
+ F  S ECD=$O(^PSRX("AM",ECD)),ECRX=0 Q:'ECD  Q:ECD>ECED  Q:ECXERR  F  S ECRX=$O(^PSRX("AM",ECD,ECRX)),ECRFL="" Q:'ECRX  F  S ECRFL=$O(^PSRX("AM",ECD,ECRX,ECRFL)) Q:ECRFL=""  Q:ECXERR  D PRE2
  Q
  ;
 PRE2 ; get Prescription data
- I (ECREF="RF")&(ECRFL) D
- .S ECQTY=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,1)
- .S ECDS=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,1.1)
- .S ECPRC=^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,1.2)
- I (ECREF="RF")&('ECRFL) D
- .S ECQTY=+^TMP($J,"ECXDSS",IEN,7)
- .S ECDS=+^TMP($J,"ECXDSS",IEN,8)
- .S ECPRC=+^TMP($J,"ECXDSS",IEN,17)
- I ECREF="P" D
- .S ECQTY=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,.04)
- .S ECDS=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,.041)
- .S ECPRC=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,.042)
+ S ECDATA=$G(^PSRX(ECRX,0))
+ I ECRFL D
+ .S ECDATA1=$G(^PSRX(ECRX,ECREF,ECRFL,0))
+ .S ECQTY=+$P(ECDATA1,U,4)
+ .S ECDS=+$P(ECDATA1,U,10)
+ .S ECPRC=+$P(ECDATA1,U,11)
+ I 'ECRFL D
+ .S ECQTY=+$P(ECDATA,U,7)
+ .S ECDS=+$P(ECDATA,U,8)
+ .S ECPRC=+$P(ECDATA,U,17)
  ;check to see if quantity>threshold
  I ECQTY>ECTHLD D
  .S ECDAY=ECD
- .S ECDFN=$P(^TMP($J,"ECXDSS",IEN,2),U)
- .S ECDRG=+$P(^TMP($J,"ECXDSS",IEN,6),U)
+ .S ECDFN=$P(ECDATA,U,2)
+ .S ECDRG=+$P(ECDATA,U,6)
  .S ECCOST=ECQTY*ECPRC
  .D FILE Q:ECXERR