| 1 | XDRMERGA ;SF-IRMFO.SEA/JLI - START OF NON-INTERACTIVE BATCH MERGE ;01/31/2000 09:14
|
|---|
| 2 | ;;7.3;TOOLKIT;**23,28,37,40,45**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | Q
|
|---|
| 5 | APPROVE ; This is the entry point for approving a duplicate pair for merge
|
|---|
| 6 | K DIRUT,DUOUT,DTOUT ;
|
|---|
| 7 | D EN^XDRVCHEK ; update verified and/or ready to merge statuses if necessary
|
|---|
| 8 | ;
|
|---|
| 9 | N XDRXX,XDRYY,XDRMA,DIE,DIC,DIR,DR,ZTDTH,ZTSK
|
|---|
| 10 | N XDRX,XDRY,XDRFIL,XDRGLOB,X,Y,XDRNAME
|
|---|
| 11 | N XDRFDA,XDRIENS,XDRI,XDRJ,XDRK,DA,DIK
|
|---|
| 12 | ;
|
|---|
| 13 | S XDRFIL=$$FILE^XDRDPICK() Q:XDRFIL'>0
|
|---|
| 14 | S XDRDIC=^DIC(XDRFIL,0,"GL")
|
|---|
| 15 | S XDRGLOB=$E(XDRDIC,2,999)
|
|---|
| 16 | S X=""
|
|---|
| 17 | S XNCNT=0,XNCNT0=0
|
|---|
| 18 | F S X=$O(^VA(15,"AVDUP",XDRGLOB,X)) Q:X="" S Y=$O(^(X,0)) D
|
|---|
| 19 | . N YVAL S YVAL=^VA(15,Y,0)
|
|---|
| 20 | . I $P(YVAL,U,20)>0 Q ; ALREADY DONE OR SCHEDULED
|
|---|
| 21 | . I $P(YVAL,U,3)'="V" Q ; TAKE ONLY VERIFIED
|
|---|
| 22 | . I $P(YVAL,U,5)'=1 Q ; TAKE ONLY IF MARKED READY TO MERGE
|
|---|
| 23 | . I $P(YVAL,U,4)="" D Q ; MAKE SURE MERGE DIRECTION IS DEFINED
|
|---|
| 24 | . . W !,"Entry `",Y," DOES NOT HAVE MERGE DIRECTION DEFINED - CAN'T APPROVE"
|
|---|
| 25 | . . N XDRDICA S XDRDICA=U_$P($P(YVAL,U),";",2)
|
|---|
| 26 | . . I '$D(@(XDRDICA_(+YVAL)_",0)"))!$D(@(XDRDICA_(+YVAL)_",-9)"))!'$D(@(XDRDICA_(+$P(YVAL,U,2))_",0)"))!$D(@(XDRDICA_(+$P(YVAL,U,2))_",-9)")) D Q
|
|---|
| 27 | . . . D RESET^XDRDPICK(Y)
|
|---|
| 28 | . I $P(YVAL,U,13)'>0 D
|
|---|
| 29 | . . I $P(YVAL,U,4)'=2 S XDRY(+YVAL,+$P(YVAL,U,2))=Y
|
|---|
| 30 | . . E S XDRY(+$P(YVAL,U,2),+YVAL)=Y
|
|---|
| 31 | . . S XNCNT0=XNCNT0+1
|
|---|
| 32 | I XNCNT0>0 W !!,XNCNT0," Entries are awaiting approval for merging Return to continue..." R X:DTIME
|
|---|
| 33 | I $D(XDRY) D CHKBKUP I $D(DUOUT)!$D(DTOUT) Q
|
|---|
| 34 | K XDRY
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | STOP ;
|
|---|
| 38 | N XDRI,DIE,DA,DR,DIR,XDRC
|
|---|
| 39 | S XDRC=0 F XDRI=0:0 S XDRI=$O(^VA(15.2,XDRI)) Q:XDRI'>0 I $P(^(XDRI,0),U,4)="A" D
|
|---|
| 40 | . S XDRC=XDRC+1
|
|---|
| 41 | . S DIR(0)="Y",DIR("A")="Do you want to stop "_$P(^VA(15.2,XDRI,0),U)
|
|---|
| 42 | . D ^DIR K DIR I Y'>0 Q
|
|---|
| 43 | . S DIE="^VA(15.2,",DA=XDRI,DR=".09///1" D ^DIE
|
|---|
| 44 | . K DIE,DR
|
|---|
| 45 | I XDRC'>0 W !!,$C(7),"No active merge processes were found.",!!
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | CHKBKUP ; Check if backups have been generated for outstanding pairs
|
|---|
| 49 | N I,J,X,Y,X1,X2,XNCNT,I,J,K,L,M,N,XX
|
|---|
| 50 | K DIR
|
|---|
| 51 | ;S DIR("A")="Do you want to check pairs awaiting backups (Y/N)"
|
|---|
| 52 | ;S DIR("?")="Indication that a backup of the data for the entries for a duplicate pair is required prior to merging the entries. You may review entries to see if any should be marked as completed."
|
|---|
| 53 | ;S DIR(0)="Y" D ^DIR K DIR Q:Y'>0
|
|---|
| 54 | S ASKNAME="ASK1" D CHECK
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | CHECK ;
|
|---|
| 58 | W @IOF
|
|---|
| 59 | S XNCNT=0
|
|---|
| 60 | F I=0:0 S I=$O(XDRY(I)) Q:I'>0 D Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 61 | . F J=0:0 S J=$O(XDRY(I,J)) Q:J'>0 D Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 62 | . . S X01=$G(@(XDRDIC_I_",0)")),X1=$P(X01,U),X1S=$P(X01,U,9),X1S=$E(X1S,1,3)_"-"_$E(X1S,4,5)_"-"_$E(X1S,6,15)
|
|---|
| 63 | . . S X02=$G(@(XDRDIC_J_",0)")),X2=$P(X02,U),X2S=$P(X02,U,9),X2S=$E(X2S,1,3)_"-"_$E(X2S,4,5)_"-"_$E(X2S,6,15)
|
|---|
| 64 | . . I X1=""!(X2="") K XDRY(I,J) Q
|
|---|
| 65 | . . F Q:X1'["MERGING INTO" S X1=$P($P(X1,"(",2,10),")",1,$L(X1,")")-1)
|
|---|
| 66 | . . S XNCNT=XNCNT+1,XX(XNCNT)=I_U_J
|
|---|
| 67 | . . W !!,$J(XNCNT,3)," ",?8,X1,?42,X1S,?60,"[",I,"]"
|
|---|
| 68 | . . W !,?8,X2,?42,X2S,?60,"[",J,"]"
|
|---|
| 69 | . . I '(XNCNT#6) D @ASKNAME Q:$D(DUOUT)!$D(DTOUT) W @IOF
|
|---|
| 70 | I '($D(DUOUT)!$D(DTOUT)) D @ASKNAME
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | ASK1 ;
|
|---|
| 74 | W ! S DIR(0)="LO^1:"_XNCNT,DIR("A")="Select entries to approve them for merging"
|
|---|
| 75 | ;W !,"TEST"
|
|---|
| 76 | D ^DIR K DIR K DIRUT Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 77 | S K="" F S K=$O(Y(K)) Q:K="" S Y=Y(K) K Y(K) D
|
|---|
| 78 | . F M=1:1 S N=$P(Y,",",M) Q:N="" D
|
|---|
| 79 | . . S N1=+XX(N),N2=$P(XX(N),U,2)
|
|---|
| 80 | . . S (DA,XDRX(N1,N2))=XDRY(N1,N2)
|
|---|
| 81 | . . N I,J,K,M,N,N1,N2,X1,X2,X,DIE,DR,Y
|
|---|
| 82 | . . S DIE="^VA(15,"
|
|---|
| 83 | . . S X=DT,X=$$FMTE^XLFDT(X,"2D")
|
|---|
| 84 | . . S X=$P($P(^VA(200,DUZ,0),U),",",2)_" "_$P($P(^(0),U),",")_" (DUZ="_DUZ_") "_X
|
|---|
| 85 | . . S DR=".13///1;.14///"_X
|
|---|
| 86 | . . D ^DIE
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | RESTART ; Entry point to restart non-completed merges
|
|---|
| 90 | N NC,N S NC=0
|
|---|
| 91 | F XDRFDA=0:0 S XDRFDA=$O(^VA(15.2,XDRFDA)) Q:XDRFDA'>0 D
|
|---|
| 92 | . S X=$P(^VA(15.2,XDRFDA,0),U,4) I X="C"!(X="A") S N=1 D Q:N=1
|
|---|
| 93 | . . F J=0:0 S J=$O(^VA(15.2,XDRFDA,3,J)) Q:J'>0 I "CA"'[$P(^(J,0),U,3) S N=0 Q
|
|---|
| 94 | . S NC=NC+1
|
|---|
| 95 | . S DIR(0)="Y",DIR("A")="Do you want to RESTART merge process "_$P(^VA(15.2,XDRFDA,0),U),DIR("B")="NO"
|
|---|
| 96 | . D ^DIR K DIR Q:Y'>0
|
|---|
| 97 | . S ZTRTN="DQ^XDRMERG0",ZTSAVE("XDRFDA")="",ZTIO="NULL"
|
|---|
| 98 | . D ^%ZTLOAD I '$D(ZTSK) W !!,$C(7),"RESTART **NOT** QUEUED" Q
|
|---|
| 99 | . S $P(^VA(15.2,XDRFDA,0),U,8,9)=ZTSK_U ; SET TASK NUMBER AND REMOVE HALT FLAG IF SET
|
|---|
| 100 | . W !,"Restart queued as task ",ZTSK,!
|
|---|
| 101 | I NC'>0 W !!,$C(7),"No merge processes found that needed restarting.",!!
|
|---|
| 102 | Q
|
|---|
| 103 | ;
|
|---|
| 104 | ;
|
|---|
| 105 | DOSUBS(XDRFROM,XDRTO,IENTOSTR,XDRDASEQ) ;
|
|---|
| 106 | N NODEA,SFILE,VALUE,XVALUE,XDRXX,XDRYY,YVALUE,XENTOSTR
|
|---|
| 107 | N XDRAA,XDRZZ ; DEBUG STATEMENT
|
|---|
| 108 | S SFILE=+$P($G(@(XDRFROM_"0)")),U,2)
|
|---|
| 109 | I SFILE'>0 Q ; NO FILE NUMBER, NOT FILE MANAGER COMPATIBLE
|
|---|
| 110 | I $P($G(^DD(SFILE,.01,0)),U,2)["W" D Q ; HANDLE WORD PROCESSING FIELDS
|
|---|
| 111 | . N XF,XT S XT=$E(XDRTO,1,$L(XDRTO)-1)_")"
|
|---|
| 112 | . I '$D(@XT) D
|
|---|
| 113 | . . S XF=$E(XDRFROM,1,$L(XDRFROM)-1)_")"
|
|---|
| 114 | . . M @XT=@XF
|
|---|
| 115 | . . Q
|
|---|
| 116 | . Q
|
|---|
| 117 | F NODEA=0:0 S NODEA=$O(@(XDRFROM_NODEA_")")) Q:NODEA'>0 D
|
|---|
| 118 | . S VALUE=$P($G(@(XDRFROM_NODEA_",0)")),U) ; GET .01 VALUE
|
|---|
| 119 | . N XDRDT S XDRDT=^DD(SFILE,.01,0)
|
|---|
| 120 | . 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
|
|---|
| 121 | . S YVALUE=0,XVALUE=0 I $D(^DD(SFILE,.001,0)) S YVALUE=NODEA I $D(@(XDRTO_NODEA_")")) S XVALUE=YVALUE
|
|---|
| 122 | . I XVALUE=0,$P(^DD(SFILE,.01,0),U,5,99)["DINUM",$D(@(XDRTO_NODEA_")")) S XVALUE=NODEA
|
|---|
| 123 | . I XVALUE=0 S XVALUE=+$$FIND1^DIC(SFILE,(","_IENTOSTR),"Q",VALUE) ; FIND CURRENT ENTRY NUMBER, IF PRESENT
|
|---|
| 124 | . I XVALUE>0 D Q ; SUBFILE EXISTS IN IENTO, CHECK FOR LOWER SUBFILES
|
|---|
| 125 | . . N X,X1,NODE,NEWFROM,NEWTO,NEWTOIEN
|
|---|
| 126 | . . S NODE=""
|
|---|
| 127 | . . F S NODE=$O(@(XDRFROM_NODEA_","""_NODE_""")")) Q:NODE="" D
|
|---|
| 128 | . . . I $D(@(XDRFROM_NODEA_","""_NODE_""")"))'>1 Q
|
|---|
| 129 | . . . S NEWFROM=XDRFROM_NODEA_","""_NODE_""","
|
|---|
| 130 | . . . S NEWTO=XDRTO_XVALUE_","""_NODE_""","
|
|---|
| 131 | . . . S NEWTOIEN=XVALUE_","_IENTOSTR
|
|---|
| 132 | . . . D DOSUBS(NEWFROM,NEWTO,NEWTOIEN,(XVALUE_U_XDRDASEQ))
|
|---|
| 133 | . K XDRYY I YVALUE>0 S XDRYY(1)=YVALUE
|
|---|
| 134 | . S XENTOSTR="+1,"_IENTOSTR
|
|---|
| 135 | . S XDRFILTY=$P($G(^DD(SFILE,.01,0)),U,2)
|
|---|
| 136 | . I XDRFILTY["P" S VALUE="`"_VALUE
|
|---|
| 137 | . I XDRFILTY["V" D
|
|---|
| 138 | . . N Y S Y=$P(VALUE,";",2) Q:Y=""
|
|---|
| 139 | . . S Y=$P($G(@("^"_Y_"0)")),U) Q:Y=""
|
|---|
| 140 | . . S VALUE=Y_".`"_(+VALUE)
|
|---|
| 141 | . . Q
|
|---|
| 142 | . I SFILE=70.03 S XDRFILTY="D" ;use internal data for file 70.03
|
|---|
| 143 | . I XDRFILTY'["P"&(XDRFILTY'["V"),XDRFILTY'["D" S VALUE=$$GETEXT(XDRFROM,NODEA,SFILE)
|
|---|
| 144 | . S XDRXX(SFILE,XENTOSTR,.01)=VALUE
|
|---|
| 145 | . I $O(^DD(SFILE,0,"ID",0))>0 D
|
|---|
| 146 | . . ;CODE FOR ADDING IDENTIFIERS
|
|---|
| 147 | . . N I,N,XDRFROM1,IENFR
|
|---|
| 148 | . . S N=0,I=SFILE F S I=$G(^DD(I,0,"UP")) Q:I'>0 S N=N+1
|
|---|
| 149 | . . S XDRFROM1=$P(XDRFROM,"(",2,99),IENFR=NODEA_","
|
|---|
| 150 | . . F I=$L(XDRFROM1,",")-2:-2 Q:N'>0 S IENFR=IENFR_$P(XDRFROM1,",",I)_",",N=N-1
|
|---|
| 151 | . . ;
|
|---|
| 152 | . . F XDRID=0:0 S XDRID=$O(^DD(SFILE,0,"ID",XDRID)) Q:XDRID'>0 D
|
|---|
| 153 | . . . S N=$$GET1^DIQ(SFILE,IENFR,XDRID)
|
|---|
| 154 | . . . I N'="" S XDRXX(SFILE,XENTOSTR,XDRID)=N
|
|---|
| 155 | . . . Q
|
|---|
| 156 | . . Q
|
|---|
| 157 | . ;
|
|---|
| 158 | . K XDRAA,XDRZZ I $D(XDRTESTK) M XDRAA=XDRXX ; DEBUG STATEMENT
|
|---|
| 159 | . ; DATES THAT ARE DINUMED HAVE BEEN HANDLED ABOVE, SO CAN PASS A DATE IN AS AN INTERNAL VALUE
|
|---|
| 160 | . D UPDATE^DIE($S(XDRFILTY["D":"",1:"E"),"XDRXX","XDRYY","XDRZZ") ; CREATE A NEW ENTRY IN IENTO FOR VALUE
|
|---|
| 161 | . I $D(XDRZZ),$D(XDRTESTK),SFILE'=2.0361 S XDRTESTK=XDRTESTK+1 M ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ ; DEBUG STATEMENT
|
|---|
| 162 | . S NODEB=$G(XDRYY(1)) I NODEB'>0 Q
|
|---|
| 163 | . M @(XDRTO_NODEB_")")=@(XDRFROM_NODEA_")")
|
|---|
| 164 | . S DIK=XDRTO,DA=NODEB D
|
|---|
| 165 | . . F I=1:1 S DA(I)=$P(XDRDASEQ,U,I) I DA(I)="" K DA(I) Q
|
|---|
| 166 | . I SFILE=55.06 N DIU S DIU(0)=1 F DIK(1)=".01^B","10^AUDS","34^AUD","64^AUDDD","7^ACR1" D EN1^DIK
|
|---|
| 167 | . I SFILE'=55.06 N DIU S DIU(0)=1 D IX^DIK
|
|---|
| 168 | Q
|
|---|
| 169 | ;
|
|---|
| 170 | GETEXT(DICA,DA,FILNUM) ; GET EXTERNAL VALUE FOR .01 FIELD
|
|---|
| 171 | N DIC,DIQ,DR,XDRQ
|
|---|
| 172 | S DIC=DICA,DIC("P")=FILNUM,DR=.01,DIQ="XDRQ",DIQ(0)="E"
|
|---|
| 173 | D EN^DIQ1
|
|---|
| 174 | Q $G(XDRQ(FILNUM,DA,.01,"E"))
|
|---|
| 175 | ;
|
|---|
| 176 | DINUMDAT ; PROCESS ENTRIES WITH SAMPLE DATE/TIMES WITH SECONDS, NEEDS DINUM
|
|---|
| 177 | N NEWVAL,NODETO
|
|---|
| 178 | S NODETO=NODEA
|
|---|
| 179 | I $D(@(XDRTO_NODEA_")")) Q:(SFILE'=63.04) D
|
|---|
| 180 | . S NEWVAL=VALUE
|
|---|
| 181 | . F Q:'$D(@(XDRTO_NODETO_")")) S NODETO=NODETO-.000001,NEWVAL=NEWVAL+.000001
|
|---|
| 182 | M @(XDRTO_NODETO_")")=@(XDRFROM_NODEA_")")
|
|---|
| 183 | I $D(NEWVAL) S $P(@(XDRTO_NODETO_",0)"),U)=NEWVAL
|
|---|
| 184 | S DIK=XDRTO,DA=NODEA D D IX^DIK
|
|---|
| 185 | . F I=1:1 S DA(I)=$P(XDRDASEQ,U,I) I DA(I)="" K DA(I) Q
|
|---|
| 186 | S XDRDT=1
|
|---|
| 187 | Q
|
|---|
| 188 | ;
|
|---|
| 189 | DODIS ; CODE TO HANDLE DISPOSITION ENTRIES IN PATIENT FILE
|
|---|
| 190 | N XDRI,DA,DIK
|
|---|
| 191 | F XDRI=0:0 S XDRI=$O(@(XDRDIC_IENFROM_",""DIS"","_XDRI_")")) Q:XDRI'>0 D
|
|---|
| 192 | . I $D(@(XDRDIC_IENTO_",""DIS"","_XDRI_")")) Q
|
|---|
| 193 | . M @(XDRDIC_IENTO_",""DIS"","_XDRI_")")=@(XDRDIC_IENFROM_",""DIS"","_XDRI_")")
|
|---|
| 194 | . S DA=XDRI,DA(1)=IENTO,DIK=XDRDIC_IENTO_",""DIS""," D IX^DIK
|
|---|
| 195 | . Q
|
|---|
| 196 | Q
|
|---|
| 197 | ;
|
|---|
