- 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 Feb 18, 2025@23:25:42 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