AZHZCLV ;DSD/PDW - Clean VA patient file ; AUGUST 14, 1992
;;1.0;AZHZ;;AUG 14, 1992
;;
S ;
VAPAT ;start edits for fields in VA patient file
;perform top level edits
S AZHZGL="^DPT("
F AZHZFLD=1,9,111,112,113,114,211,2401,2402,2403,331 D @AZHZFLD,TX1X2
; perform checks on 'Other Name' multiple
S IEN=0 F S IEN=$O(^DPT(DFN,.01,IEN)) Q:(DFOUT!DUOUT) Q:'IEN S (AZHZX1,AZHZX2)=$P(^(IEN,0),U) D BLNK,NAME I AZHZX1'=AZHZX2 S ^AZHZTEMP(DFN,"OTHER",IEN,.01,"O")=AZHZX1,^("N")=AZHZX2
Q
;---------------------------------------------------------------------
VA ; edits for VA patient file
1 S AZHZN=0,AZHZP=1,AZHZFLDN=.01 D PULL D NAME Q ; edit name field
9 S AZHZN=0,AZHZP=9,AZHZFLDN=.09 D PULL S AZHZX2=$TR(AZHZX2,"-") Q ;edit SSN (-)
111 S AZHZN=.11,AZHZP=1,AZHZFLDN=.111 D PULL Q ; edit for address l1
112 S AZHZN=.11,AZHZP=2,AZHZFLDN=.112 D PULL Q ; edit for address l2
113 S AZHZN=.11,AZHZP=3,AZHZFLDN=.113 D PULL Q ; edit for address l3
114 S AZHZN=.11,AZHZP=4,AZHZFLDN=.114 D PULL Q ; edit for address L4
211 S AZHZN=.21,AZHZP=1,AZHZFLDN=.211 D PULL D NAME Q ;edit for next of kin
2401 S AZHZN=.24,AZHZP=1,AZHZFLDN=.2401 D PULL D NAME Q ;edit for father name
2402 S AZHZN=.24,AZHZP=2,AZHZFLDN=.2402 D PULL D NAME Q ;edit for mother name
2403 S AZHZN=.24,AZHZP=3,AZHZFLDN=.2403 D PULL D NAME Q ;edit for mother maiden name
331 S AZHZN=.33,AZHZP=1,AZHZFLDN=.331 D PULL D NAME Q ;edit for emergency contact
;---------------------------------------------------------------------
PULL ; pull data item and remove beginning blanks
S AZHZNODE=AZHZGL_DFN_","_AZHZN_")",(AZHZX1,AZHZX2)="" I $D(@AZHZNODE) S AZHZX1=$P(@(AZHZNODE),U,AZHZP),AZHZX2=AZHZX1 D BLNK
Q
;---------------------------------------------------------------------
BLNK ; REMOVE BEGINNING BLANKS
F Q:'($E(AZHZX2)=" ") S AZHZX2=$E(AZHZX2,2,999)
Q
;---------------------------------------------------------------------
TX1X2 ; test x1 - x2 set
;I AZHZX1'=AZHZX2 W !,DFN,?15,AZHZX1,!,?15,AZHZX2
I AZHZX1'=AZHZX2 S ^AZHZTEMP(DFN,"V",AZHZFLDN,"O")=AZHZX1,^("N")=AZHZX2
Q ;-----
;---------------------------------------------------------------------
NAME ; edit name: uppercase: change () to - : remove punctuation
Q:'$L(AZHZX2)
S AZHZX3=$TR(AZHZX2,")(&/","----") S:AZHZX3'=AZHZX2 ^AZHZTEMP("P",DFN)=""
S AZHZX2=AZHZX3,AZHZX2=$TR(AZHZX2,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"),AZHZX2=$TR(AZHZX2,"/:;`*()_+=*&%$#@!") S:AZHZX2[", " AZHZX2=$P(AZHZX2,", ")_","_$P(AZHZX2,", ",2)
F I=1:1:3 S AZHZNAM(I)=$P(AZHZX2,",",I)
S AZHZLN=AZHZNAM(1),AZHZFN=AZHZNAM(2)
F Q:AZHZLN'?1P.E S AZHZLN=$E(AZHZLN,2,99)
F Q:AZHZFN'?1P.E S AZHZFN=$E(AZHZFN,2,99)
S AZHZX2=AZHZLN_","_AZHZFN S:$L(AZHZNAM(3)) AZHZX2=AZHZX2_","_AZHZNAM(3)
Q ;-----
EVAPAT ;
TNAM ;R !,"NAME : ",X Q:X="" S AZHZX2=X D NAME W !,">",AZHZX2,"<" G TNAM
AZHZCLV ;DSD/PDW - Clean VA patient file ; AUGUST 14, 1992
+1 ;;1.0;AZHZ;;AUG 14, 1992
+2 ;;
S ;
VAPAT ;start edits for fields in VA patient file
+1 ;perform top level edits
+2 SET AZHZGL="^DPT("
+3 FOR AZHZFLD=1,9,111,112,113,114,211,2401,2402,2403,331
DO @AZHZFLD
DO TX1X2
+4 ; perform checks on 'Other Name' multiple
+5 SET IEN=0
FOR
SET IEN=$ORDER(^DPT(DFN,.01,IEN))
IF (DFOUT!DUOUT)
QUIT
IF 'IEN
QUIT
SET (AZHZX1,AZHZX2)=$PIECE(^(IEN,0),U)
DO BLNK
DO NAME
IF AZHZX1'=AZHZX2
SET ^AZHZTEMP(DFN,"OTHER",IEN,.01,"O")=AZHZX1
SET ^("N")=AZHZX2
+6 QUIT
+7 ;---------------------------------------------------------------------
VA ; edits for VA patient file
1 ; edit name field
SET AZHZN=0
SET AZHZP=1
SET AZHZFLDN=.01
DO PULL
DO NAME
QUIT
9 ;edit SSN (-)
SET AZHZN=0
SET AZHZP=9
SET AZHZFLDN=.09
DO PULL
SET AZHZX2=$TRANSLATE(AZHZX2,"-")
QUIT
111 ; edit for address l1
SET AZHZN=.11
SET AZHZP=1
SET AZHZFLDN=.111
DO PULL
QUIT
112 ; edit for address l2
SET AZHZN=.11
SET AZHZP=2
SET AZHZFLDN=.112
DO PULL
QUIT
113 ; edit for address l3
SET AZHZN=.11
SET AZHZP=3
SET AZHZFLDN=.113
DO PULL
QUIT
114 ; edit for address L4
SET AZHZN=.11
SET AZHZP=4
SET AZHZFLDN=.114
DO PULL
QUIT
211 ;edit for next of kin
SET AZHZN=.21
SET AZHZP=1
SET AZHZFLDN=.211
DO PULL
DO NAME
QUIT
2401 ;edit for father name
SET AZHZN=.24
SET AZHZP=1
SET AZHZFLDN=.2401
DO PULL
DO NAME
QUIT
2402 ;edit for mother name
SET AZHZN=.24
SET AZHZP=2
SET AZHZFLDN=.2402
DO PULL
DO NAME
QUIT
2403 ;edit for mother maiden name
SET AZHZN=.24
SET AZHZP=3
SET AZHZFLDN=.2403
DO PULL
DO NAME
QUIT
331 ;edit for emergency contact
SET AZHZN=.33
SET AZHZP=1
SET AZHZFLDN=.331
DO PULL
DO NAME
QUIT
+1 ;---------------------------------------------------------------------
PULL ; pull data item and remove beginning blanks
+1 SET AZHZNODE=AZHZGL_DFN_","_AZHZN_")"
SET (AZHZX1,AZHZX2)=""
IF $DATA(@AZHZNODE)
SET AZHZX1=$PIECE(@(AZHZNODE),U,AZHZP)
SET AZHZX2=AZHZX1
DO BLNK
+2 QUIT
+3 ;---------------------------------------------------------------------
BLNK ; REMOVE BEGINNING BLANKS
+1 FOR
IF '($EXTRACT(AZHZX2)=" ")
QUIT
SET AZHZX2=$EXTRACT(AZHZX2,2,999)
+2 QUIT
+3 ;---------------------------------------------------------------------
TX1X2 ; test x1 - x2 set
+1 ;I AZHZX1'=AZHZX2 W !,DFN,?15,AZHZX1,!,?15,AZHZX2
+2 IF AZHZX1'=AZHZX2
SET ^AZHZTEMP(DFN,"V",AZHZFLDN,"O")=AZHZX1
SET ^("N")=AZHZX2
+3 ;-----
QUIT
+4 ;---------------------------------------------------------------------
NAME ; edit name: uppercase: change () to - : remove punctuation
+1 IF '$LENGTH(AZHZX2)
QUIT
+2 SET AZHZX3=$TRANSLATE(AZHZX2,")(&/","----")
IF AZHZX3'=AZHZX2
SET ^AZHZTEMP("P",DFN)=""
+3 SET AZHZX2=AZHZX3
SET AZHZX2=$TRANSLATE(AZHZX2,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
SET AZHZX2=$TRANSLATE(AZHZX2,"/:;`*()_+=*&%$#@!")
IF AZHZX2[", "
SET AZHZX2=$PIECE(AZHZX2,", ")_","_$PIECE(AZHZX2,", ",2)
+4 FOR I=1:1:3
SET AZHZNAM(I)=$PIECE(AZHZX2,",",I)
+5 SET AZHZLN=AZHZNAM(1)
SET AZHZFN=AZHZNAM(2)
+6 FOR
IF AZHZLN'?1P.E
QUIT
SET AZHZLN=$EXTRACT(AZHZLN,2,99)
+7 FOR
IF AZHZFN'?1P.E
QUIT
SET AZHZFN=$EXTRACT(AZHZFN,2,99)
+8 SET AZHZX2=AZHZLN_","_AZHZFN
IF $LENGTH(AZHZNAM(3))
SET AZHZX2=AZHZX2_","_AZHZNAM(3)
+9 ;-----
QUIT
EVAPAT ;
TNAM ;R !,"NAME : ",X Q:X="" S AZHZX2=X D NAME W !,">",AZHZX2,"<" G TNAM
