| 1 | XDRDVAL2 ;SF-IRMFO.SEA/JLI - IDENTIFY FIELDS THAT NEED CHECKING FOR MERGE ;02/07/2000 09:55
|
|---|
| 2 | ;;7.3;TOOLKIT;**23,34,36,42,45,77**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | CHKMERG(FILENUM,IENFROM,IENTO,ARRAY) ;
|
|---|
| 7 | N XDRDVALF
|
|---|
| 8 | S XDRDVALF=1
|
|---|
| 9 | S FILE=FILENUM D SETUP^XDRMERG(2)
|
|---|
| 10 | D CHKFMERG(FILE,IENFROM,IENTO,ARRAY)
|
|---|
| 11 | S XGLOB="" F S XGLOB=$O(^TMP($J,"XGLOB",XGLOB)) Q:XGLOB="" D
|
|---|
| 12 | . I $P($G(^TMP($J,"XGLOB",XGLOB,0,1)),U,3)="DINUM" S F=$P(^(1),U) D CHKFMERG(F,IENFROM,IENTO,ARRAY)
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | CHKFMERG(XFILNO,IENFROM,IENTO,LOCATION) ; CHECK VALIDITY FOR MERGE OF TWO ENTRIES IN FILE
|
|---|
| 16 | 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
|
|---|
| 17 | N XDRAA ; DEBUG STATEMENT
|
|---|
| 18 | ;
|
|---|
| 19 | S XDRDIC=$G(^DIC(XFILNO,0,"GL")) Q:XDRDIC=""
|
|---|
| 20 | S IENTOSTR=IENTO_","
|
|---|
| 21 | S DFN=IENTO
|
|---|
| 22 | ;
|
|---|
| 23 | ; CHECK FOR BROKEN LR NODES IF PATIENT FILE
|
|---|
| 24 | ;
|
|---|
| 25 | ; FOLLOWING LINE MODIFIED TO INCLUDE IDENTIFIED PROBLEMS IN OUTPUT - JLI 03/23/99
|
|---|
| 26 | 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
|
|---|
| 27 | ;
|
|---|
| 28 | ; NOW MERGE DATA GOING NODE BY NODE
|
|---|
| 29 | ;
|
|---|
| 30 | S NODE=""
|
|---|
| 31 | F D Q:NODE=""
|
|---|
| 32 | . S NODE1=$O(@(XDRDIC_IENFROM_","""_NODE_""")"))
|
|---|
| 33 | . I NODE1="" S NODE="" Q ; NOTHING MORE TO MOVE OVER
|
|---|
| 34 | . S NODE2=$O(@(XDRDIC_IENTO_","""_NODE_""")"))
|
|---|
| 35 | . I NODE2'="",NODE1]NODE2 S NODE=NODE2 Q ; NODE ON TO, BUT NOT ON FROM - GO TO NEXT
|
|---|
| 36 | . S NODE=NODE1
|
|---|
| 37 | . I $D(@(XDRDIC_IENFROM_","""_NODE_""")"))=1 D Q ; SINGLE NODE, MERGE DATA
|
|---|
| 38 | . . I NODE2]NODE1!(NODE2="") D Q ; MISSING NODE, JUST MOVE IT OVER
|
|---|
| 39 | . . . N XDRXX,FLD,N,J
|
|---|
| 40 | . . . 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
|
|---|
| 41 | . . . . 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
|
|---|
| 42 | . . . . I X>0 D
|
|---|
| 43 | . . . . . S XDRXX(XFILNO,IENTOSTR,FLD)=$$GETEXT(XDRDIC,IENFROM,XFILNO,FLD)
|
|---|
| 44 | . . . I $D(XDRXX) D CHEKFDA("XDRXX",LOCATION)
|
|---|
| 45 | . . I $D(@(XDRDIC_IENTO_","""_NODE_""")"))>1 Q ; MISMATCH SKIP
|
|---|
| 46 | . . N XDRXX,FLD
|
|---|
| 47 | . . S X1=@(XDRDIC_IENFROM_","""_NODE_""")")
|
|---|
| 48 | . . S (X2,X3)=@(XDRDIC_IENTO_","""_NODE_""")")
|
|---|
| 49 | . . F XDRI=1:1 Q:X1="" S X=$P(X1,U),X1=$P(X1,U,2,999) I X'="" D
|
|---|
| 50 | . . . S Y=$P(X2,U,XDRI)
|
|---|
| 51 | . . . I Y="" D
|
|---|
| 52 | . . . . S $P(X2,U,XDRI)=X
|
|---|
| 53 | . . . . S FLD=$O(^DD(XFILNO,"GL",NODE,XDRI,0)) S JXFLD=FLD
|
|---|
| 54 | . . . . I FLD>0,$O(^DD(XFILNO,FLD,1,0))>0 S XDRXX(XFILNO,IENTOSTR,FLD)=$$GETEXT(XDRDIC,IENFROM,XFILNO,FLD)
|
|---|
| 55 | . . I X2'=X3 D
|
|---|
| 56 | . . . I $D(XDRXX) D
|
|---|
| 57 | . . . . N X2 D CHEKFDA("XDRXX",LOCATION)
|
|---|
| 58 | . ;
|
|---|
| 59 | . ; THE FOLLOWING HANDLES NODES THAT HAVE MULTIPLES
|
|---|
| 60 | . ;
|
|---|
| 61 | . S XDRFROM=XDRDIC_IENFROM_","""_NODE_""","
|
|---|
| 62 | . S XDRTO=XDRDIC_IENTO_","""_NODE_""","
|
|---|
| 63 | . I NODE="DIS",XFILNO=2 Q
|
|---|
| 64 | . S IENTOSTR=IENTO_","
|
|---|
| 65 | . D CHKSUBS(XDRFROM,XDRTO,IENTOSTR,IENTO)
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | CHKSUBS(XDRFROM,XDRTO,IENTOSTR,XDRDASEQ) ;
|
|---|
| 69 | N NODEA,SFILE,VALUE,XVALUE,XDRXX,XDRYY,YVALUE,XENTOSTR
|
|---|
| 70 | N XDRAA,XDRZZ ; DEBUG STATEMENT
|
|---|
| 71 | S SFILE=+$P($G(@(XDRFROM_"0)")),U,2)
|
|---|
| 72 | I SFILE'>0 Q ; NO FILE NUMBER, NOT FILE MANAGER COMPATIBLE
|
|---|
| 73 | I $P($G(^DD(SFILE,.01,0)),U,2)["W" Q ; HANDLE WORD PROCESSING FIELDS
|
|---|
| 74 | F NODEA=0:0 S NODEA=$O(@(XDRFROM_NODEA_")")) Q:NODEA'>0 D
|
|---|
| 75 | . S VALUE=$P($G(@(XDRFROM_NODEA_",0)")),U) ; GET .01 VALUE
|
|---|
| 76 | . N XDRDT S XDRDT=^DD(SFILE,.01,0)
|
|---|
| 77 | . 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
|
|---|
| 78 | . S YVALUE=0,XVALUE=0 I $D(^DD(SFILE,.001,0)) S YVALUE=NODEA I $D(@(XDRTO_NODEA_")")) S XVALUE=YVALUE
|
|---|
| 79 | . I XVALUE=0,$P(^DD(SFILE,.01,0),U,5,99)["DINUM",$D(@(XDRTO_NODEA_")")) S XVALUE=NODEA
|
|---|
| 80 | . I XVALUE=0 S XVALUE=+$$FIND1^DIC(SFILE,(","_IENTOSTR),"Q",VALUE) ; FIND CURRENT ENTRY NUMBER, IF PRESENT
|
|---|
| 81 | . I XVALUE>0 D Q ; SUBFILE EXISTS IN IENTO, CHECK FOR LOWER SUBFILES
|
|---|
| 82 | . . N X,X1,NODE,NEWFROM,NEWTO,NEWTOIEN
|
|---|
| 83 | . . S NODE=""
|
|---|
| 84 | . . F S NODE=$O(@(XDRFROM_NODEA_","""_NODE_""")")) Q:NODE="" D
|
|---|
| 85 | . . . I $D(@(XDRFROM_NODEA_","""_NODE_""")"))'>1 Q
|
|---|
| 86 | . . . S NEWFROM=XDRFROM_NODEA_","""_NODE_""","
|
|---|
| 87 | . . . S NEWTO=XDRTO_XVALUE_","""_NODE_""","
|
|---|
| 88 | . . . S NEWTOIEN=XVALUE_","_IENTOSTR
|
|---|
| 89 | . . . D CHKSUBS(NEWFROM,NEWTO,NEWTOIEN,(XVALUE_U_XDRDASEQ))
|
|---|
| 90 | . K XDRYY I YVALUE>0 S XDRYY(1)=YVALUE
|
|---|
| 91 | . S XENTOSTR="+1,"_IENTOSTR
|
|---|
| 92 | . S XDRFILTY=$P($G(^DD(SFILE,.01,0)),U,2)
|
|---|
| 93 | . ;I XDRFILTY["P",SFILE'=2.011 S VALUE="`"_VALUE
|
|---|
| 94 | . ;I XDRFILTY["V" D
|
|---|
| 95 | . ;. N Y S Y=$P(VALUE,";",2) Q:Y=""
|
|---|
| 96 | . ;. S Y=$P($G(@("^"_Y_"0)")),U) Q:Y=""
|
|---|
| 97 | . ;. S VALUE=Y_".`"_(+VALUE)
|
|---|
| 98 | . ;. Q
|
|---|
| 99 | . I (XDRFILTY["P")!(XDRFILTY["V")!(XDRFILTY["D") Q ; HANDLE AS INTERNAL VALUES ; JLI 9-1-99
|
|---|
| 100 | . I SFILE=2.011 Q ; SPECIAL HANDLING ; JLI 9-1-99
|
|---|
| 101 | . S XDRXX(SFILE,XENTOSTR,.01)=$$GETEXT(XDRFROM,NODEA,SFILE,.01)
|
|---|
| 102 | . D CHEKFDA("XDRXX",LOCATION)
|
|---|
| 103 | . F XDRID=0:0 S XDRID=$O(^DD(SFILE,0,"ID",XDRID)) Q:XDRID'>0 D
|
|---|
| 104 | . . Q:$P(^DD(SFILE,XDRID,0),U,2)'["R"
|
|---|
| 105 | . . S VALUE=$$GETEXT(XDRFROM,NODEA,SFILE,XDRID)
|
|---|
| 106 | . . I VALUE="" W !,"PROBLEM WITH IDENTIFIER FILE=",SFILE," IENSTR=",XENTOSTR," FIELD=",XDRID
|
|---|
| 107 | Q
|
|---|
| 108 | ;
|
|---|
| 109 | GETEXT(DICA,DA,FILNUM,FIELD,TYPE) ; GET EXTERNAL VALUE FOR .01 FIELD
|
|---|
| 110 | N DIC,DIQ,DR,XDRQ,TEMP
|
|---|
| 111 | I $G(FIELD)="" S FIELD=.01
|
|---|
| 112 | I $G(TYPE)="" S TYPE="E"
|
|---|
| 113 | S DIC=DICA,DIC("P")=FILNUM,DR=FIELD,DIQ="XDRQ",DIQ(0)="I"
|
|---|
| 114 | D EN^DIQ1
|
|---|
| 115 | S TEMP=$G(XDRQ(FILNUM,DA,FIELD,"I")) I TEMP="" Q ""
|
|---|
| 116 | S DIC=DICA,DIC("P")=FILNUM,DR=FIELD,DIQ="XDRQ",DIQ(0)="E" K XDRQ
|
|---|
| 117 | D EN^DIQ1
|
|---|
| 118 | Q TEMP_U_$G(XDRQ(FILNUM,DA,FIELD,"E"))
|
|---|
| 119 | Q $G(XDRQ(FILNUM,DA,FIELD,TYPE))
|
|---|
| 120 | ;
|
|---|
| 121 | DINUMDAT ; PROCESS ENTRIES WITH SAMPLE DATE/TIMES WITH SECONDS, NEEDS DINUM
|
|---|
| 122 | I $D(@(XDRTO_NODEA_")")) Q
|
|---|
| 123 | S XDRDT=1
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
| 126 | CHEKFDA(FDA,LOCATION) ;
|
|---|
| 127 | N FILE,IENS,FIELD,VAL,VALEXT
|
|---|
| 128 | F FILE=0:0 S FILE=$O(@FDA@(FILE)) Q:FILE'>0 D
|
|---|
| 129 | . S IENS="" F S IENS=$O(@FDA@(FILE,IENS)) Q:IENS="" D
|
|---|
| 130 | . . F FIELD=0:0 S FIELD=$O(@FDA@(FILE,IENS,FIELD)) Q:FIELD'>0 D
|
|---|
| 131 | . . . S VAL=@FDA@(FILE,IENS,FIELD),VALEXT=$P(VAL,U,2),VAL=$P(VAL,U) I VAL="" Q
|
|---|
| 132 | . . . I FILE=2,FIELD=.09 Q ; SSN NUMBER IS ENTERED AS INTERNAL
|
|---|
| 133 | . . . I FILE=2,$P(^DD(FILE,FIELD,0),U,5,99)["DGLOCK2" Q ; no NOK check
|
|---|
| 134 | . . . I FILE=70.03,FIELD=.01 Q ; TIES UP EVERYTHING... ; JLI 9-1-99
|
|---|
| 135 | . . . I FILE=354,FIELD=.03!(FIELD=.05) Q ; THIS ONE IS TOUGH, DON'T WORRY ABOUT IT
|
|---|
| 136 | . . . I FILE=2,FIELD=63 Q ; LAB DATA POINTER HAS SPECIAL PROCESSING
|
|---|
| 137 | . . . I FILE=161,FIELD=.5 Q ; FB has special processing, JDS XT*7.3*77, 8/5/03
|
|---|
| 138 | . . . S MESGROOT=$NA(^TMP($J,"MESG")) K @MESGROOT
|
|---|
| 139 | . . . D CHKVALID^XDRDVAL(MESGROOT,FILE,IENS,FIELD,VALEXT,VAL)
|
|---|
| 140 | . . . I $D(@MESGROOT) M @LOCATION=@MESGROOT K @MESGROOT
|
|---|
| 141 | . . . Q
|
|---|
| 142 | . . Q
|
|---|
| 143 | . Q
|
|---|
| 144 | Q
|
|---|
