- ECV2RPC ;ALB/ACS - Event Capture Spreadsheet Validation ;10/31/17 12:33
- ;;2.0;EVENT CAPTURE;**25,30,49,95,139**;8 May 96;Build 7
- ;
- ;-----------------------------------------------------------------------
- ; Validates the following Event Capture spreadsheet fields:
- ; 1. Location
- ; 2. Patient SSN
- ; 3. Patient Name
- ;-----------------------------------------------------------------------
- ;=======================================================================
- ;MODIFICATIONS
- ;08/2001 EC*2.0*30 Updated the error message for Location
- ;=======================================================================
- ;
- ;--Set up error flag
- S ECERRFLG=0
- ;
- ;--Location must be on the Institution file
- N ERR ;139
- I $G(ECSOURCE)="STATE HOME",'$D(^DIC(4,ECSTAV)) S ERR=1 ;139
- I $G(ECSOURCE)'="STATE HOME",'$D(^DIC(4,"D",ECSTAV)) S ERR=1 ;139
- I $G(ERR) D ;139
- . ; Location not on the VistA file
- . S ECERRMSG=$P($T(STA1^ECV2RPC),";;",2)_$S($G(ECSOURCE)="STATE HOME":" - Invalid Internal Entry Number (IEN)",1:" - Invalid Station Number") ;139
- . S ECCOLERR=ECSTAPC
- . D ERROR
- . Q
- ;Check for multiple station number entries
- I $G(ECSOURCE)'="STATE HOME" D ;139 Check for multiple station numbers
- .N LOC,C,STR
- .S (LOC,C)=0,STR=""
- .F S LOC=$O(^DIC(4,"D",ECSTAV,LOC)) Q:'LOC S C=C+1 D
- .. S LOC(LOC)=ECSTAV_", Location IEN "_LOC_", "_$P(^DIC(4,LOC,0),"^")
- .I C>1 S LOC=0 F S LOC=$O(LOC(LOC)) Q:'LOC D
- .. S ECERRMSG=$P($T(STA2^ECV2RPC),";;",2)_LOC(LOC)
- .. S ECCOLERR=ECSTAPC
- .. D ERROR
- .I C=1,$D(^DIC(4,"D",ECSTAV)) S ECSTAV=$O(^DIC(4,"D",ECSTAV,"")) ;get ien
- ;
- ;--Patient SSN must be on the Patient file--
- N ECNAMEU,ECVNAMEV,ECVNAME,ECSSNNUM,ECI
- S (ECSSNIEN,ECERRFLG)=0,ECSSNNUM=+ECSSNV
- I $L(ECSSNNUM)>9!$L(ECSSNV)>10 D
- . ; User has entered an SSN that is too long
- . S ECERRMSG=$P($T(SSN5^ECV2RPC),";;",2)
- . S ECCOLERR=ECSSNPC
- . D ERROR
- . Q
- I 'ECERRFLG D
- . ; -add leading zeros if needed
- . I $L(ECSSNNUM)<9 S ECSSNV=$E("000000000",1,9-$L(ECSSNNUM))_ECSSNNUM
- . I $L(ECSSNV)>10 D
- . . ; User has entered an invalid SSN
- . . S ECERRMSG=$P($T(SSN5^ECV2RPC),";;",2)
- . . S ECCOLERR=ECSSNPC
- . . D ERROR
- . . Q
- . I 'ECERRFLG,$L(ECSSNV)=10 D
- . . I $E(ECSSNV,10,10)'="P" D
- . . . ; Invalid SSN
- . . . S ECERRMSG=$P($T(SSN5^ECV2RPC),";;",2)
- . . . S ECCOLERR=ECSSNPC
- . . . D ERROR
- . . Q
- . I 'ECERRFLG,'$D(^DPT("SSN",ECSSNV)) D
- . . ; No SSN x-ref on patient file
- . . S ECERRMSG=$P($T(SSN1^ECV2RPC),";;",2)
- . . S ECCOLERR=ECSSNPC
- . . D ERROR
- . . Q
- . Q
- I 'ECERRFLG D
- . ; -get SSN IEN
- . S ECSSNIEN=$O(^DPT("SSN",ECSSNV,0))
- . I 'ECSSNIEN D
- . . S ECERRMSG=$P($T(SSN2^ECV2RPC),";;",2)
- . . S ECCOLERR=ECSSNPC
- . . D ERROR
- . . Q
- . Q
- I 'ECERRFLG,'$D(^DPT(ECSSNIEN,0)) D
- . ; SSN record not found
- . S ECERRMSG=$P($T(SSN3^ECV2RPC),";;",2)
- . S ECCOLERR=ECSSNPC
- . D ERROR
- . Q
- ;
- I 'ECERRFLG D
- . ; -Compare patient file ssn to patient ssn
- . S ECVSSN=$P(^DPT(ECSSNIEN,0),U,9)
- . I ECVSSN'=ECSSNV D
- . . ; Spreadsheet ssn doesn't match vista
- . . S ECERRMSG=$P($T(SSN4^ECV2RPC),";;",2)
- . . S ECCOLERR=ECSSNPC
- . . D ERROR
- . . Q
- . Q
- ;--Patient Name must match VistA name--
- I 'ECERRFLG D
- . S ECVNAME=$P(^DPT(ECSSNIEN,0),U,1)
- . I '$D(ECVNAME) D
- . . ; Patient name missing from VistA file
- . . S ECERRMSG=$P($T(NAME1^ECV2RPC),";;",2)
- . . S ECCOLERR=ECSSNPC
- . . D ERROR
- . . Q
- . Q
- I 'ECERRFLG,'ECDECPAT D
- . N DFN,VADM S DFN=ECSSNIEN D 2^VADPT I +VADM(6) D
- . . S ECERRMSG="WARNING: [PATIENT DIED ON "_$P(VADM(6),U,2)_"]"
- . . S ECCOLERR=ECSSNPC
- . . D ERROR
- ; -- Patient last name check
- I 'ECERRFLG D
- . F ECI=1:1:$L($P(ECPATV,",")) D Q:ECERRFLG
- . .S ECVNAMEV=$E($P(ECVNAME,","),1,ECI),ECNAMEU=$E($P(ECPATV,","),1,ECI)
- . .I ECVNAMEV=ECNAMEU Q
- . .S ECERRMSG=$P($T(NAME2^ECV2RPC),";;",2)
- . .S ECCOLERR=ECPATLPC
- . .D ERROR
- ; -- Patient first name check
- I 'ECERRFLG D
- . F ECI=1:1:$L($P(ECPATV,",",2)) D Q:ECERRFLG
- . .S ECVNAMEV=$E($P(ECVNAME,",",2),1,ECI),ECNAMEU=$E($P(ECPATV,",",2),1,ECI)
- . .I ECVNAMEV=ECNAMEU Q
- . .S ECERRMSG=$P($T(NAME3^ECV2RPC),";;",2)
- . .S ECCOLERR=ECPATLPC
- . .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:
- ;
- STA1 ;;Location not in Institution file (#4)
- STA2 ;;Multiple entries found for Station #
- SSN1 ;;No SSN x-ref on patient file(#2)
- SSN2 ;;No SSN entry on patient file(#2)
- SSN3 ;;No internal entry on patient file(#2) for ssn x-ref
- SSN4 ;;SSN doesn't match SSN on patient file(#2)
- SSN5 ;;SSN invalid
- NAME1 ;;Patient Name is missing from VistA patient file(#2)
- NAME2 ;;Patient last name doesn't match VistA
- NAME3 ;;Patient first name doesn't match VistA
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECV2RPC 5034 printed Feb 18, 2025@23:25:41 Page 2
- ECV2RPC ;ALB/ACS - Event Capture Spreadsheet Validation ;10/31/17 12:33
- +1 ;;2.0;EVENT CAPTURE;**25,30,49,95,139**;8 May 96;Build 7
- +2 ;
- +3 ;-----------------------------------------------------------------------
- +4 ; Validates the following Event Capture spreadsheet fields:
- +5 ; 1. Location
- +6 ; 2. Patient SSN
- +7 ; 3. Patient Name
- +8 ;-----------------------------------------------------------------------
- +9 ;=======================================================================
- +10 ;MODIFICATIONS
- +11 ;08/2001 EC*2.0*30 Updated the error message for Location
- +12 ;=======================================================================
- +13 ;
- +14 ;--Set up error flag
- +15 SET ECERRFLG=0
- +16 ;
- +17 ;--Location must be on the Institution file
- +18 ;139
- NEW ERR
- +19 ;139
- IF $GET(ECSOURCE)="STATE HOME"
- IF '$DATA(^DIC(4,ECSTAV))
- SET ERR=1
- +20 ;139
- IF $GET(ECSOURCE)'="STATE HOME"
- IF '$DATA(^DIC(4,"D",ECSTAV))
- SET ERR=1
- +21 ;139
- IF $GET(ERR)
- Begin DoDot:1
- +22 ; Location not on the VistA file
- +23 ;139
- SET ECERRMSG=$PIECE($TEXT(STA1^ECV2RPC),";;",2)_$SELECT($GET(ECSOURCE)="STATE HOME":" - Invalid Internal Entry Number (IEN)",1:" - Invalid Station Number")
- +24 SET ECCOLERR=ECSTAPC
- +25 DO ERROR
- +26 QUIT
- End DoDot:1
- +27 ;Check for multiple station number entries
- +28 ;139 Check for multiple station numbers
- IF $GET(ECSOURCE)'="STATE HOME"
- Begin DoDot:1
- +29 NEW LOC,C,STR
- +30 SET (LOC,C)=0
- SET STR=""
- +31 FOR
- SET LOC=$ORDER(^DIC(4,"D",ECSTAV,LOC))
- if 'LOC
- QUIT
- SET C=C+1
- Begin DoDot:2
- +32 SET LOC(LOC)=ECSTAV_", Location IEN "_LOC_", "_$PIECE(^DIC(4,LOC,0),"^")
- End DoDot:2
- +33 IF C>1
- SET LOC=0
- FOR
- SET LOC=$ORDER(LOC(LOC))
- if 'LOC
- QUIT
- Begin DoDot:2
- +34 SET ECERRMSG=$PIECE($TEXT(STA2^ECV2RPC),";;",2)_LOC(LOC)
- +35 SET ECCOLERR=ECSTAPC
- +36 DO ERROR
- End DoDot:2
- +37 ;get ien
- IF C=1
- IF $DATA(^DIC(4,"D",ECSTAV))
- SET ECSTAV=$ORDER(^DIC(4,"D",ECSTAV,""))
- End DoDot:1
- +38 ;
- +39 ;--Patient SSN must be on the Patient file--
- +40 NEW ECNAMEU,ECVNAMEV,ECVNAME,ECSSNNUM,ECI
- +41 SET (ECSSNIEN,ECERRFLG)=0
- SET ECSSNNUM=+ECSSNV
- +42 IF $LENGTH(ECSSNNUM)>9!$LENGTH(ECSSNV)>10
- Begin DoDot:1
- +43 ; User has entered an SSN that is too long
- +44 SET ECERRMSG=$PIECE($TEXT(SSN5^ECV2RPC),";;",2)
- +45 SET ECCOLERR=ECSSNPC
- +46 DO ERROR
- +47 QUIT
- End DoDot:1
- +48 IF 'ECERRFLG
- Begin DoDot:1
- +49 ; -add leading zeros if needed
- +50 IF $LENGTH(ECSSNNUM)<9
- SET ECSSNV=$EXTRACT("000000000",1,9-$LENGTH(ECSSNNUM))_ECSSNNUM
- +51 IF $LENGTH(ECSSNV)>10
- Begin DoDot:2
- +52 ; User has entered an invalid SSN
- +53 SET ECERRMSG=$PIECE($TEXT(SSN5^ECV2RPC),";;",2)
- +54 SET ECCOLERR=ECSSNPC
- +55 DO ERROR
- +56 QUIT
- End DoDot:2
- +57 IF 'ECERRFLG
- IF $LENGTH(ECSSNV)=10
- Begin DoDot:2
- +58 IF $EXTRACT(ECSSNV,10,10)'="P"
- Begin DoDot:3
- +59 ; Invalid SSN
- +60 SET ECERRMSG=$PIECE($TEXT(SSN5^ECV2RPC),";;",2)
- +61 SET ECCOLERR=ECSSNPC
- +62 DO ERROR
- End DoDot:3
- +63 QUIT
- End DoDot:2
- +64 IF 'ECERRFLG
- IF '$DATA(^DPT("SSN",ECSSNV))
- Begin DoDot:2
- +65 ; No SSN x-ref on patient file
- +66 SET ECERRMSG=$PIECE($TEXT(SSN1^ECV2RPC),";;",2)
- +67 SET ECCOLERR=ECSSNPC
- +68 DO ERROR
- +69 QUIT
- End DoDot:2
- +70 QUIT
- End DoDot:1
- +71 IF 'ECERRFLG
- Begin DoDot:1
- +72 ; -get SSN IEN
- +73 SET ECSSNIEN=$ORDER(^DPT("SSN",ECSSNV,0))
- +74 IF 'ECSSNIEN
- Begin DoDot:2
- +75 SET ECERRMSG=$PIECE($TEXT(SSN2^ECV2RPC),";;",2)
- +76 SET ECCOLERR=ECSSNPC
- +77 DO ERROR
- +78 QUIT
- End DoDot:2
- +79 QUIT
- End DoDot:1
- +80 IF 'ECERRFLG
- IF '$DATA(^DPT(ECSSNIEN,0))
- Begin DoDot:1
- +81 ; SSN record not found
- +82 SET ECERRMSG=$PIECE($TEXT(SSN3^ECV2RPC),";;",2)
- +83 SET ECCOLERR=ECSSNPC
- +84 DO ERROR
- +85 QUIT
- End DoDot:1
- +86 ;
- +87 IF 'ECERRFLG
- Begin DoDot:1
- +88 ; -Compare patient file ssn to patient ssn
- +89 SET ECVSSN=$PIECE(^DPT(ECSSNIEN,0),U,9)
- +90 IF ECVSSN'=ECSSNV
- Begin DoDot:2
- +91 ; Spreadsheet ssn doesn't match vista
- +92 SET ECERRMSG=$PIECE($TEXT(SSN4^ECV2RPC),";;",2)
- +93 SET ECCOLERR=ECSSNPC
- +94 DO ERROR
- +95 QUIT
- End DoDot:2
- +96 QUIT
- End DoDot:1
- +97 ;--Patient Name must match VistA name--
- +98 IF 'ECERRFLG
- Begin DoDot:1
- +99 SET ECVNAME=$PIECE(^DPT(ECSSNIEN,0),U,1)
- +100 IF '$DATA(ECVNAME)
- Begin DoDot:2
- +101 ; Patient name missing from VistA file
- +102 SET ECERRMSG=$PIECE($TEXT(NAME1^ECV2RPC),";;",2)
- +103 SET ECCOLERR=ECSSNPC
- +104 DO ERROR
- +105 QUIT
- End DoDot:2
- +106 QUIT
- End DoDot:1
- +107 IF 'ECERRFLG
- IF 'ECDECPAT
- Begin DoDot:1
- +108 NEW DFN,VADM
- SET DFN=ECSSNIEN
- DO 2^VADPT
- IF +VADM(6)
- Begin DoDot:2
- +109 SET ECERRMSG="WARNING: [PATIENT DIED ON "_$PIECE(VADM(6),U,2)_"]"
- +110 SET ECCOLERR=ECSSNPC
- +111 DO ERROR
- End DoDot:2
- End DoDot:1
- +112 ; -- Patient last name check
- +113 IF 'ECERRFLG
- Begin DoDot:1
- +114 FOR ECI=1:1:$LENGTH($PIECE(ECPATV,","))
- Begin DoDot:2
- +115 SET ECVNAMEV=$EXTRACT($PIECE(ECVNAME,","),1,ECI)
- SET ECNAMEU=$EXTRACT($PIECE(ECPATV,","),1,ECI)
- +116 IF ECVNAMEV=ECNAMEU
- QUIT
- +117 SET ECERRMSG=$PIECE($TEXT(NAME2^ECV2RPC),";;",2)
- +118 SET ECCOLERR=ECPATLPC
- +119 DO ERROR
- End DoDot:2
- if ECERRFLG
- QUIT
- End DoDot:1
- +120 ; -- Patient first name check
- +121 IF 'ECERRFLG
- Begin DoDot:1
- +122 FOR ECI=1:1:$LENGTH($PIECE(ECPATV,",",2))
- Begin DoDot:2
- +123 SET ECVNAMEV=$EXTRACT($PIECE(ECVNAME,",",2),1,ECI)
- SET ECNAMEU=$EXTRACT($PIECE(ECPATV,",",2),1,ECI)
- +124 IF ECVNAMEV=ECNAMEU
- QUIT
- +125 SET ECERRMSG=$PIECE($TEXT(NAME3^ECV2RPC),";;",2)
- +126 SET ECCOLERR=ECPATLPC
- +127 DO ERROR
- End DoDot:2
- if ECERRFLG
- QUIT
- End DoDot:1
- +128 QUIT
- +129 ;
- 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 ;
- STA1 ;;Location not in Institution file (#4)
- STA2 ;;Multiple entries found for Station #
- SSN1 ;;No SSN x-ref on patient file(#2)
- SSN2 ;;No SSN entry on patient file(#2)
- SSN3 ;;No internal entry on patient file(#2) for ssn x-ref
- SSN4 ;;SSN doesn't match SSN on patient file(#2)
- SSN5 ;;SSN invalid
- NAME1 ;;Patient Name is missing from VistA patient file(#2)
- NAME2 ;;Patient last name doesn't match VistA
- NAME3 ;;Patient first name doesn't match VistA