Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXPRO1.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/ECXPRO1.m (modified) (4 diffs)

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

@@ -1 @@
-ECXPRO1 ;ALB/GTS - Prosthetics Extract for DSS (Continued) ; 11/8/07 8:02am
- ;;3.0;DSS EXTRACTS;**9,11,13,15,21,24,33,37,39,100,105**;Dec 22, 1997;Build 70
+ECXPRO1 ;ALB/GTS - Prosthetics Extract for DSS (Continued) ; DEC 15, 2006
+ ;;3.0;DSS EXTRACTS;**9,11,13,15,21,24,33,37,39,100**;Dec 22, 1997;Build 2
  ;
 NTEG(ECXDFN,ECXLNE,ECXPIEN,ECXN0,ECXNLB,ECINST,ECXFORM) ;** Check for required fields
@@ -22 +22 @@
  ;    ECXRCST                - Receiving Station
  ;    ECXPHCPC               - PSAS HCPCS code; if 'unknown', then use CPT/HCPCS code 
- ;    ECXNPPDC               - NPPD code for repairs or new issues
  ;   Output (KILLed by NTEG)
  ;    ECXMISS                - 1 indicates missing information
@@ -28 +27 @@
  ;
  N ECXGOOD,ECXMISS
- S (ECXRCST,ECXRQST,ECXNPPDC)="",ECXGOOD=1,ECXSTAT2=$P(ECXN0,U,10)
+ S (ECXRCST,ECXRQST)="",ECXGOOD=1,ECXSTAT2=$P(ECXN0,U,10)
  I ECXSTAT2]"" D
  .K ECXDIC
@@ -46 +45 @@
  ;get psas hcpcs code from file #661.1
  S ECXPHCPC=$P($G(^RMPR(660,ECXPIEN,1)),U,4) D
- .;get nppd code for repairs and new issues 10 characters in length.
- .I "X5"[ECXTYPE S ECXNPPDC=$TR($$GET1^DIQ(661.1,ECXPHCPC_",",5)," ","_")
- .I "IR"[ECXTYPE S ECXNPPDC=$TR($$GET1^DIQ(661.1,ECXPHCPC_",",6)," ","_")
+ .;I +ECXPHCPC S ECXPHCPC=$P($G(^RMPR(661.1,ECXPHCPC,0)),U,1)
  .I +ECXPHCPC S ECXPHCPC=$E($P($G(^RMPR(661.1,ECXPHCPC,0)),U,1),1,5)
  .I ECXPHCPC="UNKNOWN" S ECXPHCPC=$E(ECXHCPCS,1,5)