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 Apr 09, 2024@21:00:32 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
