203 lines
6.4 KiB
Mathematica
203 lines
6.4 KiB
Mathematica
ECV3RPC ;ALB/ACS;Event Capture Spreadsheet Data Validation ;Oct 13, 2000
|
|
;;2.0; EVENT CAPTURE ;**25,47,49,61,72**;8 May 96
|
|
;
|
|
;-----------------------------------------------------------------------
|
|
; Validates the following Event Capture Spreadsheet Upload fields:
|
|
; 1. DSS UNIT IEN, DSS UNIT NUMBER, DSS UNIT NAME
|
|
; 2. ORDERING SECTION
|
|
; 3. PROCEDURE CODE
|
|
; 4. CATEGORY
|
|
;
|
|
;-----------------------------------------------------------------------
|
|
;
|
|
;--Set up error flag
|
|
S ECERRFLG=0
|
|
;
|
|
;--GET DSS Unit IEN--
|
|
S ECDSSIEN=""
|
|
; -Check for DSS Unit IEN first
|
|
I ECUNITV'="",(ECUNITV'=+ECUNITV) D
|
|
. S ECERRMSG=$P($T(DSS1^ECV3RPC),";;",2)
|
|
. S ECCOLERR=ECUNITPC
|
|
. D ERROR
|
|
I ECUNITV,'ECERRFLG,$D(^ECD(ECUNITV,0)) S ECDSSIEN=ECUNITV
|
|
I ECUNITV,'ECERRFLG,'$D(^ECD(ECUNITV,0)) D
|
|
. ; DSS unit ien not found on VistA
|
|
. S ECERRMSG=$P($T(DSS1^ECV3RPC),";;",2)
|
|
. S ECCOLERR=ECUNITPC
|
|
. D ERROR
|
|
. Q
|
|
; -Check for DSS Unit Number
|
|
I ECDCMV'="",'$D(^ECD("C",ECDCMV)) D
|
|
. ; DSS Unit Number not found on VistA
|
|
. S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
|
|
. S ECCOLERR=ECDCMPC
|
|
. D ERROR
|
|
I 'ECERRFLG,ECDCMV'="",$D(^ECD("C",ECDCMV)) S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
|
|
;Check if the next record is a match
|
|
I 'ECERRFLG,'ECDSSIEN,ECDCMV'="",$D(^ECD("C",ECDCMV)) D
|
|
. S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
|
|
. I '$D(^ECD("C",ECDCMV)) D
|
|
. . ; DSS Unit Number not found on VistA
|
|
. . S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
|
|
. . S ECCOLERR=ECDCMPC
|
|
. . D ERROR
|
|
. . Q
|
|
; -Check for DSS Unit Name
|
|
I ECDSSV'="",'$D(^ECD("B",ECDSSV)) D
|
|
. S ECERRMSG=$P($T(DSS3^ECV3RPC),";;",2)
|
|
. S ECCOLERR=ECDSSPC
|
|
. D ERROR
|
|
;
|
|
I 'ECERRFLG,'ECDSSIEN,ECDSSV'="",$D(^ECD("B",ECDSSV)) S ECDSSIEN=$O(^ECD("B",ECDSSV,0))
|
|
I 'ECERRFLG,'ECDSSIEN,ECDSSV'="",'$D(^ECD("B",ECDSSV)) D
|
|
. N ECNXTDSS
|
|
. S ECNXTDSS=$O(^ECD("B",ECDSSV))
|
|
. I ECDSSV=$E(ECNXTDSS,1,$L(ECDSSV)) S ECDSSIEN=$O(^ECD("B",ECNXTDSS,0))
|
|
. ;
|
|
. I ECDSSV'=$E(ECNXTDSS,1,$L(ECDSSV)) D
|
|
. . ; DSS unit name not found on VistA
|
|
. . S ECERRMSG=$P($T(DSS3^ECV3RPC),";;",2)
|
|
. . S ECCOLERR=ECDSSPC
|
|
. . D ERROR
|
|
. . Q
|
|
. Q
|
|
;
|
|
;--Validate Ordering section or derive from DSS Unit IEN--
|
|
I ECOSV'="" D
|
|
. S ECOSIEN=$O(^ECC(723,"B",ECOSV,0))
|
|
. I ECOSIEN="" D
|
|
. . ; Ordering Section "B" x-ref doesn't exist
|
|
. . S ECERRMSG=$P($T(ORDSEC1^ECV3RPC),";;",2)
|
|
. . S ECCOLERR=ECOSPC
|
|
. . D ERROR
|
|
. . Q
|
|
. Q
|
|
I ECOSV="" D
|
|
. I 'ECDSSIEN D
|
|
. . ; Unable to derive Ordering section from DSS Unit
|
|
. . S ECERRMSG=$P($T(ORDSEC2^ECV3RPC),";;",2)
|
|
. . S ECCOLERR=ECOSPC
|
|
. . D ERROR
|
|
. . Q
|
|
. I ECDSSIEN D
|
|
. . S ECOSIEN=$P(^ECD(ECDSSIEN,0),U,3)
|
|
. . I ECOSIEN="" D
|
|
. . . ; Unable to derive Ordering section from DSS Unit
|
|
. . . S ECERRMSG=$P($T(ORDSEC2^ECV3RPC),";;",2)
|
|
. . . S ECCOLERR=ECOSPC
|
|
. . . D ERROR
|
|
. . . Q
|
|
. . Q
|
|
;
|
|
;--Procedure must be a National Procedure, Local Procedure, --
|
|
;--or a CPT code, and the EC Event Code Screen must be active --
|
|
N ECFOUND,ECPI,ECDT
|
|
S ECERRFLG=0,ECFOUND=0
|
|
S %DT="XST",X=$G(ECENCV,"NOW") D ^%DT S ECDT=+Y
|
|
; Check for National Procedure code (D x-ref)
|
|
I $D(^EC(725,"D",ECPROCV)) D
|
|
. S ECPROCV=$O(^EC(725,"D",ECPROCV,0))_";EC(725,"
|
|
. S ECPI=$P($G(^EC(725,ECPROCV,0)),"^",5)
|
|
. I ECPI="" S ECFOUND=1 Q
|
|
. S ECPI=$$CPT^ICPTCOD(ECPI,ECDT) I +ECPI>0,$P(ECPI,"^",7) S ECFOUND=1
|
|
; Check for local procedure code (DL x-ref)
|
|
I 'ECFOUND,$D(^EC(725,"DL",ECPROCV)) D
|
|
. S ECPROCV=$O(^EC(725,"DL",ECPROCV,0))_";EC(725,"
|
|
. S ECPI=$P($G(^EC(725,ECPROCV,0)),"^",5)
|
|
. I ECPI="" S ECFOUND=1 Q
|
|
. S ECPI=$$CPT^ICPTCOD(ECPI,ECDT) I +ECPI>0,$P(ECPI,"^",7) S ECFOUND=1
|
|
; Check for CPT code (B x-ref)
|
|
I 'ECFOUND S ECPI=$$CPT^ICPTCOD(ECPROCV,ECDT) I +ECPI>0,$P(ECPI,"^",7) D
|
|
. S ECPROCV=$P(ECPI,"^")_";ICPT("
|
|
. S ECFOUND=1
|
|
;
|
|
I 'ECFOUND D
|
|
. ; Invalid procedure code
|
|
. S ECERRMSG=$P($T(PROC1^ECV3RPC),";;",2)
|
|
. S ECCOLERR=ECPROCPC
|
|
. D ERROR
|
|
. Q
|
|
;
|
|
; -Category must exist on the Event Capture Category file
|
|
I ECCATV="" S ECCATIEN=0
|
|
I ECCATV'="" D
|
|
. I $D(^EC(726,"B",ECCATV)) S ECCATIEN=$O(^EC(726,"B",ECCATV,0))
|
|
. I '$D(^EC(726,"B",ECCATV)) D
|
|
. . ; B cross reference not found for category
|
|
. . S ECERRMSG=$P($T(CAT1^ECV3RPC),";;",2)
|
|
. . S ECCOLERR=ECCATPC
|
|
. . D ERROR
|
|
. . Q
|
|
;
|
|
; -check for active Event Code screen
|
|
N ECEVNT,ECSNODE,ECSDATA,ECSFOUND
|
|
I 'ECERRFLG D
|
|
. S ECEVNT=ECSTAV_"-"_ECDSSIEN_"-"_ECCATIEN_"-"_ECPROCV
|
|
. S (ECSNODE,ECSFOUND)=0
|
|
. F S ECSNODE=$O(^ECJ(ECSNODE)) Q:ECSNODE="" D
|
|
. . S ECSDATA=$G(^ECJ(ECSNODE,0))
|
|
. . I ECEVNT=$P(ECSDATA,U,1) D
|
|
. . . S ECSFOUND=1
|
|
. . . I $P(ECSDATA,U,2)'="" D
|
|
. . . . ; Event Code screen inactive
|
|
. . . . S ECERRMSG=$P($T(PROC2^ECV3RPC),";;",2)
|
|
. . . . S ECCOLERR=ECPROCPC
|
|
. . . . D ERROR
|
|
. . . . Q
|
|
. . . Q
|
|
. . Q
|
|
. Q
|
|
;
|
|
;Generate error if event code screen not found
|
|
I 'ECERRFLG,'ECSFOUND,ECDSSIEN D
|
|
. ; Event Code screen not found
|
|
. S ECERRMSG=$P($T(PROC3^ECV3RPC),";;",2)
|
|
. S ECCOLERR=ECPROCPC
|
|
. D ERROR
|
|
. Q
|
|
;
|
|
I 'ECERRFLG,'ECFILDUP D
|
|
.;Check for duplicate uploaded record base on Loc_DSS Unit_Category_Proc
|
|
.;Date_Procedure
|
|
. N ECDUP,ECNAM,ECPNAM,ECI,ECX,Y,ECPRV,ECPROV
|
|
. S (ECDA,ECDUP)=0
|
|
. F S ECDA=$O(^ECH("ADT",ECSTAV,ECSSNIEN,ECDSSIEN,ECDT,ECDA)) Q:'ECDA D I ECDUP Q
|
|
. . S ECX=$G(^ECH(ECDA,0)) I ECX="" Q
|
|
. . I $P(ECX,U,8)'=ECCATIEN Q
|
|
. . I $P(ECX,U,9)'=ECPROCV Q
|
|
. . S ECPNAM="",ECDUP=1
|
|
. . K ECPRV S ECPROV=$$GETPRV^ECPRVMUT(ECDA,.ECPRV)
|
|
. . F ECI=1:1:3 S Y=$O(ECPRV("")) I Y'="" D
|
|
. . . S ECNAM=$P(ECPRV(Y),U,2) K ECPRV(Y)
|
|
. . . S ECPNAM=ECPNAM_" "_$P(ECNAM,",")_","_$E($P(ECNAM,",",2))
|
|
. . S ECERRMSG="**DUPLICATE** "
|
|
. . S ECERRMSG=ECERRMSG_" Clinic: "_$$GET1^DIQ(44,$P(ECX,U,19),.01,"I")
|
|
. . S ECERRMSG=ECERRMSG_" Order Sect: "_$$GET1^DIQ(723,$P(ECX,U,12),.01,"I")
|
|
. . S ECERRMSG=ECERRMSG_" Provider: "_ECPNAM
|
|
. . S ECNAM=$$GET1^DIQ(200,$P(ECX,U,13),.01,"I")
|
|
. . S ECERRMSG=ECERRMSG_" Entered: "_$P(ECNAM,",")_","_$E($P(ECNAM,",",2))
|
|
. . S ECCOLERR=ECSTAPC ;(???)
|
|
. . D ERROR
|
|
Q
|
|
ERROR ;--Set up array entry to contain the following:
|
|
;1. record number
|
|
;2. column number on spreadsheet containing the record number
|
|
;3. column number on spreadsheet containing the data in error
|
|
;4. error message
|
|
;
|
|
S ECINDEX=ECINDEX+1
|
|
S RESULTS(ECINDEX)=ECRECV_"^"_ECRECPC_"^"_ECCOLERR_"^"_ECERRMSG_"^"
|
|
S ECERRFLG=1
|
|
Q
|
|
;
|
|
DSS1 ;;Invalid DSS Unit IEN
|
|
DSS2 ;;Invalid DSS Unit Number
|
|
DSS3 ;;Invalid DSS Unit Name
|
|
ORDSEC1 ;;Ordering Section "B" x-ref not on Med Specialty file(#723)
|
|
ORDSEC2 ;;Unable to derive Ordering Section from DSS Unit
|
|
PROC1 ;;Procedure/CPT invalid
|
|
PROC2 ;;Procedure/CPT invalid for this Station and DSS Unit
|
|
PROC3 ;;Event Code screen not found
|
|
CAT1 ;;Category "B" x-ref not on EC Category file(#726)
|