ECV3RPC ;ALB/ACS;Event Capture Spreadsheet Data Validation ;2/5/18 11:05
;;2.0;EVENT CAPTURE;**25,47,49,61,72,131,134,139**;8 May 96;Build 7
;
;----------------------------------------------------------------------
; Validates the following Event Capture Spreadsheet Upload fields:
; 1. DSS UNIT IEN, DSS UNIT NAME (DSS UNIT NUMBER IS NO LONGER CHECKED PER PATCH 134)
; 2. ORDERING SECTION
; 3. PROCEDURE CODE
; 4. CPT Modifiers
; 5. 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 - Starting with patch 134, DSS Unit Number is no longer checked. Entire section commented out
;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
;
I ECDSSIEN="" D ;131 Need to have a DSS Unit identified
.S ECERRMSG=$P($T(DSS4^ECV3RPC),";;",2)
.S ECCOLERR=ECDSSPC
.D ERROR
.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
I ECFOUND,$G(ECPI) D ;Section added in 131 to check CPT Modifiers
.N MODLIST,VALUES,MODARR,MSUB,ENTRY
.S VALUES=$P(ECPI,U)_U_$G(ECENCV,$$DT^XLFDT) ;Procedure code and encounter date or today's date
.D ECPXMOD^ECUERPC(.MODLIST,VALUES) ;Call returns valid modifiers for selected CPT code
.S MSUB=0 F S MSUB=$O(@MODLIST@(MSUB)) Q:'+MSUB S MODARR($P(@MODLIST@(MSUB),U))=@MODLIST@(MSUB)
.F MSUB=1:1:5 S ENTRY=@("ECMOD"_MSUB_"V") I ENTRY'="" D ;Look at each modifier
..I '$D(MODARR(ENTRY)) D Q
...S ECERRMSG=$P($T(MOD1^ECV3RPC),";;",2)
...S ECCOLERR=@("ECMOD"_MSUB_"PC")
...D ERROR
..S @("ECMOD"_MSUB_"V")=$P(MODARR(ENTRY),U,3) K MODARR(ENTRY) ;Delete modifer from list if used so it can't be duplicated
..Q
.Q
I ECFOUND,'$G(ECPI) D ;131 Section checks to see if modifiers sent for a non-CPT procedure
.N MSUB
.F MSUB=1:1:5 I $G(@("ECMOD"_MSUB_"V"))'="" D
..S ECERRMSG=$P($T(MOD2^ECV3RPC),";;",2)
..S ECCOLERR=@("ECMOD"_MSUB_"PC")
..D ERROR
..Q
.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
;
;139 Modified section to add testing for DSS Unit allowing duplicates
I 'ECERRFLG 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 ;131 Make sure DSS IEN has a value
. . 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))
. . I 'ECFILDUP D
. . . 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
. .I ECFILDUP D
. . .I $$GET1^DIQ(724,+ECDSSIEN,16,"I")'="Y" D
. . . .S ECERRMSG="The DSS Unit associated with this record does not allow duplicate entries - Record NOT filed."
. . . .S ECCOLERR=ECUNITPC
. . . .D ERROR
. . . .Q
. . .Q
. .Q
.Q
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
DSS4 ;;DSS Unit required. Must enter DSS Unit Name or DSS IEN
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)
MOD1 ;;Modifier is invalid or duplicated for the selected procedure
MOD2 ;;Modifiers cannot be used with this procedure - no CPT identified
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECV3RPC 8709 printed Apr 09, 2024@21:01:58 Page 2
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
+2 ;
+3 ;----------------------------------------------------------------------
+4 ; Validates the following Event Capture Spreadsheet Upload fields:
+5 ; 1. DSS UNIT IEN, DSS UNIT NAME (DSS UNIT NUMBER IS NO LONGER CHECKED PER PATCH 134)
+6 ; 2. ORDERING SECTION
+7 ; 3. PROCEDURE CODE
+8 ; 4. CPT Modifiers
+9 ; 5. CATEGORY
+10 ;
+11 ;----------------------------------------------------------------------
+12 ;
+13 ;--Set up error flag
+14 SET ECERRFLG=0
+15 ;
+16 ;--GET DSS Unit IEN--
+17 SET ECDSSIEN=""
+18 ; -Check for DSS Unit IEN first
+19 IF ECUNITV'=""
IF (ECUNITV'=+ECUNITV)
Begin DoDot:1
+20 SET ECERRMSG=$PIECE($TEXT(DSS1^ECV3RPC),";;",2)
+21 SET ECCOLERR=ECUNITPC
+22 DO ERROR
End DoDot:1
+23 IF ECUNITV
IF 'ECERRFLG
IF $DATA(^ECD(ECUNITV,0))
SET ECDSSIEN=ECUNITV
+24 IF ECUNITV
IF 'ECERRFLG
IF '$DATA(^ECD(ECUNITV,0))
Begin DoDot:1
+25 ; DSS unit ien not found on VistA
+26 SET ECERRMSG=$PIECE($TEXT(DSS1^ECV3RPC),";;",2)
+27 SET ECCOLERR=ECUNITPC
+28 DO ERROR
+29 QUIT
End DoDot:1
+30 ; -Check for DSS Unit Number - Starting with patch 134, DSS Unit Number is no longer checked. Entire section commented out
+31 ;I ECDCMV'="",'$D(^ECD("C",ECDCMV)) D
+32 ;. ; DSS Unit Number not found on VistA
+33 ;. S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
+34 ;. S ECCOLERR=ECDCMPC
+35 ;. D ERROR
+36 ;I 'ECERRFLG,ECDCMV'="",$D(^ECD("C",ECDCMV)) S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
+37 ;Check if the next record is a match
+38 ;I 'ECERRFLG,'ECDSSIEN,ECDCMV'="",$D(^ECD("C",ECDCMV)) D
+39 ;. S ECDSSIEN=$O(^ECD("C",ECDCMV,0))
+40 ;. I '$D(^ECD("C",ECDCMV)) D
+41 ;. . ; DSS Unit Number not found on VistA
+42 ;. . S ECERRMSG=$P($T(DSS2^ECV3RPC),";;",2)
+43 ;. . S ECCOLERR=ECDCMPC
+44 ;. . D ERROR
+45 ;. . Q
+46 ; -Check for DSS Unit Name
+47 IF ECDSSV'=""
IF '$DATA(^ECD("B",ECDSSV))
Begin DoDot:1
+48 SET ECERRMSG=$PIECE($TEXT(DSS3^ECV3RPC),";;",2)
+49 SET ECCOLERR=ECDSSPC
+50 DO ERROR
End DoDot:1
+51 ;
+52 IF 'ECERRFLG
IF 'ECDSSIEN
IF ECDSSV'=""
IF $DATA(^ECD("B",ECDSSV))
SET ECDSSIEN=$ORDER(^ECD("B",ECDSSV,0))
+53 IF 'ECERRFLG
IF 'ECDSSIEN
IF ECDSSV'=""
IF '$DATA(^ECD("B",ECDSSV))
Begin DoDot:1
+54 NEW ECNXTDSS
+55 SET ECNXTDSS=$ORDER(^ECD("B",ECDSSV))
+56 IF ECDSSV=$EXTRACT(ECNXTDSS,1,$LENGTH(ECDSSV))
SET ECDSSIEN=$ORDER(^ECD("B",ECNXTDSS,0))
+57 ;
+58 IF ECDSSV'=$EXTRACT(ECNXTDSS,1,$LENGTH(ECDSSV))
Begin DoDot:2
+59 ; DSS unit name not found on VistA
+60 SET ECERRMSG=$PIECE($TEXT(DSS3^ECV3RPC),";;",2)
+61 SET ECCOLERR=ECDSSPC
+62 DO ERROR
+63 QUIT
End DoDot:2
+64 QUIT
End DoDot:1
+65 ;
+66 ;131 Need to have a DSS Unit identified
IF ECDSSIEN=""
Begin DoDot:1
+67 SET ECERRMSG=$PIECE($TEXT(DSS4^ECV3RPC),";;",2)
+68 SET ECCOLERR=ECDSSPC
+69 DO ERROR
+70 QUIT
End DoDot:1
+71 ;--Validate Ordering section or derive from DSS Unit IEN--
+72 IF ECOSV'=""
Begin DoDot:1
+73 SET ECOSIEN=$ORDER(^ECC(723,"B",ECOSV,0))
+74 IF ECOSIEN=""
Begin DoDot:2
+75 ; Ordering Section "B" x-ref doesn't exist
+76 SET ECERRMSG=$PIECE($TEXT(ORDSEC1^ECV3RPC),";;",2)
+77 SET ECCOLERR=ECOSPC
+78 DO ERROR
+79 QUIT
End DoDot:2
+80 QUIT
End DoDot:1
+81 IF ECOSV=""
Begin DoDot:1
+82 IF 'ECDSSIEN
Begin DoDot:2
+83 ; Unable to derive Ordering section from DSS Unit
+84 SET ECERRMSG=$PIECE($TEXT(ORDSEC2^ECV3RPC),";;",2)
+85 SET ECCOLERR=ECOSPC
+86 DO ERROR
+87 QUIT
End DoDot:2
+88 IF ECDSSIEN
Begin DoDot:2
+89 SET ECOSIEN=$PIECE(^ECD(ECDSSIEN,0),U,3)
+90 IF ECOSIEN=""
Begin DoDot:3
+91 ; Unable to derive Ordering section from DSS Unit
+92 SET ECERRMSG=$PIECE($TEXT(ORDSEC2^ECV3RPC),";;",2)
+93 SET ECCOLERR=ECOSPC
+94 DO ERROR
+95 QUIT
End DoDot:3
+96 QUIT
End DoDot:2
End DoDot:1
+97 ;
+98 ;--Procedure must be a National Procedure, Local Procedure, --
+99 ;--or a CPT code, and the EC Event Code Screen must be active --
+100 NEW ECFOUND,ECPI,ECDT
+101 SET ECERRFLG=0
SET ECFOUND=0
+102 SET %DT="XST"
SET X=$GET(ECENCV,"NOW")
DO ^%DT
SET ECDT=+Y
+103 ; Check for National Procedure code (D x-ref)
+104 IF $DATA(^EC(725,"D",ECPROCV))
Begin DoDot:1
+105 SET ECPROCV=$ORDER(^EC(725,"D",ECPROCV,0))_";EC(725,"
+106 SET ECPI=$PIECE($GET(^EC(725,ECPROCV,0)),"^",5)
+107 IF ECPI=""
SET ECFOUND=1
QUIT
+108 SET ECPI=$$CPT^ICPTCOD(ECPI,ECDT)
IF +ECPI>0
IF $PIECE(ECPI,"^",7)
SET ECFOUND=1
End DoDot:1
+109 ; Check for local procedure code (DL x-ref)
+110 IF 'ECFOUND
IF $DATA(^EC(725,"DL",ECPROCV))
Begin DoDot:1
+111 SET ECPROCV=$ORDER(^EC(725,"DL",ECPROCV,0))_";EC(725,"
+112 SET ECPI=$PIECE($GET(^EC(725,ECPROCV,0)),"^",5)
+113 IF ECPI=""
SET ECFOUND=1
QUIT
+114 SET ECPI=$$CPT^ICPTCOD(ECPI,ECDT)
IF +ECPI>0
IF $PIECE(ECPI,"^",7)
SET ECFOUND=1
End DoDot:1
+115 ; Check for CPT code (B x-ref)
+116 IF 'ECFOUND
SET ECPI=$$CPT^ICPTCOD(ECPROCV,ECDT)
IF +ECPI>0
IF $PIECE(ECPI,"^",7)
Begin DoDot:1
+117 SET ECPROCV=$PIECE(ECPI,"^")_";ICPT("
+118 SET ECFOUND=1
End DoDot:1
+119 ;
+120 IF 'ECFOUND
Begin DoDot:1
+121 ; Invalid procedure code
+122 SET ECERRMSG=$PIECE($TEXT(PROC1^ECV3RPC),";;",2)
+123 SET ECCOLERR=ECPROCPC
+124 DO ERROR
+125 QUIT
End DoDot:1
+126 ;Section added in 131 to check CPT Modifiers
IF ECFOUND
IF $GET(ECPI)
Begin DoDot:1
+127 NEW MODLIST,VALUES,MODARR,MSUB,ENTRY
+128 ;Procedure code and encounter date or today's date
SET VALUES=$PIECE(ECPI,U)_U_$GET(ECENCV,$$DT^XLFDT)
+129 ;Call returns valid modifiers for selected CPT code
DO ECPXMOD^ECUERPC(.MODLIST,VALUES)
+130 SET MSUB=0
FOR
SET MSUB=$ORDER(@MODLIST@(MSUB))
if '+MSUB
QUIT
SET MODARR($PIECE(@MODLIST@(MSUB),U))=@MODLIST@(MSUB)
+131 ;Look at each modifier
FOR MSUB=1:1:5
SET ENTRY=@("ECMOD"_MSUB_"V")
IF ENTRY'=""
Begin DoDot:2
+132 IF '$DATA(MODARR(ENTRY))
Begin DoDot:3
+133 SET ECERRMSG=$PIECE($TEXT(MOD1^ECV3RPC),";;",2)
+134 SET ECCOLERR=@("ECMOD"_MSUB_"PC")
+135 DO ERROR
End DoDot:3
QUIT
+136 ;Delete modifer from list if used so it can't be duplicated
SET @("ECMOD"_MSUB_"V")=$PIECE(MODARR(ENTRY),U,3)
KILL MODARR(ENTRY)
+137 QUIT
End DoDot:2
+138 QUIT
End DoDot:1
+139 ;131 Section checks to see if modifiers sent for a non-CPT procedure
IF ECFOUND
IF '$GET(ECPI)
Begin DoDot:1
+140 NEW MSUB
+141 FOR MSUB=1:1:5
IF $GET(@("ECMOD"_MSUB_"V"))'=""
Begin DoDot:2
+142 SET ECERRMSG=$PIECE($TEXT(MOD2^ECV3RPC),";;",2)
+143 SET ECCOLERR=@("ECMOD"_MSUB_"PC")
+144 DO ERROR
+145 QUIT
End DoDot:2
+146 QUIT
End DoDot:1
+147 ;
+148 ; -Category must exist on the Event Capture Category file
+149 IF ECCATV=""
SET ECCATIEN=0
+150 IF ECCATV'=""
Begin DoDot:1
+151 IF $DATA(^EC(726,"B",ECCATV))
SET ECCATIEN=$ORDER(^EC(726,"B",ECCATV,0))
+152 IF '$DATA(^EC(726,"B",ECCATV))
Begin DoDot:2
+153 ; B cross reference not found for category
+154 SET ECERRMSG=$PIECE($TEXT(CAT1^ECV3RPC),";;",2)
+155 SET ECCOLERR=ECCATPC
+156 DO ERROR
+157 QUIT
End DoDot:2
End DoDot:1
+158 ;
+159 ; -check for active Event Code screen
+160 NEW ECEVNT,ECSNODE,ECSDATA,ECSFOUND
+161 IF 'ECERRFLG
Begin DoDot:1
+162 SET ECEVNT=ECSTAV_"-"_ECDSSIEN_"-"_ECCATIEN_"-"_ECPROCV
+163 SET (ECSNODE,ECSFOUND)=0
+164 FOR
SET ECSNODE=$ORDER(^ECJ(ECSNODE))
if ECSNODE=""
QUIT
Begin DoDot:2
+165 SET ECSDATA=$GET(^ECJ(ECSNODE,0))
+166 IF ECEVNT=$PIECE(ECSDATA,U,1)
Begin DoDot:3
+167 SET ECSFOUND=1
+168 IF $PIECE(ECSDATA,U,2)'=""
Begin DoDot:4
+169 ; Event Code screen inactive
+170 SET ECERRMSG=$PIECE($TEXT(PROC2^ECV3RPC),";;",2)
+171 SET ECCOLERR=ECPROCPC
+172 DO ERROR
+173 QUIT
End DoDot:4
+174 QUIT
End DoDot:3
+175 QUIT
End DoDot:2
+176 QUIT
End DoDot:1
+177 ;
+178 ;Generate error if event code screen not found
+179 IF 'ECERRFLG
IF 'ECSFOUND
IF ECDSSIEN
Begin DoDot:1
+180 ; Event Code screen not found
+181 SET ECERRMSG=$PIECE($TEXT(PROC3^ECV3RPC),";;",2)
+182 SET ECCOLERR=ECPROCPC
+183 DO ERROR
+184 QUIT
End DoDot:1
+185 ;
+186 ;139 Modified section to add testing for DSS Unit allowing duplicates
+187 IF 'ECERRFLG
Begin DoDot:1
+188 ;Check for duplicate uploaded record base on Loc_DSS Unit_Category_Proc
+189 ;Date_Procedure
+190 NEW ECDUP,ECNAM,ECPNAM,ECI,ECX,Y,ECPRV,ECPROV
+191 SET (ECDA,ECDUP)=0
+192 ;131 Make sure DSS IEN has a value
FOR
SET ECDA=$ORDER(^ECH("ADT",ECSTAV,ECSSNIEN,+ECDSSIEN,ECDT,ECDA))
if 'ECDA
QUIT
Begin DoDot:2
+193 SET ECX=$GET(^ECH(ECDA,0))
IF ECX=""
QUIT
+194 IF $PIECE(ECX,U,8)'=ECCATIEN
QUIT
+195 IF $PIECE(ECX,U,9)'=ECPROCV
QUIT
+196 SET ECPNAM=""
SET ECDUP=1
+197 KILL ECPRV
SET ECPROV=$$GETPRV^ECPRVMUT(ECDA,.ECPRV)
+198 FOR ECI=1:1:3
SET Y=$ORDER(ECPRV(""))
IF Y'=""
Begin DoDot:3
+199 SET ECNAM=$PIECE(ECPRV(Y),U,2)
KILL ECPRV(Y)
+200 SET ECPNAM=ECPNAM_" "_$PIECE(ECNAM,",")_","_$EXTRACT($PIECE(ECNAM,",",2))
End DoDot:3
+201 IF 'ECFILDUP
Begin DoDot:3
+202 SET ECERRMSG="**DUPLICATE** "
+203 SET ECERRMSG=ECERRMSG_" Clinic: "_$$GET1^DIQ(44,$PIECE(ECX,U,19),.01,"I")
+204 SET ECERRMSG=ECERRMSG_" Order Sect: "_$$GET1^DIQ(723,$PIECE(ECX,U,12),.01,"I")
+205 SET ECERRMSG=ECERRMSG_" Provider: "_ECPNAM
+206 SET ECNAM=$$GET1^DIQ(200,$PIECE(ECX,U,13),.01,"I")
+207 SET ECERRMSG=ECERRMSG_" Entered: "_$PIECE(ECNAM,",")_","_$EXTRACT($PIECE(ECNAM,",",2))
+208 SET ECCOLERR=ECSTAPC
+209 DO ERROR
End DoDot:3
+210 IF ECFILDUP
Begin DoDot:3
+211 IF $$GET1^DIQ(724,+ECDSSIEN,16,"I")'="Y"
Begin DoDot:4
+212 SET ECERRMSG="The DSS Unit associated with this record does not allow duplicate entries - Record NOT filed."
+213 SET ECCOLERR=ECUNITPC
+214 DO ERROR
+215 QUIT
End DoDot:4
+216 QUIT
End DoDot:3
+217 QUIT
End DoDot:2
IF ECDUP
QUIT
+218 QUIT
End DoDot:1
+219 QUIT
ERROR ;--Set up array entry to contain the following:
+1 ;1. record number
+2 ;2. column number on spreadsheet containing the record number
+3 ;3. column number on spreadsheet containing the data in error
+4 ;4. error message
+5 ;
+6 SET ECINDEX=ECINDEX+1
+7 SET RESULTS(ECINDEX)=ECRECV_"^"_ECRECPC_"^"_ECCOLERR_"^"_ECERRMSG_"^"
+8 SET ECERRFLG=1
+9 QUIT
+10 ;
DSS1 ;;Invalid DSS Unit IEN
DSS2 ;;Invalid DSS Unit Number
DSS3 ;;Invalid DSS Unit Name
DSS4 ;;DSS Unit required. Must enter DSS Unit Name or DSS IEN
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)
MOD1 ;;Modifier is invalid or duplicated for the selected procedure
MOD2 ;;Modifiers cannot be used with this procedure - no CPT identified
