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

ECV3RPC.m

Go to the documentation of this file.
  1. ECV3RPC ;ALB/ACS;Event Capture Spreadsheet Data Validation ;2/5/18 11:05
  1. ;;2.0;EVENT CAPTURE;**25,47,49,61,72,131,134,139**;8 May 96;Build 7
  1. ;
  1. ;----------------------------------------------------------------------
  1. ; Validates the following Event Capture Spreadsheet Upload fields:
  1. ; 1. DSS UNIT IEN, DSS UNIT NAME (DSS UNIT NUMBER IS NO LONGER CHECKED PER PATCH 134)
  1. ; 2. ORDERING SECTION
  1. ; 3. PROCEDURE CODE
  1. ; 4. CPT Modifiers
  1. ; 5. CATEGORY
  1. ;
  1. ;----------------------------------------------------------------------
  1. ;
  1. ;--Set up error flag
  1. S ECERRFLG=0
  1. ;
  1. ;--GET DSS Unit IEN--
  1. S ECDSSIEN=""
  1. ; -Check for DSS Unit IEN first
  1. I ECUNITV'="",(ECUNITV'=+ECUNITV) D
  1. . S ECERRMSG=$P($T(DSS1^ECV3RPC),";;",2)
  1. . S ECCOLERR=ECUNITPC
  1. . D ERROR
  1. I ECUNITV,'ECERRFLG,$D(^ECD(ECUNITV,0)) S ECDSSIEN=ECUNITV
  1. I ECUNITV,'ECERRFLG,'$D(^ECD(ECUNITV,0)) D
  1. . ; DSS unit ien not found on VistA
  1. . S ECERRMSG=$P($T(DSS1^ECV3RPC),";;",2)
  1. . S ECCOLERR=ECUNITPC
  1. . D ERROR
  1. . Q
  1. ; -Check for DSS Unit Number - Starting with patch 134, DSS Unit Number is no longer checked. Entire section commented out
  1. ;I ECDCMV'="",'$D(^ECD("C",ECDCMV)) D
  1. ;. ; DSS Unit Number not found on VistA
  1. ;. S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
  1. ;. S ECCOLERR=ECDCMPC
  1. ;. D ERROR
  1. ;I 'ECERRFLG,ECDCMV'="",$D(^ECD("C",ECDCMV)) S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
  1. ;Check if the next record is a match
  1. ;I 'ECERRFLG,'ECDSSIEN,ECDCMV'="",$D(^ECD("C",ECDCMV)) D
  1. ;. S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
  1. ;. I '$D(^ECD("C",ECDCMV)) D
  1. ;. . ; DSS Unit Number not found on VistA
  1. ;. . S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
  1. ;. . S ECCOLERR=ECDCMPC
  1. ;. . D ERROR
  1. ;. . Q
  1. ; -Check for DSS Unit Name
  1. I ECDSSV'="",'$D(^ECD("B",ECDSSV)) D
  1. . S ECERRMSG=$P($T(DSS3^ECV3RPC),";;",2)
  1. . S ECCOLERR=ECDSSPC
  1. . D ERROR
  1. ;
  1. I 'ECERRFLG,'ECDSSIEN,ECDSSV'="",$D(^ECD("B",ECDSSV)) S ECDSSIEN=$O(^ECD("B",ECDSSV,0))
  1. I 'ECERRFLG,'ECDSSIEN,ECDSSV'="",'$D(^ECD("B",ECDSSV)) D
  1. . N ECNXTDSS
  1. . S ECNXTDSS=$O(^ECD("B",ECDSSV))
  1. . I ECDSSV=$E(ECNXTDSS,1,$L(ECDSSV)) S ECDSSIEN=$O(^ECD("B",ECNXTDSS,0))
  1. . ;
  1. . I ECDSSV'=$E(ECNXTDSS,1,$L(ECDSSV)) D
  1. . . ; DSS unit name not found on VistA
  1. . . S ECERRMSG=$P($T(DSS3^ECV3RPC),";;",2)
  1. . . S ECCOLERR=ECDSSPC
  1. . . D ERROR
  1. . . Q
  1. . Q
  1. ;
  1. I ECDSSIEN="" D ;131 Need to have a DSS Unit identified
  1. .S ECERRMSG=$P($T(DSS4^ECV3RPC),";;",2)
  1. .S ECCOLERR=ECDSSPC
  1. .D ERROR
  1. .Q
  1. ;--Validate Ordering section or derive from DSS Unit IEN--
  1. I ECOSV'="" D
  1. . S ECOSIEN=$O(^ECC(723,"B",ECOSV,0))
  1. . I ECOSIEN="" D
  1. . . ; Ordering Section "B" x-ref doesn't exist
  1. . . S ECERRMSG=$P($T(ORDSEC1^ECV3RPC),";;",2)
  1. . . S ECCOLERR=ECOSPC
  1. . . D ERROR
  1. . . Q
  1. . Q
  1. I ECOSV="" D
  1. . I 'ECDSSIEN D
  1. . . ; Unable to derive Ordering section from DSS Unit
  1. . . S ECERRMSG=$P($T(ORDSEC2^ECV3RPC),";;",2)
  1. . . S ECCOLERR=ECOSPC
  1. . . D ERROR
  1. . . Q
  1. . I ECDSSIEN D
  1. . . S ECOSIEN=$P(^ECD(ECDSSIEN,0),U,3)
  1. . . I ECOSIEN="" D
  1. . . . ; Unable to derive Ordering section from DSS Unit
  1. . . . S ECERRMSG=$P($T(ORDSEC2^ECV3RPC),";;",2)
  1. . . . S ECCOLERR=ECOSPC
  1. . . . D ERROR
  1. . . . Q
  1. . . Q
  1. ;
  1. ;--Procedure must be a National Procedure, Local Procedure, --
  1. ;--or a CPT code, and the EC Event Code Screen must be active --
  1. N ECFOUND,ECPI,ECDT
  1. S ECERRFLG=0,ECFOUND=0
  1. S %DT="XST",X=$G(ECENCV,"NOW") D ^%DT S ECDT=+Y
  1. ; Check for National Procedure code (D x-ref)
  1. I $D(^EC(725,"D",ECPROCV)) D
  1. . S ECPROCV=$O(^EC(725,"D",ECPROCV,0))_";EC(725,"
  1. . S ECPI=$P($G(^EC(725,ECPROCV,0)),"^",5)
  1. . I ECPI="" S ECFOUND=1 Q
  1. . S ECPI=$$CPT^ICPTCOD(ECPI,ECDT) I +ECPI>0,$P(ECPI,"^",7) S ECFOUND=1
  1. ; Check for local procedure code (DL x-ref)
  1. I 'ECFOUND,$D(^EC(725,"DL",ECPROCV)) D
  1. . S ECPROCV=$O(^EC(725,"DL",ECPROCV,0))_";EC(725,"
  1. . S ECPI=$P($G(^EC(725,ECPROCV,0)),"^",5)
  1. . I ECPI="" S ECFOUND=1 Q
  1. . S ECPI=$$CPT^ICPTCOD(ECPI,ECDT) I +ECPI>0,$P(ECPI,"^",7) S ECFOUND=1
  1. ; Check for CPT code (B x-ref)
  1. I 'ECFOUND S ECPI=$$CPT^ICPTCOD(ECPROCV,ECDT) I +ECPI>0,$P(ECPI,"^",7) D
  1. . S ECPROCV=$P(ECPI,"^")_";ICPT("
  1. . S ECFOUND=1
  1. ;
  1. I 'ECFOUND D
  1. . ; Invalid procedure code
  1. . S ECERRMSG=$P($T(PROC1^ECV3RPC),";;",2)
  1. . S ECCOLERR=ECPROCPC
  1. . D ERROR
  1. . Q
  1. I ECFOUND,$G(ECPI) D ;Section added in 131 to check CPT Modifiers
  1. .N MODLIST,VALUES,MODARR,MSUB,ENTRY
  1. .S VALUES=$P(ECPI,U)_U_$G(ECENCV,$$DT^XLFDT) ;Procedure code and encounter date or today's date
  1. .D ECPXMOD^ECUERPC(.MODLIST,VALUES) ;Call returns valid modifiers for selected CPT code
  1. .S MSUB=0 F S MSUB=$O(@MODLIST@(MSUB)) Q:'+MSUB S MODARR($P(@MODLIST@(MSUB),U))=@MODLIST@(MSUB)
  1. .F MSUB=1:1:5 S ENTRY=@("ECMOD"_MSUB_"V") I ENTRY'="" D ;Look at each modifier
  1. ..I '$D(MODARR(ENTRY)) D Q
  1. ...S ECERRMSG=$P($T(MOD1^ECV3RPC),";;",2)
  1. ...S ECCOLERR=@("ECMOD"_MSUB_"PC")
  1. ...D ERROR
  1. ..S @("ECMOD"_MSUB_"V")=$P(MODARR(ENTRY),U,3) K MODARR(ENTRY) ;Delete modifer from list if used so it can't be duplicated
  1. ..Q
  1. .Q
  1. I ECFOUND,'$G(ECPI) D ;131 Section checks to see if modifiers sent for a non-CPT procedure
  1. .N MSUB
  1. .F MSUB=1:1:5 I $G(@("ECMOD"_MSUB_"V"))'="" D
  1. ..S ECERRMSG=$P($T(MOD2^ECV3RPC),";;",2)
  1. ..S ECCOLERR=@("ECMOD"_MSUB_"PC")
  1. ..D ERROR
  1. ..Q
  1. .Q
  1. ;
  1. ; -Category must exist on the Event Capture Category file
  1. I ECCATV="" S ECCATIEN=0
  1. I ECCATV'="" D
  1. . I $D(^EC(726,"B",ECCATV)) S ECCATIEN=$O(^EC(726,"B",ECCATV,0))
  1. . I '$D(^EC(726,"B",ECCATV)) D
  1. . . ; B cross reference not found for category
  1. . . S ECERRMSG=$P($T(CAT1^ECV3RPC),";;",2)
  1. . . S ECCOLERR=ECCATPC
  1. . . D ERROR
  1. . . Q
  1. ;
  1. ; -check for active Event Code screen
  1. N ECEVNT,ECSNODE,ECSDATA,ECSFOUND
  1. I 'ECERRFLG D
  1. . S ECEVNT=ECSTAV_"-"_ECDSSIEN_"-"_ECCATIEN_"-"_ECPROCV
  1. . S (ECSNODE,ECSFOUND)=0
  1. . F S ECSNODE=$O(^ECJ(ECSNODE)) Q:ECSNODE="" D
  1. . . S ECSDATA=$G(^ECJ(ECSNODE,0))
  1. . . I ECEVNT=$P(ECSDATA,U,1) D
  1. . . . S ECSFOUND=1
  1. . . . I $P(ECSDATA,U,2)'="" D
  1. . . . . ; Event Code screen inactive
  1. . . . . S ECERRMSG=$P($T(PROC2^ECV3RPC),";;",2)
  1. . . . . S ECCOLERR=ECPROCPC
  1. . . . . D ERROR
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . Q
  1. ;
  1. ;Generate error if event code screen not found
  1. I 'ECERRFLG,'ECSFOUND,ECDSSIEN D
  1. . ; Event Code screen not found
  1. . S ECERRMSG=$P($T(PROC3^ECV3RPC),";;",2)
  1. . S ECCOLERR=ECPROCPC
  1. . D ERROR
  1. . Q
  1. ;
  1. ;139 Modified section to add testing for DSS Unit allowing duplicates
  1. I 'ECERRFLG D
  1. .;Check for duplicate uploaded record base on Loc_DSS Unit_Category_Proc
  1. .;Date_Procedure
  1. . N ECDUP,ECNAM,ECPNAM,ECI,ECX,Y,ECPRV,ECPROV
  1. . S (ECDA,ECDUP)=0
  1. . F S ECDA=$O(^ECH("ADT",ECSTAV,ECSSNIEN,+ECDSSIEN,ECDT,ECDA)) Q:'ECDA D I ECDUP Q ;131 Make sure DSS IEN has a value
  1. . . S ECX=$G(^ECH(ECDA,0)) I ECX="" Q
  1. . . I $P(ECX,U,8)'=ECCATIEN Q
  1. . . I $P(ECX,U,9)'=ECPROCV Q
  1. . . S ECPNAM="",ECDUP=1
  1. . . K ECPRV S ECPROV=$$GETPRV^ECPRVMUT(ECDA,.ECPRV)
  1. . . F ECI=1:1:3 S Y=$O(ECPRV("")) I Y'="" D
  1. . . . S ECNAM=$P(ECPRV(Y),U,2) K ECPRV(Y)
  1. . . . S ECPNAM=ECPNAM_" "_$P(ECNAM,",")_","_$E($P(ECNAM,",",2))
  1. . . I 'ECFILDUP D
  1. . . . S ECERRMSG="**DUPLICATE** "
  1. . . . S ECERRMSG=ECERRMSG_" Clinic: "_$$GET1^DIQ(44,$P(ECX,U,19),.01,"I")
  1. . . . S ECERRMSG=ECERRMSG_" Order Sect: "_$$GET1^DIQ(723,$P(ECX,U,12),.01,"I")
  1. . . . S ECERRMSG=ECERRMSG_" Provider: "_ECPNAM
  1. . . . S ECNAM=$$GET1^DIQ(200,$P(ECX,U,13),.01,"I")
  1. . . . S ECERRMSG=ECERRMSG_" Entered: "_$P(ECNAM,",")_","_$E($P(ECNAM,",",2))
  1. . . . S ECCOLERR=ECSTAPC
  1. . . . D ERROR
  1. . .I ECFILDUP D
  1. . . .I $$GET1^DIQ(724,+ECDSSIEN,16,"I")'="Y" D
  1. . . . .S ECERRMSG="The DSS Unit associated with this record does not allow duplicate entries - Record NOT filed."
  1. . . . .S ECCOLERR=ECUNITPC
  1. . . . .D ERROR
  1. . . . .Q
  1. . . .Q
  1. . .Q
  1. .Q
  1. Q
  1. ERROR ;--Set up array entry to contain the following:
  1. ;1. record number
  1. ;2. column number on spreadsheet containing the record number
  1. ;3. column number on spreadsheet containing the data in error
  1. ;4. error message
  1. ;
  1. S ECINDEX=ECINDEX+1
  1. S RESULTS(ECINDEX)=ECRECV_"^"_ECRECPC_"^"_ECCOLERR_"^"_ECERRMSG_"^"
  1. S ECERRFLG=1
  1. Q
  1. ;
  1. DSS1 ;;Invalid DSS Unit IEN
  1. DSS2 ;;Invalid DSS Unit Number
  1. DSS3 ;;Invalid DSS Unit Name
  1. DSS4 ;;DSS Unit required. Must enter DSS Unit Name or DSS IEN
  1. ORDSEC1 ;;Ordering Section "B" x-ref not on Med Specialty file(#723)
  1. ORDSEC2 ;;Unable to derive Ordering Section from DSS Unit
  1. PROC1 ;;Procedure/CPT invalid
  1. PROC2 ;;Procedure/CPT invalid for this Station and DSS Unit
  1. PROC3 ;;Event Code screen not found
  1. CAT1 ;;Category "B" x-ref not on EC Category file(#726)
  1. MOD1 ;;Modifier is invalid or duplicated for the selected procedure
  1. MOD2 ;;Modifiers cannot be used with this procedure - no CPT identified