ECV4RPC ;ALB/ACS - Event Capture Spreadsheet Data Validation ;12/2/22 14:26
;;2.0;EVENT CAPTURE;**25,33,49,131,134,139,159**;8 May 96;Build 61
;
; Reference to ^VA(200, in ICR #10060
; Reference to ^%DT in ICR #10003
; Reference to CHK^DIE in ICR #2053
;
;----------------------------------------------------------------------
; Validates the following Event Capture Spreadsheet Upload fields:
; 1. VOLUME
; 2. ENCOUNTER DATE/TIME
; 3. PROVIDER NAME
;
; Determines the following:
; 1. PATIENT STATUS
;----------------------------------------------------------------------
;
;--Volume must be 1 thru 99--
N ECVOLVN,ECPDT
S ECVOLVN=ECVOLV
I (+ECVOLVN'=ECVOLVN)!(ECVOLVN<1)!(ECVOLVN>99)!(ECVOLVN?.E1"."1N.N) D
. S ECERRMSG=$P($T(VOL1^ECV4RPC),";;",2)
. S ECCOLERR=ECVOLPC
. D ERROR
. Q
I $L(ECVOLVN)'=$L(ECVOLV) D
. ; Volume must be numeric
. S ECERRMSG=$P($T(VOL2^ECV4RPC),";;",2)
. S ECCOLERR=ECVOLPC
. D ERROR
. Q
;
;--Encounter Date/Time--
S ECERRFLG=0
N ECRETVAL
S %DT(0)="-NOW",ECENCV=$TR(ECENCV," ","")
D CHK^DIE(721,2,"E",ECENCV,.ECRETVAL)
I $G(ECRETVAL)="^" D
. ; Invalid encounter date/time
. S ECERRMSG=$P($T(ENC1^ECV4RPC),";;",2)
. S ECCOLERR=ECENCPC
. D ERROR
. Q
I $G(ECRETVAL)'="^" D
. S %DT="XST",X=ECENCV
. D ^%DT
. S ECENCV=+Y
. Q
;
;--Provider Name or IEN must be on the New Person file--
;--and provider must have active person class --
N ECPROV1,ECPROVV,NUM,PRVARR,DSSUPCE ;131,134
S DSSUPCE=$P($G(^ECD(+$G(ECDSSIEN),0)),U,14) S:DSSUPCE="" DSSUPCE="N" ;139
;131 Entire section modified to add checking for up to 7 providers
F NUM=1:1:7 S ECPROVV=@("ECPRV"_NUM_"V") I ECPROVV'="" D I '$G(ECERRFLG) S @("ECPRV"_NUM_"V")=$G(ECPRVIEN) ;If no error, set provider value to IEN
.S ECERRFLG=0,ECPRVIEN=0
.; Remove punctuation if necessary
.I ECPROVV?.E1P S ECPROVV=$E(ECPROVV,1,$L(ECPROVV)-1)
.; If provider ien passed in, find on file
.S ECPROV1=ECPROVV
.I +ECPROVV>0 D
. . I '$D(^VA(200,ECPROVV)) D
. . . ; Provider ien not found on New Person file
. . . S ECERRMSG=$P($T(PROV4^ECV4RPC),";;",2)
. . . S ECCOLERR=@("ECPRV"_NUM_"PC")
. . . D ERROR
. . E S ECPRVIEN=ECPROVV
.;
.; If provider name passed in, find on B x-ref and
.; make sure there isn't more than 1 with same name
.N ECPRVNXT,ECPRVMOR,ECPRVMNT
.S (ECPRVMOR,ECPRVMNT)=0,ECCOLERR=@("ECPRV"_NUM_"PC")
.I +ECPROVV'>0,$D(^VA(200,"B",ECPROVV)) D
. . S ECPRVIE2=$O(^VA(200,"B",ECPROVV,""))
. . S ECPRVNXT=$O(^VA(200,"B",ECPROVV,ECPRVIE2))
. . I ECPRVNXT'="" D
. . . S ECERRMSG=$P($T(PROV5^ECV4RPC),";;",2)
. . . S ECCOLERR=@("ECPRV"_NUM_"PC")
. . . D ERROR
. . . S ECPRVMOR=1
. . E S ECPRVIEN=ECPRVIE2
.;
.I +ECPROVV'>0,'$D(^VA(200,"B",ECPROVV)) D
. . ; Exact match not found on New Person file
. . ; Generate standard error message
. . S ECERRMSG=$P($T(PROV1^ECV4RPC),";;",2)
. . S ECCOLERR=@("ECPRV"_NUM_"PC")
. . D ERROR
. . S ECPRVMNT=1
.; If exact match not found, get provider info
.I ECPRVMNT D
. . ; look at next provider on file for 'close' match
. . N ECINFO,ECLENPRV,NOMATCH,ECSPEC,ECSUBSP
. . N ECCOUNT,ECFIRST,ECLAST,ECPRVNXT,ECPRVIE2,ECPRVIE3
. . S ECLENPRV=$L(ECPROVV),(ECPRVIE2,ECPRVIE3)="",(ECCOUNT,NOMATCH)=0
. . S ECPRVNXT=ECPROVV
. . F S ECPRVNXT=$O(^VA(200,"B",ECPRVNXT)) Q:NOMATCH=1!(ECPRVNXT="") D ;131 Added check for null
. . . F S ECPRVIE3=$O(^VA(200,"B",ECPRVNXT,ECPRVIE3)) Q:ECPRVIE3="" D
. . . . I ECPROVV'=$E(ECPRVNXT,1,ECLENPRV) S NOMATCH=1
. . . . E D
. . . . . ;get provider info and add to end of error string
. . . . . S ECINFO=$$GET^XUA4A72(ECPRVIE3,ECENCV)
. . . . . I +ECINFO'>0 D
. . . . . . S ECERRMSG=ECPRVNXT_"-"_ECPRVIE3_"-"_$S(DSSUPCE="N"&($D(^EC(722,"B",ECPRVIE3))):"Non Licensed Provider",+ECINFO=-1:"Not a provider",1:"Inactive Provider for this encounter date") ;134
. . . . . . D ERROR
. . . . . . ;S ECCOUNT=ECCOUNT+1
. . . . . I +ECINFO>0 D
. . . . . . S ECCOUNT=ECCOUNT+1
. . . . . . S ECSPEC=$P(ECINFO,U,3)
. . . . . . I ECSPEC=" " S ECSPEC=""
. . . . . . S ECSUBSP=$P(ECINFO,U,4)
. . . . . . I ECSUBSP=" " S ECSUBSP=""
. . . . . . S ECPCLASS=$P(^VA(200,ECPRVIE3,"USC1",0),U,3)
. . . . . . I ECPCLASS="" S ECPCLASS="PERSON CLASS NOT FOUND"
. . . . . . S ECERRMSG=ECPRVNXT_"-"_ECPRVIE3_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
. . . . . . D ERROR
.; If more than one provider with that name, get info
.I ECPRVMOR D
. . N ECINFO,ECSPEC,ECSUBSP,ECPCLASS,ECCOUNT,ECFIRST,ECLAST,ECPRVIE2
. . S ECCOUNT=0,ECPRVIE2=0
. . ;look at each provider for exact match
. . F S ECPRVIE2=$O(^VA(200,"B",ECPROVV,ECPRVIE2)) Q:ECPRVIE2="" D
. . . S ECINFO=$$GET^XUA4A72(ECPRVIE2,ECENCV)
. . . I +ECINFO'>0 D
. . . . S ECERRMSG=ECPROVV_"-"_ECPRVIE2_"-"_$S(DSSUPCE="N"&($D(^EC(722,"B",ECPRVIE2))):"Non Licensed Provider",+ECINFO=-1:"Not a provider",1:"Inactive Provider for this encounter date") ;134
. . . . D ERROR
. . . I +ECINFO>0 D
. . . . S ECCOUNT=ECCOUNT+1
. . . . S ECSPEC=$P(ECINFO,U,3)
. . . . I ECSPEC=" " S ECSPEC=""
. . . . S ECSUBSP=$P(ECINFO,U,4)
. . . . I ECSUBSP=" " S ECSUBSP=""
. . . . S ECPCLASS=$P(^VA(200,ECPRVIE2,"USC1",0),U,3)
. . . . I ECPCLASS="" S ECPCLASS="PERSON CLASS NOT FOUND"
. . . . S ECERRMSG=ECPROVV_"-"_ECPRVIE2_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
. . . . D ERROR
.;
.; Check for valid provider
.S ECPROVV=ECPROV1
.S %DT="XST",X=ECENCV D ^%DT S ECPDT=$S(+Y>0:+Y,1:DT)
.I 'ECERRFLG D ;134
. .I DSSUPCE'="N"!(DSSUPCE="N"&('$D(^EC(722,"B",ECPRVIEN)))) D ;134,139 Check providers for units that send to PCE or for units that don't send but have a traditional provider
. . . ;134 section updated
. . . I ECPRVIEN=0 S ECPRVIEN=$O(^VA(200,"B",ECPROVV,0))
. . . S ECINFO=$$GET^XUA4A72(ECPRVIEN,ECPDT) I +ECINFO<0 D ;134
. . . . S ECERRMSG=$S(+ECINFO=-1:$P($T(PROV8^ECV4RPC),";;",2),1:$P($T(PROV3^ECV4RPC),";;",2)) ;134
. . . . S ECCOLERR=@("ECPRV"_NUM_"PC")
. . . . D ERROR
. . . . Q
. . . Q
. .;134 Added section to check for non licensed providers
. .I DSSUPCE="N",'$D(^EC(722,"B",ECPRVIEN)),$$GET^XUA4A72(ECPRVIEN,ECPDT)<0 D
. . . S ECERRMSG=$P($T(PROV7^ECV4RPC),";;",2)
. . . S ECCOLERR=@("ECPRV"_NUM_"PC")
. . . D ERROR
. . . Q
. . Q
.I 'ECERRFLG D ;131 Section added to check for duplicate providers
..I $D(PRVARR(ECPRVIEN)) D
...S ECERRMSG=$P($T(PROV6^ECV4RPC),";;",2)
...S ECCOLERR=@("ECPRV"_NUM_"PC")
...D ERROR
..S PRVARR(ECPRVIEN)=""
..Q
. Q
;
;--Determine Patient Status--
S ECPSTAT=""
I ECSSNIEN D
. S ECERRFLG=0
. S ECPSTAT=$$INOUTPT^ECUTL0(ECSSNIEN,+ECENCV)
. I ECPSTAT="" D
. . ; Unable to determine patient status
. . S ECERRMSG=$P($T(STAT1^ECV4RPC),";;",2)
. . S ECCOLERR=ECENCPC
. . D ERROR
. . Q
. I ECPSTAT="I",'ECPSTATV,'ECERRFLG D
. . ; Patient status is Inpatient and override flag is false
. . S ECERRMSG=$P($T(STAT2^ECV4RPC),";;",2)
. . S ECCOLERR=ECENCPC
. . D ERROR
. . Q
;
;--Check to see if the DSS Unit is 'send to PCE'--
S ECDXIEN="",ECCLNIEN=""
S (ECSECDX1,ECSECDX2,ECSECDX3,ECSECDX4)="" ;159
I ECPSTAT'="",ECDSSIEN'="" D
. N ECDSSDAT,ECDSSPCE
. S ECDSSDAT=$G(^ECD(ECDSSIEN,0))
. S ECDSSPCE=$P(ECDSSDAT,U,14)
. ; If send is 'all records'
. I ECDSSPCE="A" D ;139
. . ;Validate Diagnosis code and Associated Clinic
. . D VALDIAG^ECV5RPC
. . D VALCLIN^ECV5RPC
. I ECDSSPCE="OOS" D ;139 Set encounter values to null
. . S (ECAOV,ECIRV,ECSCV,ECSWAV,ECMSTV,ECHNCV,ECCVV,ECSHADV,ECCLV)="" ;139 Values not use in OOS units
. Q
;
;--Check to see if DUZ is defined
S ECDUZ=$S($D(DUZ):DUZ,1:"")
I ECDUZ="" D
. ; Invalid DUZ
. S ECERRMSG=$P($T(DUZ^ECV4RPC),";;",2),ECCOLERR=0
. 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
;
;Error messages:
;
VOL1 ;;Volume must be a whole number from 1 to 99
VOL2 ;;Volume must contain numeric characters only
PROV1 ;;Provider has no B x-ref on New Person file(#200)
PROV2 ;;Unable to determine person class
PROV3 ;;Provider does not have an active person class
PROV4 ;;Provider IEN not found on New Person file(#200)
PROV5 ;;More than one provider with this name - use IEN
PROV6 ;;Duplicate provider identified - providers must be unique
PROV7 ;;Provider not identified as a non licensed provider
PROV8 ;;The provider has never been assigned a provider class
ENC1 ;;Invalid encounter date/time. Date cannot be in the future.
STAT1 ;;Unable to determine patient status
STAT2 ;;The patient status is Inpatient
DUZ ;;User DUZ not defined
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECV4RPC 8892 printed Oct 16, 2024@18:00:03 Page 2
ECV4RPC ;ALB/ACS - Event Capture Spreadsheet Data Validation ;12/2/22 14:26
+1 ;;2.0;EVENT CAPTURE;**25,33,49,131,134,139,159**;8 May 96;Build 61
+2 ;
+3 ; Reference to ^VA(200, in ICR #10060
+4 ; Reference to ^%DT in ICR #10003
+5 ; Reference to CHK^DIE in ICR #2053
+6 ;
+7 ;----------------------------------------------------------------------
+8 ; Validates the following Event Capture Spreadsheet Upload fields:
+9 ; 1. VOLUME
+10 ; 2. ENCOUNTER DATE/TIME
+11 ; 3. PROVIDER NAME
+12 ;
+13 ; Determines the following:
+14 ; 1. PATIENT STATUS
+15 ;----------------------------------------------------------------------
+16 ;
+17 ;--Volume must be 1 thru 99--
+18 NEW ECVOLVN,ECPDT
+19 SET ECVOLVN=ECVOLV
+20 IF (+ECVOLVN'=ECVOLVN)!(ECVOLVN<1)!(ECVOLVN>99)!(ECVOLVN?.E1"."1N.N)
Begin DoDot:1
+21 SET ECERRMSG=$PIECE($TEXT(VOL1^ECV4RPC),";;",2)
+22 SET ECCOLERR=ECVOLPC
+23 DO ERROR
+24 QUIT
End DoDot:1
+25 IF $LENGTH(ECVOLVN)'=$LENGTH(ECVOLV)
Begin DoDot:1
+26 ; Volume must be numeric
+27 SET ECERRMSG=$PIECE($TEXT(VOL2^ECV4RPC),";;",2)
+28 SET ECCOLERR=ECVOLPC
+29 DO ERROR
+30 QUIT
End DoDot:1
+31 ;
+32 ;--Encounter Date/Time--
+33 SET ECERRFLG=0
+34 NEW ECRETVAL
+35 SET %DT(0)="-NOW"
SET ECENCV=$TRANSLATE(ECENCV," ","")
+36 DO CHK^DIE(721,2,"E",ECENCV,.ECRETVAL)
+37 IF $GET(ECRETVAL)="^"
Begin DoDot:1
+38 ; Invalid encounter date/time
+39 SET ECERRMSG=$PIECE($TEXT(ENC1^ECV4RPC),";;",2)
+40 SET ECCOLERR=ECENCPC
+41 DO ERROR
+42 QUIT
End DoDot:1
+43 IF $GET(ECRETVAL)'="^"
Begin DoDot:1
+44 SET %DT="XST"
SET X=ECENCV
+45 DO ^%DT
+46 SET ECENCV=+Y
+47 QUIT
End DoDot:1
+48 ;
+49 ;--Provider Name or IEN must be on the New Person file--
+50 ;--and provider must have active person class --
+51 ;131,134
NEW ECPROV1,ECPROVV,NUM,PRVARR,DSSUPCE
+52 ;139
SET DSSUPCE=$PIECE($GET(^ECD(+$GET(ECDSSIEN),0)),U,14)
if DSSUPCE=""
SET DSSUPCE="N"
+53 ;131 Entire section modified to add checking for up to 7 providers
+54 ;If no error, set provider value to IEN
FOR NUM=1:1:7
SET ECPROVV=@("ECPRV"_NUM_"V")
IF ECPROVV'=""
Begin DoDot:1
+55 SET ECERRFLG=0
SET ECPRVIEN=0
+56 ; Remove punctuation if necessary
+57 IF ECPROVV?.E1P
SET ECPROVV=$EXTRACT(ECPROVV,1,$LENGTH(ECPROVV)-1)
+58 ; If provider ien passed in, find on file
+59 SET ECPROV1=ECPROVV
+60 IF +ECPROVV>0
Begin DoDot:2
+61 IF '$DATA(^VA(200,ECPROVV))
Begin DoDot:3
+62 ; Provider ien not found on New Person file
+63 SET ECERRMSG=$PIECE($TEXT(PROV4^ECV4RPC),";;",2)
+64 SET ECCOLERR=@("ECPRV"_NUM_"PC")
+65 DO ERROR
End DoDot:3
+66 IF '$TEST
SET ECPRVIEN=ECPROVV
End DoDot:2
+67 ;
+68 ; If provider name passed in, find on B x-ref and
+69 ; make sure there isn't more than 1 with same name
+70 NEW ECPRVNXT,ECPRVMOR,ECPRVMNT
+71 SET (ECPRVMOR,ECPRVMNT)=0
SET ECCOLERR=@("ECPRV"_NUM_"PC")
+72 IF +ECPROVV'>0
IF $DATA(^VA(200,"B",ECPROVV))
Begin DoDot:2
+73 SET ECPRVIE2=$ORDER(^VA(200,"B",ECPROVV,""))
+74 SET ECPRVNXT=$ORDER(^VA(200,"B",ECPROVV,ECPRVIE2))
+75 IF ECPRVNXT'=""
Begin DoDot:3
+76 SET ECERRMSG=$PIECE($TEXT(PROV5^ECV4RPC),";;",2)
+77 SET ECCOLERR=@("ECPRV"_NUM_"PC")
+78 DO ERROR
+79 SET ECPRVMOR=1
End DoDot:3
+80 IF '$TEST
SET ECPRVIEN=ECPRVIE2
End DoDot:2
+81 ;
+82 IF +ECPROVV'>0
IF '$DATA(^VA(200,"B",ECPROVV))
Begin DoDot:2
+83 ; Exact match not found on New Person file
+84 ; Generate standard error message
+85 SET ECERRMSG=$PIECE($TEXT(PROV1^ECV4RPC),";;",2)
+86 SET ECCOLERR=@("ECPRV"_NUM_"PC")
+87 DO ERROR
+88 SET ECPRVMNT=1
End DoDot:2
+89 ; If exact match not found, get provider info
+90 IF ECPRVMNT
Begin DoDot:2
+91 ; look at next provider on file for 'close' match
+92 NEW ECINFO,ECLENPRV,NOMATCH,ECSPEC,ECSUBSP
+93 NEW ECCOUNT,ECFIRST,ECLAST,ECPRVNXT,ECPRVIE2,ECPRVIE3
+94 SET ECLENPRV=$LENGTH(ECPROVV)
SET (ECPRVIE2,ECPRVIE3)=""
SET (ECCOUNT,NOMATCH)=0
+95 SET ECPRVNXT=ECPROVV
+96 ;131 Added check for null
FOR
SET ECPRVNXT=$ORDER(^VA(200,"B",ECPRVNXT))
if NOMATCH=1!(ECPRVNXT="")
QUIT
Begin DoDot:3
+97 FOR
SET ECPRVIE3=$ORDER(^VA(200,"B",ECPRVNXT,ECPRVIE3))
if ECPRVIE3=""
QUIT
Begin DoDot:4
+98 IF ECPROVV'=$EXTRACT(ECPRVNXT,1,ECLENPRV)
SET NOMATCH=1
+99 IF '$TEST
Begin DoDot:5
+100 ;get provider info and add to end of error string
+101 SET ECINFO=$$GET^XUA4A72(ECPRVIE3,ECENCV)
+102 IF +ECINFO'>0
Begin DoDot:6
+103 ;134
SET ECERRMSG=ECPRVNXT_"-"_ECPRVIE3_"-"_$SELECT(DSSUPCE="N"&($DATA(^EC(722,"B",ECPRVIE3))):"Non Licensed Provider",+ECINFO=-1:"Not a provider",1:"Inactive Provider for this encounter date")
+104 DO ERROR
+105 ;S ECCOUNT=ECCOUNT+1
End DoDot:6
+106 IF +ECINFO>0
Begin DoDot:6
+107 SET ECCOUNT=ECCOUNT+1
+108 SET ECSPEC=$PIECE(ECINFO,U,3)
+109 IF ECSPEC=" "
SET ECSPEC=""
+110 SET ECSUBSP=$PIECE(ECINFO,U,4)
+111 IF ECSUBSP=" "
SET ECSUBSP=""
+112 SET ECPCLASS=$PIECE(^VA(200,ECPRVIE3,"USC1",0),U,3)
+113 IF ECPCLASS=""
SET ECPCLASS="PERSON CLASS NOT FOUND"
+114 SET ECERRMSG=ECPRVNXT_"-"_ECPRVIE3_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
+115 DO ERROR
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+116 ; If more than one provider with that name, get info
+117 IF ECPRVMOR
Begin DoDot:2
+118 NEW ECINFO,ECSPEC,ECSUBSP,ECPCLASS,ECCOUNT,ECFIRST,ECLAST,ECPRVIE2
+119 SET ECCOUNT=0
SET ECPRVIE2=0
+120 ;look at each provider for exact match
+121 FOR
SET ECPRVIE2=$ORDER(^VA(200,"B",ECPROVV,ECPRVIE2))
if ECPRVIE2=""
QUIT
Begin DoDot:3
+122 SET ECINFO=$$GET^XUA4A72(ECPRVIE2,ECENCV)
+123 IF +ECINFO'>0
Begin DoDot:4
+124 ;134
SET ECERRMSG=ECPROVV_"-"_ECPRVIE2_"-"_$SELECT(DSSUPCE="N"&($DATA(^EC(722,"B",ECPRVIE2))):"Non Licensed Provider",+ECINFO=-1:"Not a provider",1:"Inactive Provider for this encounter date")
+125 DO ERROR
End DoDot:4
+126 IF +ECINFO>0
Begin DoDot:4
+127 SET ECCOUNT=ECCOUNT+1
+128 SET ECSPEC=$PIECE(ECINFO,U,3)
+129 IF ECSPEC=" "
SET ECSPEC=""
+130 SET ECSUBSP=$PIECE(ECINFO,U,4)
+131 IF ECSUBSP=" "
SET ECSUBSP=""
+132 SET ECPCLASS=$PIECE(^VA(200,ECPRVIE2,"USC1",0),U,3)
+133 IF ECPCLASS=""
SET ECPCLASS="PERSON CLASS NOT FOUND"
+134 SET ECERRMSG=ECPROVV_"-"_ECPRVIE2_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
+135 DO ERROR
End DoDot:4
End DoDot:3
End DoDot:2
+136 ;
+137 ; Check for valid provider
+138 SET ECPROVV=ECPROV1
+139 SET %DT="XST"
SET X=ECENCV
DO ^%DT
SET ECPDT=$SELECT(+Y>0:+Y,1:DT)
+140 ;134
IF 'ECERRFLG
Begin DoDot:2
+141 ;134,139 Check providers for units that send to PCE or for units that don't send but have a traditional provider
IF DSSUPCE'="N"!(DSSUPCE="N"&('$DATA(^EC(722,"B",ECPRVIEN))))
Begin DoDot:3
+142 ;134 section updated
+143 IF ECPRVIEN=0
SET ECPRVIEN=$ORDER(^VA(200,"B",ECPROVV,0))
+144 ;134
SET ECINFO=$$GET^XUA4A72(ECPRVIEN,ECPDT)
IF +ECINFO<0
Begin DoDot:4
+145 ;134
SET ECERRMSG=$SELECT(+ECINFO=-1:$PIECE($TEXT(PROV8^ECV4RPC),";;",2),1:$PIECE($TEXT(PROV3^ECV4RPC),";;",2))
+146 SET ECCOLERR=@("ECPRV"_NUM_"PC")
+147 DO ERROR
+148 QUIT
End DoDot:4
+149 QUIT
End DoDot:3
+150 ;134 Added section to check for non licensed providers
+151 IF DSSUPCE="N"
IF '$DATA(^EC(722,"B",ECPRVIEN))
IF $$GET^XUA4A72(ECPRVIEN,ECPDT)<0
Begin DoDot:3
+152 SET ECERRMSG=$PIECE($TEXT(PROV7^ECV4RPC),";;",2)
+153 SET ECCOLERR=@("ECPRV"_NUM_"PC")
+154 DO ERROR
+155 QUIT
End DoDot:3
+156 QUIT
End DoDot:2
+157 ;131 Section added to check for duplicate providers
IF 'ECERRFLG
Begin DoDot:2
+158 IF $DATA(PRVARR(ECPRVIEN))
Begin DoDot:3
+159 SET ECERRMSG=$PIECE($TEXT(PROV6^ECV4RPC),";;",2)
+160 SET ECCOLERR=@("ECPRV"_NUM_"PC")
+161 DO ERROR
End DoDot:3
+162 SET PRVARR(ECPRVIEN)=""
+163 QUIT
End DoDot:2
+164 QUIT
End DoDot:1
IF '$GET(ECERRFLG)
SET @("ECPRV"_NUM_"V")=$GET(ECPRVIEN)
+165 ;
+166 ;--Determine Patient Status--
+167 SET ECPSTAT=""
+168 IF ECSSNIEN
Begin DoDot:1
+169 SET ECERRFLG=0
+170 SET ECPSTAT=$$INOUTPT^ECUTL0(ECSSNIEN,+ECENCV)
+171 IF ECPSTAT=""
Begin DoDot:2
+172 ; Unable to determine patient status
+173 SET ECERRMSG=$PIECE($TEXT(STAT1^ECV4RPC),";;",2)
+174 SET ECCOLERR=ECENCPC
+175 DO ERROR
+176 QUIT
End DoDot:2
+177 IF ECPSTAT="I"
IF 'ECPSTATV
IF 'ECERRFLG
Begin DoDot:2
+178 ; Patient status is Inpatient and override flag is false
+179 SET ECERRMSG=$PIECE($TEXT(STAT2^ECV4RPC),";;",2)
+180 SET ECCOLERR=ECENCPC
+181 DO ERROR
+182 QUIT
End DoDot:2
End DoDot:1
+183 ;
+184 ;--Check to see if the DSS Unit is 'send to PCE'--
+185 SET ECDXIEN=""
SET ECCLNIEN=""
+186 ;159
SET (ECSECDX1,ECSECDX2,ECSECDX3,ECSECDX4)=""
+187 IF ECPSTAT'=""
IF ECDSSIEN'=""
Begin DoDot:1
+188 NEW ECDSSDAT,ECDSSPCE
+189 SET ECDSSDAT=$GET(^ECD(ECDSSIEN,0))
+190 SET ECDSSPCE=$PIECE(ECDSSDAT,U,14)
+191 ; If send is 'all records'
+192 ;139
IF ECDSSPCE="A"
Begin DoDot:2
+193 ;Validate Diagnosis code and Associated Clinic
+194 DO VALDIAG^ECV5RPC
+195 DO VALCLIN^ECV5RPC
End DoDot:2
+196 ;139 Set encounter values to null
IF ECDSSPCE="OOS"
Begin DoDot:2
+197 ;139 Values not use in OOS units
SET (ECAOV,ECIRV,ECSCV,ECSWAV,ECMSTV,ECHNCV,ECCVV,ECSHADV,ECCLV)=""
End DoDot:2
+198 QUIT
End DoDot:1
+199 ;
+200 ;--Check to see if DUZ is defined
+201 SET ECDUZ=$SELECT($DATA(DUZ):DUZ,1:"")
+202 IF ECDUZ=""
Begin DoDot:1
+203 ; Invalid DUZ
+204 SET ECERRMSG=$PIECE($TEXT(DUZ^ECV4RPC),";;",2)
SET ECCOLERR=0
+205 DO ERROR
End DoDot:1
+206 QUIT
+207 ;;
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 ;
+11 ;Error messages:
+12 ;
VOL1 ;;Volume must be a whole number from 1 to 99
VOL2 ;;Volume must contain numeric characters only
PROV1 ;;Provider has no B x-ref on New Person file(#200)
PROV2 ;;Unable to determine person class
PROV3 ;;Provider does not have an active person class
PROV4 ;;Provider IEN not found on New Person file(#200)
PROV5 ;;More than one provider with this name - use IEN
PROV6 ;;Duplicate provider identified - providers must be unique
PROV7 ;;Provider not identified as a non licensed provider
PROV8 ;;The provider has never been assigned a provider class
ENC1 ;;Invalid encounter date/time. Date cannot be in the future.
STAT1 ;;Unable to determine patient status
STAT2 ;;The patient status is Inpatient
DUZ ;;User DUZ not defined
