XDRDVAL2 ;SF-IRMFO.SEA/JLI - IDENTIFY FIELDS THAT NEED CHECKING FOR MERGE ;02/07/2000 09:55
;;7.3;TOOLKIT;**23,34,36,42,45,77**;Apr 25, 1995
;;
Q
;
CHKMERG(FILENUM,IENFROM,IENTO,ARRAY) ;
N XDRDVALF
S XDRDVALF=1
S FILE=FILENUM D SETUP^XDRMERG(2)
D CHKFMERG(FILE,IENFROM,IENTO,ARRAY)
S XGLOB="" F S XGLOB=$O(^TMP($J,"XGLOB",XGLOB)) Q:XGLOB="" D
. I $P($G(^TMP($J,"XGLOB",XGLOB,0,1)),U,3)="DINUM" S F=$P(^(1),U) D CHKFMERG(F,IENFROM,IENTO,ARRAY)
Q
;
CHKFMERG(XFILNO,IENFROM,IENTO,LOCATION) ; CHECK VALIDITY FOR MERGE OF TWO ENTRIES IN FILE
N F,FILE,FILENUM,XGLOB,NODE,NODE1,NODE2,NODEA,SFILE,XDRFROM,XDRTO,NODEA,VALUE,XVALUE,XDRXX,NODEB,DIK,DA,I,Y,VREF,XNN,IENTOSTR,DFN,XDRZZ
N XDRAA ; DEBUG STATEMENT
;
S XDRDIC=$G(^DIC(XFILNO,0,"GL")) Q:XDRDIC=""
S IENTOSTR=IENTO_","
S DFN=IENTO
;
; CHECK FOR BROKEN LR NODES IF PATIENT FILE
;
; FOLLOWING LINE MODIFIED TO INCLUDE IDENTIFIED PROBLEMS IN OUTPUT - JLI 03/23/99
I XFILNO=2 F I=IENFROM,IENTO S J=$G(^DPT(I,"LR")) I J>0,($P(^LR(J,0),U,2)'=2)!($P(^LR(J,0),U,3)'=I) S @LOCATION@(2,(I_","),63,"INVALID")="Broken ""LR"" node pointers for PATIENT file and LAB DATA FILE - DFN="_I_" LRFN="_J
;
; NOW MERGE DATA GOING NODE BY NODE
;
S NODE=""
F D Q:NODE=""
. S NODE1=$O(@(XDRDIC_IENFROM_","""_NODE_""")"))
. I NODE1="" S NODE="" Q ; NOTHING MORE TO MOVE OVER
. S NODE2=$O(@(XDRDIC_IENTO_","""_NODE_""")"))
. I NODE2'="",NODE1]NODE2 S NODE=NODE2 Q ; NODE ON TO, BUT NOT ON FROM - GO TO NEXT
. S NODE=NODE1
. I $D(@(XDRDIC_IENFROM_","""_NODE_""")"))=1 D Q ; SINGLE NODE, MERGE DATA
. . I NODE2]NODE1!(NODE2="") D Q ; MISSING NODE, JUST MOVE IT OVER
. . . N XDRXX,FLD,N,J
. . . F N=0:0 S N=$O(^DD(XFILNO,"GL",NODE,N)) Q:N'>0 S FLD=$O(^(N,0)) I $O(^DD(XFILNO,FLD,1,0))>0 D
. . . . S X=0 F J=0:0 S J=$O(^DD(XFILNO,FLD,1,J)) Q:J'>0 I $O(^(J,0))>0 S X=1 Q
. . . . I X>0 D
. . . . . S XDRXX(XFILNO,IENTOSTR,FLD)=$$GETEXT(XDRDIC,IENFROM,XFILNO,FLD)
. . . I $D(XDRXX) D CHEKFDA("XDRXX",LOCATION)
. . I $D(@(XDRDIC_IENTO_","""_NODE_""")"))>1 Q ; MISMATCH SKIP
. . N XDRXX,FLD
. . S X1=@(XDRDIC_IENFROM_","""_NODE_""")")
. . S (X2,X3)=@(XDRDIC_IENTO_","""_NODE_""")")
. . F XDRI=1:1 Q:X1="" S X=$P(X1,U),X1=$P(X1,U,2,999) I X'="" D
. . . S Y=$P(X2,U,XDRI)
. . . I Y="" D
. . . . S $P(X2,U,XDRI)=X
. . . . S FLD=$O(^DD(XFILNO,"GL",NODE,XDRI,0)) S JXFLD=FLD
. . . . I FLD>0,$O(^DD(XFILNO,FLD,1,0))>0 S XDRXX(XFILNO,IENTOSTR,FLD)=$$GETEXT(XDRDIC,IENFROM,XFILNO,FLD)
. . I X2'=X3 D
. . . I $D(XDRXX) D
. . . . N X2 D CHEKFDA("XDRXX",LOCATION)
. ;
. ; THE FOLLOWING HANDLES NODES THAT HAVE MULTIPLES
. ;
. S XDRFROM=XDRDIC_IENFROM_","""_NODE_""","
. S XDRTO=XDRDIC_IENTO_","""_NODE_""","
. I NODE="DIS",XFILNO=2 Q
. S IENTOSTR=IENTO_","
. D CHKSUBS(XDRFROM,XDRTO,IENTOSTR,IENTO)
Q
;
CHKSUBS(XDRFROM,XDRTO,IENTOSTR,XDRDASEQ) ;
N NODEA,SFILE,VALUE,XVALUE,XDRXX,XDRYY,YVALUE,XENTOSTR
N XDRAA,XDRZZ ; DEBUG STATEMENT
S SFILE=+$P($G(@(XDRFROM_"0)")),U,2)
I SFILE'>0 Q ; NO FILE NUMBER, NOT FILE MANAGER COMPATIBLE
I $P($G(^DD(SFILE,.01,0)),U,2)["W" Q ; HANDLE WORD PROCESSING FIELDS
F NODEA=0:0 S NODEA=$O(@(XDRFROM_NODEA_")")) Q:NODEA'>0 D
. S VALUE=$P($G(@(XDRFROM_NODEA_",0)")),U) ; GET .01 VALUE
. N XDRDT S XDRDT=^DD(SFILE,.01,0)
. I $P(XDRDT,U,2)["D" S XDRDT=$P(XDRDT,U,5,999),XDRDINUM=$S(XDRDT["DINUM":1,1:0) I XDRDINUM S XDRDT=0 D DINUMDAT Q:XDRDT ; HANDLE DINUMED DATES BY SIMPLY MOVING THEM
. S YVALUE=0,XVALUE=0 I $D(^DD(SFILE,.001,0)) S YVALUE=NODEA I $D(@(XDRTO_NODEA_")")) S XVALUE=YVALUE
. I XVALUE=0,$P(^DD(SFILE,.01,0),U,5,99)["DINUM",$D(@(XDRTO_NODEA_")")) S XVALUE=NODEA
. I XVALUE=0 S XVALUE=+$$FIND1^DIC(SFILE,(","_IENTOSTR),"Q",VALUE) ; FIND CURRENT ENTRY NUMBER, IF PRESENT
. I XVALUE>0 D Q ; SUBFILE EXISTS IN IENTO, CHECK FOR LOWER SUBFILES
. . N X,X1,NODE,NEWFROM,NEWTO,NEWTOIEN
. . S NODE=""
. . F S NODE=$O(@(XDRFROM_NODEA_","""_NODE_""")")) Q:NODE="" D
. . . I $D(@(XDRFROM_NODEA_","""_NODE_""")"))'>1 Q
. . . S NEWFROM=XDRFROM_NODEA_","""_NODE_""","
. . . S NEWTO=XDRTO_XVALUE_","""_NODE_""","
. . . S NEWTOIEN=XVALUE_","_IENTOSTR
. . . D CHKSUBS(NEWFROM,NEWTO,NEWTOIEN,(XVALUE_U_XDRDASEQ))
. K XDRYY I YVALUE>0 S XDRYY(1)=YVALUE
. S XENTOSTR="+1,"_IENTOSTR
. S XDRFILTY=$P($G(^DD(SFILE,.01,0)),U,2)
. ;I XDRFILTY["P",SFILE'=2.011 S VALUE="`"_VALUE
. ;I XDRFILTY["V" D
. ;. N Y S Y=$P(VALUE,";",2) Q:Y=""
. ;. S Y=$P($G(@("^"_Y_"0)")),U) Q:Y=""
. ;. S VALUE=Y_".`"_(+VALUE)
. ;. Q
. I (XDRFILTY["P")!(XDRFILTY["V")!(XDRFILTY["D") Q ; HANDLE AS INTERNAL VALUES ; JLI 9-1-99
. I SFILE=2.011 Q ; SPECIAL HANDLING ; JLI 9-1-99
. S XDRXX(SFILE,XENTOSTR,.01)=$$GETEXT(XDRFROM,NODEA,SFILE,.01)
. D CHEKFDA("XDRXX",LOCATION)
. F XDRID=0:0 S XDRID=$O(^DD(SFILE,0,"ID",XDRID)) Q:XDRID'>0 D
. . Q:$P(^DD(SFILE,XDRID,0),U,2)'["R"
. . S VALUE=$$GETEXT(XDRFROM,NODEA,SFILE,XDRID)
. . I VALUE="" W !,"PROBLEM WITH IDENTIFIER FILE=",SFILE," IENSTR=",XENTOSTR," FIELD=",XDRID
Q
;
GETEXT(DICA,DA,FILNUM,FIELD,TYPE) ; GET EXTERNAL VALUE FOR .01 FIELD
N DIC,DIQ,DR,XDRQ,TEMP
I $G(FIELD)="" S FIELD=.01
I $G(TYPE)="" S TYPE="E"
S DIC=DICA,DIC("P")=FILNUM,DR=FIELD,DIQ="XDRQ",DIQ(0)="I"
D EN^DIQ1
S TEMP=$G(XDRQ(FILNUM,DA,FIELD,"I")) I TEMP="" Q ""
S DIC=DICA,DIC("P")=FILNUM,DR=FIELD,DIQ="XDRQ",DIQ(0)="E" K XDRQ
D EN^DIQ1
Q TEMP_U_$G(XDRQ(FILNUM,DA,FIELD,"E"))
Q $G(XDRQ(FILNUM,DA,FIELD,TYPE))
;
DINUMDAT ; PROCESS ENTRIES WITH SAMPLE DATE/TIMES WITH SECONDS, NEEDS DINUM
I $D(@(XDRTO_NODEA_")")) Q
S XDRDT=1
Q
;
CHEKFDA(FDA,LOCATION) ;
N FILE,IENS,FIELD,VAL,VALEXT
F FILE=0:0 S FILE=$O(@FDA@(FILE)) Q:FILE'>0 D
. S IENS="" F S IENS=$O(@FDA@(FILE,IENS)) Q:IENS="" D
. . F FIELD=0:0 S FIELD=$O(@FDA@(FILE,IENS,FIELD)) Q:FIELD'>0 D
. . . S VAL=@FDA@(FILE,IENS,FIELD),VALEXT=$P(VAL,U,2),VAL=$P(VAL,U) I VAL="" Q
. . . I FILE=2,FIELD=.09 Q ; SSN NUMBER IS ENTERED AS INTERNAL
. . . I FILE=2,$P(^DD(FILE,FIELD,0),U,5,99)["DGLOCK2" Q ; no NOK check
. . . I FILE=70.03,FIELD=.01 Q ; TIES UP EVERYTHING... ; JLI 9-1-99
. . . I FILE=354,FIELD=.03!(FIELD=.05) Q ; THIS ONE IS TOUGH, DON'T WORRY ABOUT IT
. . . I FILE=2,FIELD=63 Q ; LAB DATA POINTER HAS SPECIAL PROCESSING
. . . I FILE=161,FIELD=.5 Q ; FB has special processing, JDS XT*7.3*77, 8/5/03
. . . S MESGROOT=$NA(^TMP($J,"MESG")) K @MESGROOT
. . . D CHKVALID^XDRDVAL(MESGROOT,FILE,IENS,FIELD,VALEXT,VAL)
. . . I $D(@MESGROOT) M @LOCATION=@MESGROOT K @MESGROOT
. . . Q
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRDVAL2 6583 printed Oct 16, 2024@18:39:57 Page 2
XDRDVAL2 ;SF-IRMFO.SEA/JLI - IDENTIFY FIELDS THAT NEED CHECKING FOR MERGE ;02/07/2000 09:55
+1 ;;7.3;TOOLKIT;**23,34,36,42,45,77**;Apr 25, 1995
+2 ;;
+3 QUIT
+4 ;
CHKMERG(FILENUM,IENFROM,IENTO,ARRAY) ;
+1 NEW XDRDVALF
+2 SET XDRDVALF=1
+3 SET FILE=FILENUM
DO SETUP^XDRMERG(2)
+4 DO CHKFMERG(FILE,IENFROM,IENTO,ARRAY)
+5 SET XGLOB=""
FOR
SET XGLOB=$ORDER(^TMP($JOB,"XGLOB",XGLOB))
if XGLOB=""
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^TMP($JOB,"XGLOB",XGLOB,0,1)),U,3)="DINUM"
SET F=$PIECE(^(1),U)
DO CHKFMERG(F,IENFROM,IENTO,ARRAY)
End DoDot:1
+7 QUIT
+8 ;
CHKFMERG(XFILNO,IENFROM,IENTO,LOCATION) ; CHECK VALIDITY FOR MERGE OF TWO ENTRIES IN FILE
+1 NEW F,FILE,FILENUM,XGLOB,NODE,NODE1,NODE2,NODEA,SFILE,XDRFROM,XDRTO,NODEA,VALUE,XVALUE,XDRXX,NODEB,DIK,DA,I,Y,VREF,XNN,IENTOSTR,DFN,XDRZZ
+2 ; DEBUG STATEMENT
NEW XDRAA
+3 ;
+4 SET XDRDIC=$GET(^DIC(XFILNO,0,"GL"))
if XDRDIC=""
QUIT
+5 SET IENTOSTR=IENTO_","
+6 SET DFN=IENTO
+7 ;
+8 ; CHECK FOR BROKEN LR NODES IF PATIENT FILE
+9 ;
+10 ; FOLLOWING LINE MODIFIED TO INCLUDE IDENTIFIED PROBLEMS IN OUTPUT - JLI 03/23/99
+11 IF XFILNO=2
FOR I=IENFROM,IENTO
SET J=$GET(^DPT(I,"LR"))
IF J>0
IF ($PIECE(^LR(J,0),U,2)'=2)!($PIECE(^LR(J,0),U,3)'=I)
SET @LOCATION@(2,(I_","),63,"INVALID")="Broken ""LR"" node pointers for PATIENT file and LAB DATA FILE - DFN="_I_" LRFN="_J
+12 ;
+13 ; NOW MERGE DATA GOING NODE BY NODE
+14 ;
+15 SET NODE=""
+16 FOR
Begin DoDot:1
+17 SET NODE1=$ORDER(@(XDRDIC_IENFROM_","""_NODE_""")"))
+18 ; NOTHING MORE TO MOVE OVER
IF NODE1=""
SET NODE=""
QUIT
+19 SET NODE2=$ORDER(@(XDRDIC_IENTO_","""_NODE_""")"))
+20 ; NODE ON TO, BUT NOT ON FROM - GO TO NEXT
IF NODE2'=""
IF NODE1]NODE2
SET NODE=NODE2
QUIT
+21 SET NODE=NODE1
+22 ; SINGLE NODE, MERGE DATA
IF $DATA(@(XDRDIC_IENFROM_","""_NODE_""")"))=1
Begin DoDot:2
+23 ; MISSING NODE, JUST MOVE IT OVER
IF NODE2]NODE1!(NODE2="")
Begin DoDot:3
+24 NEW XDRXX,FLD,N,J
+25 FOR N=0:0
SET N=$ORDER(^DD(XFILNO,"GL",NODE,N))
if N'>0
QUIT
SET FLD=$ORDER(^(N,0))
IF $ORDER(^DD(XFILNO,FLD,1,0))>0
Begin DoDot:4
+26 SET X=0
FOR J=0:0
SET J=$ORDER(^DD(XFILNO,FLD,1,J))
if J'>0
QUIT
IF $ORDER(^(J,0))>0
SET X=1
QUIT
+27 IF X>0
Begin DoDot:5
+28 SET XDRXX(XFILNO,IENTOSTR,FLD)=$$GETEXT(XDRDIC,IENFROM,XFILNO,FLD)
End DoDot:5
End DoDot:4
+29 IF $DATA(XDRXX)
DO CHEKFDA("XDRXX",LOCATION)
End DoDot:3
QUIT
+30 ; MISMATCH SKIP
IF $DATA(@(XDRDIC_IENTO_","""_NODE_""")"))>1
QUIT
+31 NEW XDRXX,FLD
+32 SET X1=@(XDRDIC_IENFROM_","""_NODE_""")")
+33 SET (X2,X3)=@(XDRDIC_IENTO_","""_NODE_""")")
+34 FOR XDRI=1:1
if X1=""
QUIT
SET X=$PIECE(X1,U)
SET X1=$PIECE(X1,U,2,999)
IF X'=""
Begin DoDot:3
+35 SET Y=$PIECE(X2,U,XDRI)
+36 IF Y=""
Begin DoDot:4
+37 SET $PIECE(X2,U,XDRI)=X
+38 SET FLD=$ORDER(^DD(XFILNO,"GL",NODE,XDRI,0))
SET JXFLD=FLD
+39 IF FLD>0
IF $ORDER(^DD(XFILNO,FLD,1,0))>0
SET XDRXX(XFILNO,IENTOSTR,FLD)=$$GETEXT(XDRDIC,IENFROM,XFILNO,FLD)
End DoDot:4
End DoDot:3
+40 IF X2'=X3
Begin DoDot:3
+41 IF $DATA(XDRXX)
Begin DoDot:4
+42 NEW X2
DO CHEKFDA("XDRXX",LOCATION)
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+43 ;
+44 ; THE FOLLOWING HANDLES NODES THAT HAVE MULTIPLES
+45 ;
+46 SET XDRFROM=XDRDIC_IENFROM_","""_NODE_""","
+47 SET XDRTO=XDRDIC_IENTO_","""_NODE_""","
+48 IF NODE="DIS"
IF XFILNO=2
QUIT
+49 SET IENTOSTR=IENTO_","
+50 DO CHKSUBS(XDRFROM,XDRTO,IENTOSTR,IENTO)
End DoDot:1
if NODE=""
QUIT
+51 QUIT
+52 ;
CHKSUBS(XDRFROM,XDRTO,IENTOSTR,XDRDASEQ) ;
+1 NEW NODEA,SFILE,VALUE,XVALUE,XDRXX,XDRYY,YVALUE,XENTOSTR
+2 ; DEBUG STATEMENT
NEW XDRAA,XDRZZ
+3 SET SFILE=+$PIECE($GET(@(XDRFROM_"0)")),U,2)
+4 ; NO FILE NUMBER, NOT FILE MANAGER COMPATIBLE
IF SFILE'>0
QUIT
+5 ; HANDLE WORD PROCESSING FIELDS
IF $PIECE($GET(^DD(SFILE,.01,0)),U,2)["W"
QUIT
+6 FOR NODEA=0:0
SET NODEA=$ORDER(@(XDRFROM_NODEA_")"))
if NODEA'>0
QUIT
Begin DoDot:1
+7 ; GET .01 VALUE
SET VALUE=$PIECE($GET(@(XDRFROM_NODEA_",0)")),U)
+8 NEW XDRDT
SET XDRDT=^DD(SFILE,.01,0)
+9 ; HANDLE DINUMED DATES BY SIMPLY MOVING THEM
IF $PIECE(XDRDT,U,2)["D"
SET XDRDT=$PIECE(XDRDT,U,5,999)
SET XDRDINUM=$SELECT(XDRDT["DINUM":1,1:0)
IF XDRDINUM
SET XDRDT=0
DO DINUMDAT
if XDRDT
QUIT
+10 SET YVALUE=0
SET XVALUE=0
IF $DATA(^DD(SFILE,.001,0))
SET YVALUE=NODEA
IF $DATA(@(XDRTO_NODEA_")"))
SET XVALUE=YVALUE
+11 IF XVALUE=0
IF $PIECE(^DD(SFILE,.01,0),U,5,99)["DINUM"
IF $DATA(@(XDRTO_NODEA_")"))
SET XVALUE=NODEA
+12 ; FIND CURRENT ENTRY NUMBER, IF PRESENT
IF XVALUE=0
SET XVALUE=+$$FIND1^DIC(SFILE,(","_IENTOSTR),"Q",VALUE)
+13 ; SUBFILE EXISTS IN IENTO, CHECK FOR LOWER SUBFILES
IF XVALUE>0
Begin DoDot:2
+14 NEW X,X1,NODE,NEWFROM,NEWTO,NEWTOIEN
+15 SET NODE=""
+16 FOR
SET NODE=$ORDER(@(XDRFROM_NODEA_","""_NODE_""")"))
if NODE=""
QUIT
Begin DoDot:3
+17 IF $DATA(@(XDRFROM_NODEA_","""_NODE_""")"))'>1
QUIT
+18 SET NEWFROM=XDRFROM_NODEA_","""_NODE_""","
+19 SET NEWTO=XDRTO_XVALUE_","""_NODE_""","
+20 SET NEWTOIEN=XVALUE_","_IENTOSTR
+21 DO CHKSUBS(NEWFROM,NEWTO,NEWTOIEN,(XVALUE_U_XDRDASEQ))
End DoDot:3
End DoDot:2
QUIT
+22 KILL XDRYY
IF YVALUE>0
SET XDRYY(1)=YVALUE
+23 SET XENTOSTR="+1,"_IENTOSTR
+24 SET XDRFILTY=$PIECE($GET(^DD(SFILE,.01,0)),U,2)
+25 ;I XDRFILTY["P",SFILE'=2.011 S VALUE="`"_VALUE
+26 ;I XDRFILTY["V" D
+27 ;. N Y S Y=$P(VALUE,";",2) Q:Y=""
+28 ;. S Y=$P($G(@("^"_Y_"0)")),U) Q:Y=""
+29 ;. S VALUE=Y_".`"_(+VALUE)
+30 ;. Q
+31 ; HANDLE AS INTERNAL VALUES ; JLI 9-1-99
IF (XDRFILTY["P")!(XDRFILTY["V")!(XDRFILTY["D")
QUIT
+32 ; SPECIAL HANDLING ; JLI 9-1-99
IF SFILE=2.011
QUIT
+33 SET XDRXX(SFILE,XENTOSTR,.01)=$$GETEXT(XDRFROM,NODEA,SFILE,.01)
+34 DO CHEKFDA("XDRXX",LOCATION)
+35 FOR XDRID=0:0
SET XDRID=$ORDER(^DD(SFILE,0,"ID",XDRID))
if XDRID'>0
QUIT
Begin DoDot:2
+36 if $PIECE(^DD(SFILE,XDRID,0),U,2)'["R"
QUIT
+37 SET VALUE=$$GETEXT(XDRFROM,NODEA,SFILE,XDRID)
+38 IF VALUE=""
WRITE !,"PROBLEM WITH IDENTIFIER FILE=",SFILE," IENSTR=",XENTOSTR," FIELD=",XDRID
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
GETEXT(DICA,DA,FILNUM,FIELD,TYPE) ; GET EXTERNAL VALUE FOR .01 FIELD
+1 NEW DIC,DIQ,DR,XDRQ,TEMP
+2 IF $GET(FIELD)=""
SET FIELD=.01
+3 IF $GET(TYPE)=""
SET TYPE="E"
+4 SET DIC=DICA
SET DIC("P")=FILNUM
SET DR=FIELD
SET DIQ="XDRQ"
SET DIQ(0)="I"
+5 DO EN^DIQ1
+6 SET TEMP=$GET(XDRQ(FILNUM,DA,FIELD,"I"))
IF TEMP=""
QUIT ""
+7 SET DIC=DICA
SET DIC("P")=FILNUM
SET DR=FIELD
SET DIQ="XDRQ"
SET DIQ(0)="E"
KILL XDRQ
+8 DO EN^DIQ1
+9 QUIT TEMP_U_$GET(XDRQ(FILNUM,DA,FIELD,"E"))
+10 QUIT $GET(XDRQ(FILNUM,DA,FIELD,TYPE))
+11 ;
DINUMDAT ; PROCESS ENTRIES WITH SAMPLE DATE/TIMES WITH SECONDS, NEEDS DINUM
+1 IF $DATA(@(XDRTO_NODEA_")"))
QUIT
+2 SET XDRDT=1
+3 QUIT
+4 ;
CHEKFDA(FDA,LOCATION) ;
+1 NEW FILE,IENS,FIELD,VAL,VALEXT
+2 FOR FILE=0:0
SET FILE=$ORDER(@FDA@(FILE))
if FILE'>0
QUIT
Begin DoDot:1
+3 SET IENS=""
FOR
SET IENS=$ORDER(@FDA@(FILE,IENS))
if IENS=""
QUIT
Begin DoDot:2
+4 FOR FIELD=0:0
SET FIELD=$ORDER(@FDA@(FILE,IENS,FIELD))
if FIELD'>0
QUIT
Begin DoDot:3
+5 SET VAL=@FDA@(FILE,IENS,FIELD)
SET VALEXT=$PIECE(VAL,U,2)
SET VAL=$PIECE(VAL,U)
IF VAL=""
QUIT
+6 ; SSN NUMBER IS ENTERED AS INTERNAL
IF FILE=2
IF FIELD=.09
QUIT
+7 ; no NOK check
IF FILE=2
IF $PIECE(^DD(FILE,FIELD,0),U,5,99)["DGLOCK2"
QUIT
+8 ; TIES UP EVERYTHING... ; JLI 9-1-99
IF FILE=70.03
IF FIELD=.01
QUIT
+9 ; THIS ONE IS TOUGH, DON'T WORRY ABOUT IT
IF FILE=354
IF FIELD=.03!(FIELD=.05)
QUIT
+10 ; LAB DATA POINTER HAS SPECIAL PROCESSING
IF FILE=2
IF FIELD=63
QUIT
+11 ; FB has special processing, JDS XT*7.3*77, 8/5/03
IF FILE=161
IF FIELD=.5
QUIT
+12 SET MESGROOT=$NAME(^TMP($JOB,"MESG"))
KILL @MESGROOT
+13 DO CHKVALID^XDRDVAL(MESGROOT,FILE,IENS,FIELD,VALEXT,VAL)
+14 IF $DATA(@MESGROOT)
MERGE @LOCATION=@MESGROOT
KILL @MESGROOT
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT
