Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECV4RPC

ECV4RPC.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to ^VA(200, in ICR #10060
  1. ; Reference to ^%DT in ICR #10003
  1. ; Reference to CHK^DIE in ICR #2053
  1. ;
  1. ;----------------------------------------------------------------------
  1. ; Validates the following Event Capture Spreadsheet Upload fields:
  1. ; 1. VOLUME
  1. ; 2. ENCOUNTER DATE/TIME
  1. ; 3. PROVIDER NAME
  1. ;
  1. ; Determines the following:
  1. ; 1. PATIENT STATUS
  1. ;----------------------------------------------------------------------
  1. ;
  1. ;--Volume must be 1 thru 99--
  1. N ECVOLVN,ECPDT
  1. S ECVOLVN=ECVOLV
  1. I (+ECVOLVN'=ECVOLVN)!(ECVOLVN<1)!(ECVOLVN>99)!(ECVOLVN?.E1"."1N.N) D
  1. . S ECERRMSG=$P($T(VOL1^ECV4RPC),";;",2)
  1. . S ECCOLERR=ECVOLPC
  1. . D ERROR
  1. . Q
  1. I $L(ECVOLVN)'=$L(ECVOLV) D
  1. . ; Volume must be numeric
  1. . S ECERRMSG=$P($T(VOL2^ECV4RPC),";;",2)
  1. . S ECCOLERR=ECVOLPC
  1. . D ERROR
  1. . Q
  1. ;
  1. ;--Encounter Date/Time--
  1. S ECERRFLG=0
  1. N ECRETVAL
  1. S %DT(0)="-NOW",ECENCV=$TR(ECENCV," ","")
  1. D CHK^DIE(721,2,"E",ECENCV,.ECRETVAL)
  1. I $G(ECRETVAL)="^" D
  1. . ; Invalid encounter date/time
  1. . S ECERRMSG=$P($T(ENC1^ECV4RPC),";;",2)
  1. . S ECCOLERR=ECENCPC
  1. . D ERROR
  1. . Q
  1. I $G(ECRETVAL)'="^" D
  1. . S %DT="XST",X=ECENCV
  1. . D ^%DT
  1. . S ECENCV=+Y
  1. . Q
  1. ;
  1. ;--Provider Name or IEN must be on the New Person file--
  1. ;--and provider must have active person class --
  1. N ECPROV1,ECPROVV,NUM,PRVARR,DSSUPCE ;131,134
  1. S DSSUPCE=$P($G(^ECD(+$G(ECDSSIEN),0)),U,14) S:DSSUPCE="" DSSUPCE="N" ;139
  1. ;131 Entire section modified to add checking for up to 7 providers
  1. 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
  1. .S ECERRFLG=0,ECPRVIEN=0
  1. .; Remove punctuation if necessary
  1. .I ECPROVV?.E1P S ECPROVV=$E(ECPROVV,1,$L(ECPROVV)-1)
  1. .; If provider ien passed in, find on file
  1. .S ECPROV1=ECPROVV
  1. .I +ECPROVV>0 D
  1. . . I '$D(^VA(200,ECPROVV)) D
  1. . . . ; Provider ien not found on New Person file
  1. . . . S ECERRMSG=$P($T(PROV4^ECV4RPC),";;",2)
  1. . . . S ECCOLERR=@("ECPRV"_NUM_"PC")
  1. . . . D ERROR
  1. . . E S ECPRVIEN=ECPROVV
  1. .;
  1. .; If provider name passed in, find on B x-ref and
  1. .; make sure there isn't more than 1 with same name
  1. .N ECPRVNXT,ECPRVMOR,ECPRVMNT
  1. .S (ECPRVMOR,ECPRVMNT)=0,ECCOLERR=@("ECPRV"_NUM_"PC")
  1. .I +ECPROVV'>0,$D(^VA(200,"B",ECPROVV)) D
  1. . . S ECPRVIE2=$O(^VA(200,"B",ECPROVV,""))
  1. . . S ECPRVNXT=$O(^VA(200,"B",ECPROVV,ECPRVIE2))
  1. . . I ECPRVNXT'="" D
  1. . . . S ECERRMSG=$P($T(PROV5^ECV4RPC),";;",2)
  1. . . . S ECCOLERR=@("ECPRV"_NUM_"PC")
  1. . . . D ERROR
  1. . . . S ECPRVMOR=1
  1. . . E S ECPRVIEN=ECPRVIE2
  1. .;
  1. .I +ECPROVV'>0,'$D(^VA(200,"B",ECPROVV)) D
  1. . . ; Exact match not found on New Person file
  1. . . ; Generate standard error message
  1. . . S ECERRMSG=$P($T(PROV1^ECV4RPC),";;",2)
  1. . . S ECCOLERR=@("ECPRV"_NUM_"PC")
  1. . . D ERROR
  1. . . S ECPRVMNT=1
  1. .; If exact match not found, get provider info
  1. .I ECPRVMNT D
  1. . . ; look at next provider on file for 'close' match
  1. . . N ECINFO,ECLENPRV,NOMATCH,ECSPEC,ECSUBSP
  1. . . N ECCOUNT,ECFIRST,ECLAST,ECPRVNXT,ECPRVIE2,ECPRVIE3
  1. . . S ECLENPRV=$L(ECPROVV),(ECPRVIE2,ECPRVIE3)="",(ECCOUNT,NOMATCH)=0
  1. . . S ECPRVNXT=ECPROVV
  1. . . F S ECPRVNXT=$O(^VA(200,"B",ECPRVNXT)) Q:NOMATCH=1!(ECPRVNXT="") D ;131 Added check for null
  1. . . . F S ECPRVIE3=$O(^VA(200,"B",ECPRVNXT,ECPRVIE3)) Q:ECPRVIE3="" D
  1. . . . . I ECPROVV'=$E(ECPRVNXT,1,ECLENPRV) S NOMATCH=1
  1. . . . . E D
  1. . . . . . ;get provider info and add to end of error string
  1. . . . . . S ECINFO=$$GET^XUA4A72(ECPRVIE3,ECENCV)
  1. . . . . . I +ECINFO'>0 D
  1. . . . . . . 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
  1. . . . . . . D ERROR
  1. . . . . . . ;S ECCOUNT=ECCOUNT+1
  1. . . . . . I +ECINFO>0 D
  1. . . . . . . S ECCOUNT=ECCOUNT+1
  1. . . . . . . S ECSPEC=$P(ECINFO,U,3)
  1. . . . . . . I ECSPEC=" " S ECSPEC=""
  1. . . . . . . S ECSUBSP=$P(ECINFO,U,4)
  1. . . . . . . I ECSUBSP=" " S ECSUBSP=""
  1. . . . . . . S ECPCLASS=$P(^VA(200,ECPRVIE3,"USC1",0),U,3)
  1. . . . . . . I ECPCLASS="" S ECPCLASS="PERSON CLASS NOT FOUND"
  1. . . . . . . S ECERRMSG=ECPRVNXT_"-"_ECPRVIE3_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
  1. . . . . . . D ERROR
  1. .; If more than one provider with that name, get info
  1. .I ECPRVMOR D
  1. . . N ECINFO,ECSPEC,ECSUBSP,ECPCLASS,ECCOUNT,ECFIRST,ECLAST,ECPRVIE2
  1. . . S ECCOUNT=0,ECPRVIE2=0
  1. . . ;look at each provider for exact match
  1. . . F S ECPRVIE2=$O(^VA(200,"B",ECPROVV,ECPRVIE2)) Q:ECPRVIE2="" D
  1. . . . S ECINFO=$$GET^XUA4A72(ECPRVIE2,ECENCV)
  1. . . . I +ECINFO'>0 D
  1. . . . . 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
  1. . . . . D ERROR
  1. . . . I +ECINFO>0 D
  1. . . . . S ECCOUNT=ECCOUNT+1
  1. . . . . S ECSPEC=$P(ECINFO,U,3)
  1. . . . . I ECSPEC=" " S ECSPEC=""
  1. . . . . S ECSUBSP=$P(ECINFO,U,4)
  1. . . . . I ECSUBSP=" " S ECSUBSP=""
  1. . . . . S ECPCLASS=$P(^VA(200,ECPRVIE2,"USC1",0),U,3)
  1. . . . . I ECPCLASS="" S ECPCLASS="PERSON CLASS NOT FOUND"
  1. . . . . S ECERRMSG=ECPROVV_"-"_ECPRVIE2_"-"_ECSPEC_"-"_ECSUBSP_"-"_ECPCLASS
  1. . . . . D ERROR
  1. .;
  1. .; Check for valid provider
  1. .S ECPROVV=ECPROV1
  1. .S %DT="XST",X=ECENCV D ^%DT S ECPDT=$S(+Y>0:+Y,1:DT)
  1. .I 'ECERRFLG D ;134
  1. . .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
  1. . . . ;134 section updated
  1. . . . I ECPRVIEN=0 S ECPRVIEN=$O(^VA(200,"B",ECPROVV,0))
  1. . . . S ECINFO=$$GET^XUA4A72(ECPRVIEN,ECPDT) I +ECINFO<0 D ;134
  1. . . . . S ECERRMSG=$S(+ECINFO=-1:$P($T(PROV8^ECV4RPC),";;",2),1:$P($T(PROV3^ECV4RPC),";;",2)) ;134
  1. . . . . S ECCOLERR=@("ECPRV"_NUM_"PC")
  1. . . . . D ERROR
  1. . . . . Q
  1. . . . Q
  1. . .;134 Added section to check for non licensed providers
  1. . .I DSSUPCE="N",'$D(^EC(722,"B",ECPRVIEN)),$$GET^XUA4A72(ECPRVIEN,ECPDT)<0 D
  1. . . . S ECERRMSG=$P($T(PROV7^ECV4RPC),";;",2)
  1. . . . S ECCOLERR=@("ECPRV"_NUM_"PC")
  1. . . . D ERROR
  1. . . . Q
  1. . . Q
  1. .I 'ECERRFLG D ;131 Section added to check for duplicate providers
  1. ..I $D(PRVARR(ECPRVIEN)) D
  1. ...S ECERRMSG=$P($T(PROV6^ECV4RPC),";;",2)
  1. ...S ECCOLERR=@("ECPRV"_NUM_"PC")
  1. ...D ERROR
  1. ..S PRVARR(ECPRVIEN)=""
  1. ..Q
  1. . Q
  1. ;
  1. ;--Determine Patient Status--
  1. S ECPSTAT=""
  1. I ECSSNIEN D
  1. . S ECERRFLG=0
  1. . S ECPSTAT=$$INOUTPT^ECUTL0(ECSSNIEN,+ECENCV)
  1. . I ECPSTAT="" D
  1. . . ; Unable to determine patient status
  1. . . S ECERRMSG=$P($T(STAT1^ECV4RPC),";;",2)
  1. . . S ECCOLERR=ECENCPC
  1. . . D ERROR
  1. . . Q
  1. . I ECPSTAT="I",'ECPSTATV,'ECERRFLG D
  1. . . ; Patient status is Inpatient and override flag is false
  1. . . S ECERRMSG=$P($T(STAT2^ECV4RPC),";;",2)
  1. . . S ECCOLERR=ECENCPC
  1. . . D ERROR
  1. . . Q
  1. ;
  1. ;--Check to see if the DSS Unit is 'send to PCE'--
  1. S ECDXIEN="",ECCLNIEN=""
  1. S (ECSECDX1,ECSECDX2,ECSECDX3,ECSECDX4)="" ;159
  1. I ECPSTAT'="",ECDSSIEN'="" D
  1. . N ECDSSDAT,ECDSSPCE
  1. . S ECDSSDAT=$G(^ECD(ECDSSIEN,0))
  1. . S ECDSSPCE=$P(ECDSSDAT,U,14)
  1. . ; If send is 'all records'
  1. . I ECDSSPCE="A" D ;139
  1. . . ;Validate Diagnosis code and Associated Clinic
  1. . . D VALDIAG^ECV5RPC
  1. . . D VALCLIN^ECV5RPC
  1. . I ECDSSPCE="OOS" D ;139 Set encounter values to null
  1. . . S (ECAOV,ECIRV,ECSCV,ECSWAV,ECMSTV,ECHNCV,ECCVV,ECSHADV,ECCLV)="" ;139 Values not use in OOS units
  1. . Q
  1. ;
  1. ;--Check to see if DUZ is defined
  1. S ECDUZ=$S($D(DUZ):DUZ,1:"")
  1. I ECDUZ="" D
  1. . ; Invalid DUZ
  1. . S ECERRMSG=$P($T(DUZ^ECV4RPC),";;",2),ECCOLERR=0
  1. . D ERROR
  1. Q
  1. ;;
  1. ERROR ;--Set up array entry to contain the following:
  1. ;1. record number
  1. ;2. column number on spreadsheet containing the record number
  1. ;3. column number on spreadsheet containing the data in error
  1. ;4. error message
  1. ;
  1. S ECINDEX=ECINDEX+1
  1. S RESULTS(ECINDEX)=ECRECV_"^"_ECRECPC_"^"_ECCOLERR_"^"_ECERRMSG_"^"
  1. S ECERRFLG=1
  1. Q
  1. ;
  1. ;Error messages:
  1. ;
  1. VOL1 ;;Volume must be a whole number from 1 to 99
  1. VOL2 ;;Volume must contain numeric characters only
  1. PROV1 ;;Provider has no B x-ref on New Person file(#200)
  1. PROV2 ;;Unable to determine person class
  1. PROV3 ;;Provider does not have an active person class
  1. PROV4 ;;Provider IEN not found on New Person file(#200)
  1. PROV5 ;;More than one provider with this name - use IEN
  1. PROV6 ;;Duplicate provider identified - providers must be unique
  1. PROV7 ;;Provider not identified as a non licensed provider
  1. PROV8 ;;The provider has never been assigned a provider class
  1. ENC1 ;;Invalid encounter date/time. Date cannot be in the future.
  1. STAT1 ;;Unable to determine patient status
  1. STAT2 ;;The patient status is Inpatient
  1. DUZ ;;User DUZ not defined