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

ECXPRO1.m

Go to the documentation of this file. 
  1. ECXPRO1 ;ALB/GTS - Prosthetics Extract for DSS (Continued) ;2/27/19  15:47
  1.  ;;3.0;DSS EXTRACTS;**9,11,13,15,21,24,33,37,39,100,105,112,132,154,174,187**;Dec 22, 1997;Build 163
  1.  ;
  1.  ; Reference to ^RMPR(600, in ICR #2528
  1.  ; Reference to EN^DIQ1 in ICR #10015
  1.  ; Reference to GET1^DIQ in ICD #2056
  1.  ; Reference to ^DIC(4 in ICR #10090
  1.  ; Reference to ^RMPR(661.1 in ICR #5754
  1.  ; Reference to ^TMP supported by SACC 2.3.2.5.1 
  1.  ; Reference to $$CPT^ICPTCOD in ICR # 1995
  1.  ; Reference to ^ICPT( in ICR #5408
  1.  ;
  1. NTEG(ECXDFN,ECXLNE,ECXPIEN,ECXN0,ECXNLB,ECINST,ECXFORM) ;** Check for required fields
  1.  ;   Input
  1.  ;    ECXDFN   - ien in file #2
  1.  ;    ECXLNE   - line number variable (passed by reference)
  1.  ;    ECXPIEN  - IEN for the Prosthetics record
  1.  ;    ECXN0    - zero node of the Prosthetics record
  1.  ;    ECXNLB   - LB node of the Prosthetics record
  1.  ;    ECINST   - station number being extracted
  1.  ;    ECXFORM  - Form Requested On
  1.  ;   Output (to be KILLed by calling routine)
  1.  ;    ^TMP("ECX-PRO EXC",$J) - Array for the exception message       
  1.  ;    ECXLNE                 - The number of the next line in the msg
  1.  ;    ECXSTAT2               - Patient Station Number
  1.  ;    ECXDATE                - Delivery Date of Prosthesis
  1.  ;    ECXTYPE                - Type of Transaction work performed
  1.  ;    ECXSRCE                - Source of prosthesis
  1.  ;    ECXHCPCS               - CPT/HCPCS code for prosthesis
  1.  ;    ECXRQST                - Requesting Station
  1.  ;    ECXRCST                - Receiving Station
  1.  ;    ECXPHCPC               - PSAS HCPCS code; if 'unknown', then use CPT/HCPCS code
  1.  ;    ECXPHPCD               - PSAS HCPCS Code Description ;187
  1.  ;    ECXNPPDC               - NPPD code for repairs or new issues
  1.  ;    ECXHCPCD               - PSAS HCPCS/CPT HCPCS Description
  1.  ;   Output (KILLed by NTEG)
  1.  ;    ECXMISS                - 1 indicates missing information
  1.  ;    ECXGOOD                - 0 indicates record should not be extracted
  1.  ;
  1.  N ECXGOOD,ECXMISS
  1.  N CPTSTR ;187
  1.  S (ECXRCST,ECXRQST,ECXNPPDC)="",ECXGOOD=1,ECXSTAT2=$P(ECXN0,U,10)
  1.  I ECXSTAT2]"" D
  1.  .K ECXDIC
  1.  .S DA=ECXSTAT2,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
  1.  .D EN^DIQ1 S ECXSTAT2=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
  1.  .S:(ECINST'=$E(ECXSTAT2,1,3)) ECXGOOD=0 ;*Screen for incorrect Station
  1.  ;
  1.  ;** Screen out records
  1.  S:($P(ECXN0,U,17)'="") ECXGOOD=0 ;*SHIP/DEL is not NULL
  1.  S:($P(ECXN0,U,26)'="") ECXGOOD=0 ;*PICKUP/DEL is not NULL
  1.  S:(+($P($G(^RMPR(660,ECXPIEN,"AM")),U,2))=1) ECXGOOD=0 ;*NO ADMIN CT=1
  1.  S:(($P(ECXN0,U,15))'="") ECXGOOD=0 ;*HISTORICAL DATA is not NULL
  1.  ;
  1.  S ECXDATE=$P(ECXN0,U,12),ECXTYPE=$P(ECXN0,U,4),ECXSRCE=$P(ECXN0,U,14)
  1.  S ECXHCPCS=$P($G(^ICPT(+$P(ECXN0,U,22),0)),U,1),ECXCMOD=""
  1.  S ECXHCPCS=$$CPT^ECXUTL3(ECXHCPCS,ECXCMOD)
  1.  ;get psas hcpcs code from file #661.1
  1.  S ECXPHCPC=$P($G(^RMPR(660,ECXPIEN,1)),U,4) D
  1.  .;get nppd code for repairs and new issues 10 characters in length.
  1.  .I "X5"[ECXTYPE S ECXNPPDC=$TR($$GET1^DIQ(661.1,ECXPHCPC_",",5)," ","_")
  1.  .I "ISR"[ECXTYPE S ECXNPPDC=$TR($$GET1^DIQ(661.1,ECXPHCPC_",",6)," ","_")
  1.  .I +ECXPHCPC D  ;187 Get PSAS HCPC Code and Code Description
  1.  ..S DA=ECXPHCPC,DIC="^RMPR(661.1,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;.02"
  1.  ..D EN^DIQ1
  1.  ..S ECXPHCPC=ECXDIC(661.1,DA,.01,"I") ;Code
  1.  ..S ECXPHCPD=ECXDIC(661.1,DA,.02,"I") ;Description
  1.  ..K DIC,DIQ,DA,DR,ECXDIC
  1.  .I ECXPHCPC="UNKNOWN" S ECXPHCPC=$E(ECXHCPCS,1,5) D
  1.  .. S ECXPHPCD=$P($$CPT^ICPTCOD(ECXPHCPC,""),U,3) ; 187 Get the versioned shortname
  1.  ;
  1.  ;* Get Requesting Station Number
  1.  I ECXFORM["-3" D
  1.  .S ECXRQST=$P(ECXNLB,U,1)
  1.  .I ECXRQST]"" D
  1.  ..S DA=ECXRQST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
  1.  ..D EN^DIQ1 S ECXRQST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
  1.  S:(ECXFORM'["-3") ECXRQST=""
  1.  ;
  1.  ;* Screen out records
  1.  S:(+$P(ECXFORM,U,2)=13) ECXGOOD=0 ;*FORM REQUESTED ON = 13
  1.  ;
  1.  ;* Get Receiving Station Number
  1.  I ECXFORM["-3" D
  1.  .S ECXRCST=$P(ECXNLB,U,4)
  1.  .I ECXRCST]"" D
  1.  ..S DA=ECXRCST,DIC="^DIC(4,",DIQ(0)="I",DIQ="ECXDIC",DR=".01;99"
  1.  ..D EN^DIQ1 S ECXRCST=$G(ECXDIC(4,DA,99,"I")) K DIC,DIQ,DA,DR,ECXDIC
  1.  S:(ECXFORM'["-3") ECXRCST=""
  1.  ;
  1.  ;** Check for integrity and set up the problem variable if right DIV
  1.  I ECXGOOD D CHK
  1.  Q ECXGOOD
  1.  ;
  1. CHK ;*Check variables
  1.  ; Input
  1.  ;  Variables set in and Output from NTEG^ECXPRO1
  1.  ; Output
  1.  ;  ^TMP("ECX-PRO EXC",$J,   - Global of records with integrity problems
  1.  ;
  1.  S ECXMISS=""
  1.  I ECXSTAT2']"" S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXDFN=0 S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  ;I ECXSSN']"" S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  ;I ECXNA="    " S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXDATE']"" S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXTYPE']"" S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXSRCE']"" S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXHCPCS']"" S ECXGOOD=0 ;S ECXMISS=ECXMISS_"1" ;*HCPCS code check disabled
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXFORM["-3" D
  1.  .I ECXRQST']"" S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXFORM']"" S ECXMISS=ECXMISS_"1"
  1.  S ECXMISS=ECXMISS_U
  1.  I ECXFORM["-3" D
  1.  .I ECXRCST']"" S ECXMISS=ECXMISS_"1"
  1.  I ECXMISS'="^^^^^^^^^^" D
  1.  .S ECXGOOD=0
  1.  .D ECXMISLN^ECXPRO2(ECXMISS,.ECXLNE,ECXPIEN)
  1.  Q
  1.  ;
  1. PROSINFO(ECXDA,ECXLB,ECX0,ECXFORM) ;*Get Prosthetics Information
  1.  ;
  1.  ;  Input
  1.  ;    ECDA    - The IEN for the Prosthetics record
  1.  ;    ECX0    - The zero node of the Prosthetics record
  1.  ;    ECXLB   - The LB node of the Prosthetics record
  1.  ;    ECXFORM - The Form Requested On (to determine Lab transactions)
  1.  ;
  1.  ;  Output (to be KILLed by calling routine)
  1.  ;    ECXCTAMT   - The Cost of Transaction
  1.  ;    ECXLLC     - The Lab Labor Cost
  1.  ;    ECXLMC     - The Lab Material Cost
  1.  ;    ECXGRPR    - The AMIS Grouper number
  1.  ;    ECXBILST   - The Billing Status
  1.  ;    ECXQTY     - The Quantity
  1.  ;    ECXNCOST   - The New Cost of Transaction, implemented in Patch 174
  1.  ;    ECXNLLC    - The New Lab Labor Cost, implemented in Patch 174
  1.  ;    ECXNLMC    - The New Lab Material Cost, implemented in Patch 174
  1.  ;
  1.  N MAXAMT  ;174
  1.  S MAXAMT=$S(ECXLOGIC>2019:999999999,1:999999)  ;174
  1.  S (ECXLLC,ECXLMC,ECXCTAMT)="",ECXBILST=$P($G(^RMPR(660,ECXDA,"AM")),U,3)
  1.  S ECXQTY=$P(ECX0,U,7)
  1.  S:(+ECXQTY=0) ECXQTY=1
  1.  ;
  1.  ;- Set Quantity field to 8 chars (right-justified & padded w/zeros)
  1.  S ECXQTY=$$RJ^XLFSTR(ECXQTY,8,0)
  1.  S ECXGRPR=$P($G(^RMPR(660,ECXDA,"AMS")),U,1),ECXCTAMT=$P(ECX0,U,16)
  1.  I ECXFORM["-3" D
  1.  .S ECXCTAMT=$P(ECXLB,U,9),ECXLLC=$P(ECXLB,U,7),ECXLMC=$P(ECXLB,U,8)
  1.  ;
  1.  ;- If Stock Issue or Inventory Issue, Cost of Transaction=0
  1.  ;I $P(ECXFORM,U,2)=11!($P(ECXFORM,U,2)=12) S ECXCTAMT=0 ;154 Commented out line to allow costs to come through for inventory or stock issue
  1.  S:ECXCTAMT="" ECXCTAMT=0 S:ECXCTAMT>MAXAMT ECXCTAMT=MAXAMT
  1.  S:ECXLLC="" ECXLLC=0 S:ECXLLC>MAXAMT ECXLLC=MAXAMT
  1.  S:ECXLMC="" ECXLMC=0 S:ECXLMC>MAXAMT ECXLMC=MAXAMT
  1.  ;
  1.  ;- Round to next dollar amount
  1.  I (ECXCTAMT#1)>.50 S ECXCTAMT=(ECXCTAMT+1)\1
  1.  I (ECXLLC#1)>.50 S ECXLLC=(ECXLLC+1)\1
  1.  I (ECXLMC#1)>.50 S ECXLMC=(ECXLMC+1)\1
  1.  ;
  1.  I ECXLOGIC>2019 S ECXNCOST=ECXCTAMT S ECXNLLC=ECXLLC S ECXNLMC=ECXLMC  ;174
  1.  Q