Released XT*7.3*126 SEQ #104 Extracted from mail message **KIDS**:XT*7.3*126^ **INSTALL NAME** XT*7.3*126 "BLD",1329,0) XT*7.3*126^TOOLKIT^0^3101021^y "BLD",1329,1,0) ^^1^1^3100930^ "BLD",1329,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "BLD",1329,4,0) ^9.64PA^^ "BLD",1329,6.3) 2 "BLD",1329,"ABPKG") n "BLD",1329,"KRN",0) ^9.67PA^9002226^21 "BLD",1329,"KRN",.4,0) .4 "BLD",1329,"KRN",.401,0) .401 "BLD",1329,"KRN",.402,0) .402 "BLD",1329,"KRN",.403,0) .403 "BLD",1329,"KRN",.5,0) .5 "BLD",1329,"KRN",.84,0) .84 "BLD",1329,"KRN",3.6,0) 3.6 "BLD",1329,"KRN",3.8,0) 3.8 "BLD",1329,"KRN",9.2,0) 9.2 "BLD",1329,"KRN",9.8,0) 9.8 "BLD",1329,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",1329,"KRN",9.8,"NM",1,0) XDRRMRG1^^0^B66795233 "BLD",1329,"KRN",9.8,"NM",2,0) XDRMVFY^^0^B2860130 "BLD",1329,"KRN",9.8,"NM","B","XDRMVFY",2) "BLD",1329,"KRN",9.8,"NM","B","XDRRMRG1",1) "BLD",1329,"KRN",19,0) 19 "BLD",1329,"KRN",19.1,0) 19.1 "BLD",1329,"KRN",101,0) 101 "BLD",1329,"KRN",409.61,0) 409.61 "BLD",1329,"KRN",771,0) 771 "BLD",1329,"KRN",779.2,0) 779.2 "BLD",1329,"KRN",870,0) 870 "BLD",1329,"KRN",8989.51,0) 8989.51 "BLD",1329,"KRN",8989.52,0) 8989.52 "BLD",1329,"KRN",8994,0) 8994 "BLD",1329,"KRN",9002226,0) 9002226 "BLD",1329,"KRN","B",.4,.4) "BLD",1329,"KRN","B",.401,.401) "BLD",1329,"KRN","B",.402,.402) "BLD",1329,"KRN","B",.403,.403) "BLD",1329,"KRN","B",.5,.5) "BLD",1329,"KRN","B",.84,.84) "BLD",1329,"KRN","B",3.6,3.6) "BLD",1329,"KRN","B",3.8,3.8) "BLD",1329,"KRN","B",9.2,9.2) "BLD",1329,"KRN","B",9.8,9.8) "BLD",1329,"KRN","B",19,19) "BLD",1329,"KRN","B",19.1,19.1) "BLD",1329,"KRN","B",101,101) "BLD",1329,"KRN","B",409.61,409.61) "BLD",1329,"KRN","B",771,771) "BLD",1329,"KRN","B",779.2,779.2) "BLD",1329,"KRN","B",870,870) "BLD",1329,"KRN","B",8989.51,8989.51) "BLD",1329,"KRN","B",8989.52,8989.52) "BLD",1329,"KRN","B",8994,8994) "BLD",1329,"KRN","B",9002226,9002226) "BLD",1329,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1329,"QUES",0) ^9.62^^ "BLD",1329,"REQB",0) ^9.611^^ "MBREQ") 0 "PKG",6,-1) 1^1 "PKG",6,0) TOOLKIT^XT^PROGRAMMERS OPTIONS, MULTI. TERM LOOKUP^ "PKG",6,20,0) ^9.402P^^0 "PKG",6,22,0) ^9.49I^1^1 "PKG",6,22,1,0) 7.3^3040428^2970513^2 "PKG",6,22,1,"PAH",1,0) 126^3101021 "PKG",6,22,1,"PAH",1,1,0) ^^1^1^3101021 "PKG",6,22,1,"PAH",1,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","XDRMVFY") 0^2^B2860130^B2426142 "RTN","XDRMVFY",1,0) XDRMVFY ;SF-IRMFO/IHS/OHPRD/JCM - VERIFY POTENTIAL DUPLICATES ;09/30/2010 "RTN","XDRMVFY",2,0) ;;7.3;TOOLKIT;**23,126**;Apr 25, 1995;Build 2 "RTN","XDRMVFY",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XDRMVFY",4,0) ;; "RTN","XDRMVFY",5,0) ; Inserted DITC+4-6 IHS/OHPRD/JCM 3/26/91 "RTN","XDRMVFY",6,0) START ; "RTN","XDRMVFY",7,0) D DITC "RTN","XDRMVFY",8,0) G:XDRQFLG END "RTN","XDRMVFY",9,0) D VERIFY "RTN","XDRMVFY",10,0) G:XDRQFLG!(XDRMSTAT="") END "RTN","XDRMVFY",11,0) D STATUS "RTN","XDRMVFY",12,0) END D EOJ "RTN","XDRMVFY",13,0) Q "RTN","XDRMVFY",14,0) ; "RTN","XDRMVFY",15,0) DITC ; "RTN","XDRMVFY",16,0) S DIT(1)=XDRMCD,DIT(2)=XDRMCD2,DFF=XDRFL,IOP=IO(0) "RTN","XDRMVFY",17,0) D EN^DITC K IOP "RTN","XDRMVFY",18,0) I $D(DUOUT)!($D(DTOUT))!($D(DIRUT)) S XDRQFLG=1 K DIRUT,DUOUT,DTOUT "RTN","XDRMVFY",19,0) ;********************************* "RTN","XDRMVFY",20,0) ;I $G(DUZ("AG"))="I",'XDRQFLG,XDRFL=2 D ^DPTDZCH ;IHS/OHPRD/JCM 3/26/91 "RTN","XDRMVFY",21,0) ;********************************* "RTN","XDRMVFY",22,0) Q "RTN","XDRMVFY",23,0) ; "RTN","XDRMVFY",24,0) VERIFY ; Verifies if duplicate or not. "RTN","XDRMVFY",25,0) S XDRMSTAT="" "RTN","XDRMVFY",26,0) S DIR(0)="S^V:VERIFIED DUPLICATE;N:VERIFIED, NOT A DUPLICATE;U:UNABLE TO MAKE DETERMINATION" "RTN","XDRMVFY",27,0) S DIR("A")="Verification status of potential duplicate pair" "RTN","XDRMVFY",28,0) D ^DIR K DIR "RTN","XDRMVFY",29,0) I $D(DUOUT)!($D(DTOUT)) S XDRQFLG=1 G VERIFYX "RTN","XDRMVFY",30,0) S XDRMSTAT=$S(Y="V":"V",Y="N":"N",1:"") "RTN","XDRMVFY",31,0) D:XDRMSTAT="V" VERWARN^XDRRMRG1 ;p126 REM "RTN","XDRMVFY",32,0) VERIFYX Q "RTN","XDRMVFY",33,0) ; "RTN","XDRMVFY",34,0) STATUS ; "RTN","XDRMVFY",35,0) S DIE="^VA(15,",DA=XDRMPDA,DIE("NO^")=1,DR=".03///"_XDRMSTAT "RTN","XDRMVFY",36,0) S:XDRMSTAT="V" XDRMRG=1,DR=DR_";.04//2" "RTN","XDRMVFY",37,0) D ^DIE K DIE,DR,DA "RTN","XDRMVFY",38,0) Q "RTN","XDRMVFY",39,0) ; "RTN","XDRMVFY",40,0) EOJ ; "RTN","XDRMVFY",41,0) K DIT,DFF,IOP,XDRMSTAT,DIRUT "RTN","XDRMVFY",42,0) Q "RTN","XDRMVFY",43,0) ;******************************************** "RTN","XDRMVFY",44,0) ; EN entry point added specifically for APMFVFY for MFI "RTN","XDRMVFY",45,0) EN ; "RTN","XDRMVFY",46,0) S XDRQFLG=0 "RTN","XDRMVFY",47,0) D DITC "RTN","XDRMVFY",48,0) G:XDRQFLG ENX "RTN","XDRMVFY",49,0) D VERIFY "RTN","XDRMVFY",50,0) ENX K DIT,DFF,IOP "RTN","XDRMVFY",51,0) Q "RTN","XDRRMRG1") 0^1^B66795233^B57210493 "RTN","XDRRMRG1",1,0) XDRRMRG1 ;SF-IRMFO.SEA/JLI - DUP VERIFICATION FOR ANCILLARY SERVICES ;10/21/2010 "RTN","XDRRMRG1",2,0) ;;7.3;TOOLKIT;**23,29,46,47,49,126**;Apr 25, 1995;Build 2 "RTN","XDRRMRG1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XDRRMRG1",4,0) ; "RTN","XDRRMRG1",5,0) EN ; "RTN","XDRRMRG1",6,0) I '$D(XQADATA) Q "RTN","XDRRMRG1",7,0) N OVERWRIT,XDRDA,DFNFR,DFNTO,DFNFRX,DFNTOX,REVIEW,XDRGL,PRIFILE ; MODIFIED 03/28/00 "RTN","XDRRMRG1",8,0) S REVIEW=0 "RTN","XDRRMRG1",9,0) S XDRGL=$P($P($G(^VA(15,+XQADATA,0)),U),";",2) Q:XDRGL="" S XDRGL=U_XDRGL S PRIFILE=+$P(@(XDRGL_"0)"),U,2) ; MODIFIED 03/28/00 "RTN","XDRRMRG1",10,0) S XDRDA=$P(XQADATA,U) "RTN","XDRRMRG1",11,0) S DFNFR=$P(XQADATA,U,2) "RTN","XDRRMRG1",12,0) S (DFNTOX,DFNTO)=$P(DFNFR,";",2) "RTN","XDRRMRG1",13,0) S (DFNFRX,DFNFR)=$P(DFNFR,";") "RTN","XDRRMRG1",14,0) S PACKAGE=$P(XQADATA,U,3) "RTN","XDRRMRG1",15,0) S SUBFILES=$P(XQADATA,U,5) "RTN","XDRRMRG1",16,0) S SUBNAMES=$P(XQADATA,U,6) "RTN","XDRRMRG1",17,0) S XDRFILE=$P(XQADATA,U,4) "RTN","XDRRMRG1",18,0) S FILEDIC=^DIC(XDRFILE,0,"GL")_"DFN)" "RTN","XDRRMRG1",19,0) I XDRGL="^DPT(" D "RTN","XDRRMRG1",20,0) . S DFN=DFNFR D ^VADPT M DFNFR=VADM K VA,VADM "RTN","XDRRMRG1",21,0) . S DFN=DFNTO D ^VADPT M DFNTO=VADM K VA,VADM "RTN","XDRRMRG1",22,0) I XDRFILE=63 D "RTN","XDRRMRG1",23,0) . S DFNFR=$G(^DPT(DFNFR,"LR")) "RTN","XDRRMRG1",24,0) . S DFNTO=$G(^DPT(DFNTO,"LR")) "RTN","XDRRMRG1",25,0) I DFNFR'>0!(DFNTO'>0) W !,$C(7),"NO DATA TO REVIEW....",!! Q "RTN","XDRRMRG1",26,0) LDATE F XDRI=1,2 S DFN=$S(XDRI=1:DFNFR,1:DFNTO) S DFNNAM=$S(XDRI=1:"DFNFR",1:"DFNTO") D "RTN","XDRRMRG1",27,0) . S I=5 F S I=$O(@DFNNAM@(I)) Q:I="" K @DFNNAM@(I) "RTN","XDRRMRG1",28,0) . F ISUBS=1:1 S SUBSCR=$P(SUBFILES,";",ISUBS) Q:SUBSCR="" D "RTN","XDRRMRG1",29,0) . . S XX=$G(^DD(XDRFILE,SUBSCR,0)) "RTN","XDRRMRG1",30,0) . . I $P(XX,U,2)'["D" Q "RTN","XDRRMRG1",31,0) . . I $P($P(XX,U,4),";",2)'=0 Q "RTN","XDRRMRG1",32,0) . . S SUBSCR=$P($P(XX,U,4),";") "RTN","XDRRMRG1",33,0) . . N XDAT1 S XDAT1=0 "RTN","XDRRMRG1",34,0) . . I DFN>0 F I=0:0 S I=$O(@FILEDIC@(SUBSCR,I)) Q:I'>0 D "RTN","XDRRMRG1",35,0) . . . S X=$P($G(@FILEDIC@(SUBSCR,I,0)),U) "RTN","XDRRMRG1",36,0) . . . I XXDAT1 S XDAT1=X "RTN","XDRRMRG1",37,0) . . S LASTNAM="LAST "_$P(SUBNAMES,";",ISUBS) "RTN","XDRRMRG1",38,0) . . S @DFNNAM@(LASTNAM)="" "RTN","XDRRMRG1",39,0) . . I XDAT1>0 S @DFNNAM@(LASTNAM)=$$FMTE^XLFDT(XDAT1\1) "RTN","XDRRMRG1",40,0) . I @DFNNAM'="",'$D(@FILEDIC) S @DFNNAM="" "RTN","XDRRMRG1",41,0) D SHOW "RTN","XDRRMRG1",42,0) S:XDRFILE'=63 DFNFR=DFNFRX,DFNTO=DFNTOX ;REM - LAB is handled differently "RTN","XDRRMRG1",43,0) I IOST'["C-" Q "RTN","XDRRMRG1",44,0) D CHK "RTN","XDRRMRG1",45,0) Q "RTN","XDRRMRG1",46,0) ; "RTN","XDRRMRG1",47,0) SHOW ; "RTN","XDRRMRG1",48,0) N NAMIEN1,NAMIEN2 "RTN","XDRRMRG1",49,0) S N1=$$COUNT^XDRRMRG2(XDRFILE,DFNFRX,DFNTOX) "RTN","XDRRMRG1",50,0) W @IOF I N1>0,PACKAGE="PRIMARY" W !," RECORD"_N1_" contains fewer data elements, usually this would indicate",!," that this record would be merged INTO the other." "RTN","XDRRMRG1",51,0) ;S LABEL(1)="NAME",LABEL(2)="SSN",LABEL(3)="BIRTH DATE" "RTN","XDRRMRG1",52,0) ;S LABEL(4)="AGE",LABEL(5)="SEX",LABEL("LASTDAT")="LAST DATE" "RTN","XDRRMRG1",53,0) W !!,"Determine if these entries ARE or ARE NOT duplicates." "RTN","XDRRMRG1",54,0) W ! "RTN","XDRRMRG1",55,0) ;REM - Modified next three lines to include IENs by patient name. "RTN","XDRRMRG1",56,0) I XDRFILE=63 S NAMIEN1=$$LABIEN^XDRRMRG2(XDRFILE,DFNFR),NAMIEN2=$$LABIEN^XDRRMRG2(XDRFILE,DFNTO) "RTN","XDRRMRG1",57,0) ;W !,?20,$S(PACKAGE="PRIMARY":"RECORD1 [#"_DFNFR_"]",PACKAGE="LABORATORY":"MERGE FROM [#"_NAMIEN1_"]",1:"MERGE FROM [#"_DFNFR_"]") "RTN","XDRRMRG1",58,0) ;W ?45,$S(PACKAGE="PRIMARY":"RECORD2 [#"_DFNTO_"]",PACKAGE="LABORATORY":"MERGE TO [#"_NAMIEN2_"]",1:"MERGE TO [#"_DFNTO_"]") "RTN","XDRRMRG1",59,0) ;S I="" F S I=$O(DFNFR(I)) Q:I="" D "RTN","XDRRMRG1",60,0) ;. I DFNFR(I)=""&(DFNTO(I)="") Q "RTN","XDRRMRG1",61,0) ;. S DFNFR(I)=$S($P(DFNFR(I),U,2)'="":$P(DFNFR(I),U,2),1:$P(DFNFR(I),U)) "RTN","XDRRMRG1",62,0) ;. S DFNTO(I)=$S($P(DFNTO(I),U,2)'="":$P(DFNTO(I),U,2),1:$P(DFNTO(I),U)) "RTN","XDRRMRG1",63,0) ;. W !,$S($D(LABEL(I)):LABEL(I),1:I),?20,$E(DFNFR(I),1,20),?45,$E(DFNTO(I),1,20) "RTN","XDRRMRG1",64,0) ;. I I=1!(I=5) W ! "RTN","XDRRMRG1",65,0) ;I DFNFR=""!(DFNTO="") D "RTN","XDRRMRG1",66,0) ;. I DFNFR=""&(DFNTO="") W !!,"There is NO DATA in the "_PACKAGE_" file for either entry." Q "RTN","XDRRMRG1",67,0) ;. I DFNFR="" W !!,"There is NO DATA in the "_PACKAGE_" file for (",DFNFRX,") ",DFNFR(1)," ",DFNFR(2) "RTN","XDRRMRG1",68,0) ;. I DFNTO="" W !!,"There is NO DATA in the "_PACKAGE_" file for (",DFNTOX,") ",DFNTO(1)," ",DFNTO(2) "RTN","XDRRMRG1",69,0) ;S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT) "RTN","XDRRMRG1",70,0) ;I DFNFR=""!(DFNTO="") Q "RTN","XDRRMRG1",71,0) ;S DIT(1)=DFNFR,DIT(2)=DFNTO,IOP=IO(0),DFF=XDRFILE,DIC=XDRFILE "RTN","XDRRMRG1",72,0) D SHOW^XDRDSHOW(XDRFILE,DFNFR,DFNTO,.OVERWRIT,REVIEW) ;D EN^DITC K IOP "RTN","XDRRMRG1",73,0) Q "RTN","XDRRMRG1",74,0) ; "RTN","XDRRMRG1",75,0) CHK ; "RTN","XDRRMRG1",76,0) N DIR "RTN","XDRRMRG1",77,0) CHK1 K DIR "RTN","XDRRMRG1",78,0) S DIR(0)="S^V:VERIFIED DUPLICATE;N:VERIFIED, NOT A DUPLICATE;U:UNABLE TO DETERMINE;H:HEALTH SUMMARY;R:REVIEW DATA AGAIN;S:SELECT/REVIEW OVERWRITES",DIR("A")="Select Action",DIR("B")="HEALTH SUMMARY" "RTN","XDRRMRG1",79,0) D ^DIR K DIR S XDRY=Y I $D(DIRUT) K XQAKILL Q "RTN","XDRRMRG1",80,0) I XDRY="R" S REVIEW=0 D SHOW G CHK1 "RTN","XDRRMRG1",81,0) I XDRY="S" S REVIEW=1 D SHOW G CHK1 "RTN","XDRRMRG1",82,0) I XDRY'="H" D Q "RTN","XDRRMRG1",83,0) . K XQAKILL "RTN","XDRRMRG1",84,0) . I XDRY'="^" D "RTN","XDRRMRG1",85,0) . . S XQAKILL=$S(XDRY'="U":0,1:1) "RTN","XDRRMRG1",86,0) . . S XDRDIR="" "RTN","XDRRMRG1",87,0) . . I XDRY="V" D VERWARN ;p126-REM "RTN","XDRRMRG1",88,0) . . I XDRY="V",PACKAGE="PRIMARY" D "RTN","XDRRMRG1",89,0) . . . S DIR=0 F DFN=DFNFRX,DFNTOX I $D(@FILEDIC) S DIR=DIR+1 "RTN","XDRRMRG1",90,0) . . . I DIR'>1 K DIR Q ; DON'T NEED TO SELECT DIRECTION UNLESS DATA IN BOTH ENTRIES "RTN","XDRRMRG1",91,0) . . . S DIR("B")=$$COUNT^XDRRMRG2(XDRFILE,DFNFRX,DFNTOX) "RTN","XDRRMRG1",92,0) . . . S DIR("B")=$S(DIR("B")'>1:"RECORD1 INTO RECORD2",1:"RECORD2 INTO RECORD1") "RTN","XDRRMRG1",93,0) . . . I DIR("B")=0 K DIR("B") "RTN","XDRRMRG1",94,0) . . . S DIR(0)="S^1:RECORD1 INTO RECORD2;2:RECORD2 INTO RECORD1" "RTN","XDRRMRG1",95,0) . . . W !!!,?20,"RECORD1 [#"_DFNFR_"]",?45,"RECORD2 [#"_DFNTO_"]" "RTN","XDRRMRG1",96,0) . . . W !,?20,DFNFR(1),?45,DFNTO(1) "RTN","XDRRMRG1",97,0) . . . S DIR("A")="Which record (1 or 2) should be MERGED INTO the other record" "RTN","XDRRMRG1",98,0) . . . D ^DIR K DIR I Y>0 S XDRDIR=+Y "RTN","XDRRMRG1",99,0) . . . I $D(DIRUT) S XDRY="^" W !!!,$C(7),"VERIFICATION ABORTED!",! Q "RTN","XDRRMRG1",100,0) . . . I DFNFRX'=+^VA(15,XDRDA,0) S XDRDIR=$S(XDRDIR'>0:2,XDRDIR=1:2,1:1) "RTN","XDRRMRG1",101,0) . . N XDRFDA,XDRDA1 "RTN","XDRRMRG1",102,0) . . S XDRDA1=$$FIND1^DIC(15.02,","_XDRDA_",","X",PACKAGE) "RTN","XDRRMRG1",103,0) . . S XDRDA1=$S(XDRDA1>0:XDRDA1_",",1:"+1,")_XDRDA_"," "RTN","XDRRMRG1",104,0) . . S XDRFDA(15.02,XDRDA1,.01)=PACKAGE "RTN","XDRRMRG1",105,0) . . S XDRFDA(15.02,XDRDA1,.02)=XDRY "RTN","XDRRMRG1",106,0) . . S XDRFDA(15.02,XDRDA1,.03)=DUZ "RTN","XDRRMRG1",107,0) . . S XDRFDA(15.02,XDRDA1,.04)=$$NOW^XLFDT() "RTN","XDRRMRG1",108,0) . . I XDRDIR'="" S XDRFDA(15.02,XDRDA1,.05)=XDRDIR "RTN","XDRRMRG1",109,0) . . D UPDATE^DIE("S","XDRFDA") "RTN","XDRRMRG1",110,0) . . ; "RTN","XDRRMRG1",111,0) . . I $D(OVERWRIT)!(XDRDIR=2&(PACKAGE'="PRIMARY")) D "RTN","XDRRMRG1",112,0) . . . N I "RTN","XDRRMRG1",113,0) . . . S XDRDA1=$$FIND1^DIC(15.03,","_XDRDA_",","X",XDRFILE) "RTN","XDRRMRG1",114,0) . . . I XDRDA1'>0 D "RTN","XDRRMRG1",115,0) . . . . S XDRDA1="+1,"_XDRDA_"," "RTN","XDRRMRG1",116,0) . . . . K XDRFDA,XDRDAX "RTN","XDRRMRG1",117,0) . . . . S XDRDAX(1)=XDRFILE "RTN","XDRRMRG1",118,0) . . . . S XDRFDA(15.03,XDRDA1,.01)=XDRFILE "RTN","XDRRMRG1",119,0) . . . . I XDRDIR=2,PACKAGE'="PRIMARY" D "RTN","XDRRMRG1",120,0) . . . . . S XDRFDA(15.03,XDRDA1,.02)=2 "RTN","XDRRMRG1",121,0) . . . . D UPDATE^DIE("S","XDRFDA","XDRDAX") "RTN","XDRRMRG1",122,0) . . . . S XDRDA1=XDRDAX(1) "RTN","XDRRMRG1",123,0) . . . S XDRDA1="+1,"_XDRDA1_","_XDRDA_"," "RTN","XDRRMRG1",124,0) . . . F I=0:0 S I=$O(OVERWRIT(I)) Q:I'>0 D "RTN","XDRRMRG1",125,0) . . . . K XDRFDA,XDRDAX "RTN","XDRRMRG1",126,0) . . . . S XDRDAX(1)=I "RTN","XDRRMRG1",127,0) . . . . S XDRFDA(15.031,XDRDA1,.01)=I "RTN","XDRRMRG1",128,0) . . . . D UPDATE^DIE("S","XDRFDA","XDRDAX") "RTN","XDRRMRG1",129,0) . I XDRY="V" D "RTN","XDRRMRG1",130,0) . . D CHEKVER "RTN","XDRRMRG1",131,0) . I XDRY="N" D "RTN","XDRRMRG1",132,0) . . S XDRAID=$G(XQAID) N XQAID,I "RTN","XDRRMRG1",133,0) . . F I=0:0 S I=$O(^VA(15.1,PRIFILE,2,I)) Q:I'>0 D ; MODIFIED 03/28/00 "RTN","XDRRMRG1",134,0) . . . S XQAID=$P(XDRAID,",",1,2)_","_I "RTN","XDRRMRG1",135,0) . . . S XQAKILL=0 "RTN","XDRRMRG1",136,0) . . . D DELETEA^XQALERT "RTN","XDRRMRG1",137,0) . . N XDRFDA "RTN","XDRRMRG1",138,0) . . S XDRFDA(15,XDRDA_",",.03)="N" "RTN","XDRRMRG1",139,0) . . S XDRFDA(15,XDRDA_",",.07)=$$NOW^XLFDT() "RTN","XDRRMRG1",140,0) . . S XDRFDA(15,XDRDA_",",.11)=DUZ "RTN","XDRRMRG1",141,0) . . D UPDATE^DIE("S","XDRFDA") "RTN","XDRRMRG1",142,0) S ABORT=0 D ASK^XDRRMRG2(.QLIST,.ABORT) ;REM -Reset ABORT to 0 "RTN","XDRRMRG1",143,0) ; "RTN","XDRRMRG1",144,0) ;For health summary, user has the option of using the Browser to view "RTN","XDRRMRG1",145,0) ;both records or use may select any other device for each record. "RTN","XDRRMRG1",146,0) ; "RTN","XDRRMRG1",147,0) I '$G(ABORT) D PRINT2^XDRRMRG2 "RTN","XDRRMRG1",148,0) D HOME^%ZIS "RTN","XDRRMRG1",149,0) G CHK1 "RTN","XDRRMRG1",150,0) Q "RTN","XDRRMRG1",151,0) ; "RTN","XDRRMRG1",152,0) CHEKVER ; "RTN","XDRRMRG1",153,0) N R "RTN","XDRRMRG1",154,0) S XVER=1 "RTN","XDRRMRG1",155,0) F I=0:0 S I=$O(^VA(15.1,PRIFILE,2,I)) Q:I'>0 D Q:'XVER ; MODIFIED 03/28/00 "RTN","XDRRMRG1",156,0) . S X1=+$P(^VA(15.1,PRIFILE,2,I,0),U,2) ; MODIFIED 03/28/00 "RTN","XDRRMRG1",157,0) . S XN=$P(^VA(15.1,PRIFILE,2,I,0),U) ; MODIFIED 03/28/00 "RTN","XDRRMRG1",158,0) . I X1>0 D "RTN","XDRRMRG1",159,0) . . F R=1,5,6,7,0 I $O(^XMB(3.8,X1,R,0))>0 Q ;REM -changed I to R in FOR loop "RTN","XDRRMRG1",160,0) . . I R'>0 S X1=0 "RTN","XDRRMRG1",161,0) . I X1'>0,$O(^VA(15.1,PRIFILE,2,I,1,0))'>0 Q ; MODIFIED 03/28/00 "RTN","XDRRMRG1",162,0) . S X1=$$FIND1^DIC(15.02,","_XDRDA_",","X",XN) "RTN","XDRRMRG1",163,0) . S XVER=$S(X1'>0:0,$P(^VA(15,XDRDA,2,X1,0),U,2)="V":1,$P(^(0),U,2)="D":1,1:0) "RTN","XDRRMRG1",164,0) I XVER D FINALVER^XDRVCHEK(XDRDA) "RTN","XDRRMRG1",165,0) Q "RTN","XDRRMRG1",166,0) ; "RTN","XDRRMRG1",167,0) SETUP(XDRDA) ; "RTN","XDRRMRG1",168,0) N XDRGRPN,XDRSSN,XDRFILE "RTN","XDRRMRG1",169,0) S X=^VA(15,XDRDA,0) "RTN","XDRRMRG1",170,0) I $P($G(^VA(15,XDRDA,2,1,0)),U,5)=2 S DFNTO=+X,DFNFR=+$P(X,U,2) "RTN","XDRRMRG1",171,0) E S DFNFR=+X,DFNTO=+$P(X,U,2) "RTN","XDRRMRG1",172,0) S XDRFILE=$P($P(X,U),";",2),XDRFILE=+$P(@(U_XDRFILE_"0)"),U,2) "RTN","XDRRMRG1",173,0) F XDRAID=0:0 S XDRAID=$O(^VA(15.1,PRIFILE,2,XDRAID)) Q:XDRAID'>0 D ; MODIFIED 03/28/00 "RTN","XDRRMRG1",174,0) . S XDRNODE=^VA(15.1,PRIFILE,2,XDRAID,0) ; MODIFIED 03/28/00 "RTN","XDRRMRG1",175,0) . S XDRNOD2=$G(^VA(15.1,PRIFILE,2,XDRAID,2)) ; MODIFIED 03/28/00 "RTN","XDRRMRG1",176,0) . S XDRNAME=$P(XDRNODE,U) "RTN","XDRRMRG1",177,0) . S XDRGRP=$P(XDRNODE,U,2) "RTN","XDRRMRG1",178,0) . S:XDRGRP>0 XDRGRPN=$$GET1^DIQ(3.8,XDRGRP,.01) ;REM -8/2/96 Get the name of mail group "RTN","XDRRMRG1",179,0) . S XDRGRP=$S(XDRGRP>0:"G."_XDRGRPN,1:"") "RTN","XDRRMRG1",180,0) . S XDRFILE=$P(XDRNODE,U,3) D Q:'$D(XDRNODE) "RTN","XDRRMRG1",181,0) . . N XDRDIC,XDRFR,XDRTO "RTN","XDRRMRG1",182,0) . . S XDRDIC=^DIC(XDRFILE,0,"GL") "RTN","XDRRMRG1",183,0) . . S XDRFR=$S(XDRFILE'=63:DFNFR,1:$G(^DPT(DFNFR,"LR"))) "RTN","XDRRMRG1",184,0) . . S XDRTO=$S(XDRFILE'=63:DFNTO,1:$G(^DPT(DFNTO,"LR"))) "RTN","XDRRMRG1",185,0) . . I XDRFR'>0!(XDRTO'>0) K XDRNODE "RTN","XDRRMRG1",186,0) . . I $D(XDRNODE),'$D(@(XDRDIC_XDRFR_",0)"))!'$D(@(XDRDIC_XDRTO_",0)")) K XDRNODE "RTN","XDRRMRG1",187,0) . . I '$D(XDRNODE) D "RTN","XDRRMRG1",188,0) . . . N XDRARR I $$FIND1^DIC(15.02,","_XDRDA_",","X",XDRNAME)>0 Q "RTN","XDRRMRG1",189,0) . . . S XDRARR(15.02,"+1,"_XDRDA_",",.01)=XDRNAME "RTN","XDRRMRG1",190,0) . . . S XDRARR(15.02,"+1,"_XDRDA_",",.02)="D" "RTN","XDRRMRG1",191,0) . . . D UPDATE^DIE("","XDRARR") "RTN","XDRRMRG1",192,0) . S XQADATA=XDRDA_U_DFNFR_";"_DFNTO_U_XDRNAME_U_XDRFILE_U_$P(XDRNOD2,U)_U_$P(XDRNOD2,U,2) "RTN","XDRRMRG1",193,0) . ;S R(1)=XDRDA_U_DFNFR_";"_DFNTO_U_XDRNAME_U_XDRFILE_U_$P(XDRNOD2,U)_U_$P(XDRNOD2,U,2) "RTN","XDRRMRG1",194,0) . D SETARY^XDRRMRG0 S XMTEXT="R(" "RTN","XDRRMRG1",195,0) . S:XDRGRP'="" XMY(XDRGRP)="" "RTN","XDRRMRG1",196,0) . F I=0:0 S I=$O(^VA(15.1,PRIFILE,2,XDRAID,1,I)) Q:I'>0 S X=^(I,0) D "RTN","XDRRMRG1",197,0) . . S XQA(X)="" "RTN","XDRRMRG1",198,0) . D SEND^XDRRMRG0 K R "RTN","XDRRMRG1",199,0) Q "RTN","XDRRMRG1",200,0) VERWARN ;Warning message when ready to Verified Dupicates; p126-REM "RTN","XDRRMRG1",201,0) W !!,"*** WARNING!!! You have verified these two records are the SAME" "RTN","XDRRMRG1",202,0) W !,"patient. Once these records are merged, there is no automated way to" "RTN","XDRRMRG1",203,0) W !,"""un-do"" the merge. If you are not certain these are the same patient," "RTN","XDRRMRG1",204,0) W !,"edit the status back to 'Potential Duplicate, Unverified' and repeat the" "RTN","XDRRMRG1",205,0) W !,"verification process. For additional assistance, please log a NOIS/Remedy" "RTN","XDRRMRG1",206,0) W !,"ticket. ***" "RTN","XDRRMRG1",207,0) W !! "RTN","XDRRMRG1",208,0) Q "VER") 8.0^22.0 "BLD",1329,6) ^104 **END** **END**