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  Sep 23, 2025@19:35:24                                                                                                                                                                                                     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