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