source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMADD.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1XDRMADD ;SF-IRMFO/IHS/OHPRD/JCM,JLI,REM - USER CREATED VERIFIED DUPLICATE PAIR ENTRY ;4/6/98 09:24
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4 N XDRFL,XDRCNTR
5 S XDRCNTR=0
6START ;
7 N XDRADFLG
8 K DIC
9 S (XDRQFLG,XDRADFLG)=0
10 I '$D(XDRFL) S DIC("A")="Add entries from which File: " D FILE^XDRDQUE
11 G:XDRQFLG END
12 S XDRDTYPE=$P(XDRD(0),U,5)
13 I XDRDTYPE="" D ;REM -8/20/96 when XDRDTYPE is null set it to basic.
14 .S $P(^VA(15.1,XDRFL,0),U,5)="b",XDRDTYPE="b"
15 S XDRGL=^DIC(XDRFL,0,"GL")
16 D:XDRCNTR>0 G:XDRQFLG END
17 .W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to ADD another pair (Y/N)"
18 .D ^DIR K DIR S:$D(DIRUT)!('Y) XDRQFLG=1
19 S XDRCNTR=XDRCNTR+1
20 D BYPASS G:XDRQFLG END
21 D LKUP G:XDRQFLG END
22 D CHECK G:XDRQFLG<0 START
23 D ^XDRDSCOR S:XDRADFLG XDRDSCOR("PDT%")=0 ;REM -8/23/96 to bypass PDT%
24 S XDRD("NOADD")="" D ^XDRDUP
25 K XDRDTYPE
26 D SCORE
27 I XDRMADD("DUPSCORE%")<XDRDSCOR("PDT%") D G START ; JLI 4/11/96
28 . W !!,$C(7),"This pair of patients has a duplicate percentage of only ",XDRMADD("DUPSCORE%"),"% which"
29 . W !,"is less than the minimal percentage for potential duplicates (",XDRDSCOR("PDT%"),"%)."
30 . W !!?30,"Patients not added!!!",!!
31 S XDRDA=+XDRDFLG I XDRDA'>0 D ADD
32 G:XDRQFLG START
33 D SHOW^XDRDPICK ; D MERGE ; CHANGED TO CURRENT VERIF METHOD, NOT MERGE 4/11/96 JLI
34 G START ; ADDED 4/11/96 JLI
35END D EOJ
36 Q
37 ;
38LKUP ;Looks up the records to add.
39 K XDRCD,XDRCD2
40 S DIC=XDRGL,DIC(0)="QEAM"
41 S DIC("S")="I '$D(^VA(15,""AFR"",$P(XDRGL,U,2),Y))"
42 S DIC("A")="Select "_$P(^DIC(XDRFL,0),U,1)_": "
43 D ^DIC K DIC,DA
44 I $D(DIRUT)!(Y=-1) S XDRQFLG=1 G LKUPX
45 S XDRCD=+Y
46LKUP2 S DIC=XDRGL,DIC(0)="QEAM"
47 S DIC("S")="I '$D(^VA(15,""AFR"",$P(XDRGL,U,2),Y))"
48 S DIC("A")=" Another "_$P(^DIC(XDRFL,0),U,1)_": "
49 D ^DIC K DIC,DA
50 G:$D(DIRUT)!(Y=-1) LKUP
51 S XDRCD2=+Y
52 I XDRCD=XDRCD2 W !!,"Please do not try and merge the same patients together.",!! K XDRCD2 G LKUP2
53 S XDRMADD("REC1")=$S(XDRCD<XDRCD2:XDRCD,1:XDRCD2)
54 S XDRMADD("REC2")=$S(XDRMADD("REC1")=XDRCD:XDRCD2,1:XDRCD)
55 S XDRCD=XDRMADD("REC1"),XDRCD2=XDRMADD("REC2")
56 W !!,"You will be adding the following pair of records to the duplicate record file:",!
57 W !?5,"RECORD1: ",$P(@(XDRGL_XDRCD_",0)"),U)
58 W !?5,"RECORD2: ",$P(@(XDRGL_XDRCD2_",0)"),U)
59 W !! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S XDRQFLG=1 Q
60 W " Ok, continuing, hold on ...",!
61 ;W !!,"Hit return to continue " R XDRMADD("ANS"):DTIME W " Okay, continuing, hold on ...",!
62LKUPX Q
63 ;
64CHECK ;
65 S XDRDFLG=0 F XDRDI="APOT","ANOT","AVDUP" I $D(^VA(15,XDRDI,$P(XDRGL,U,2),XDRCD_U_XDRCD2))!($D(^VA(15,XDRDI,$P(XDRGL,U,2),XDRCD2_U_XDRCD))) S XDRDFLG=-1 I XDRDI="APOT" D
66 . I $D(^VA(15,XDRDI,$P(XDRGL,U,2),XDRCD_U_XDRCD2)) S XDRDFLG=$O(^(XDRCD_U_XDRCD2,0)) Q
67 . S XDRDFLG=$O(^VA(15,XDRDI,$P(XDRGL,U,2),XDRCD2_U_XDRCD,0))
68 I XDRDFLG W !!,"They are already entered in Duplicate Record file.",!!
69 K XDRDI
70 Q
71 ;
72SCORE ;
73 S XDRMADD("DUPSCORE%")=$S($G(XDRDSCOR("MAX"))=0:0,1:(XDRD("DUPSCORE")/XDRDSCOR("MAX")))
74 S XDRMADD("DUPSCORE%")=$J(XDRMADD("DUPSCORE%"),1,2)
75 S XDRMADD("DUPSCORE%")=$S(XDRMADD("DUPSCORE%")<0:0,XDRMADD("DUPSCORE%")<1:$E(XDRMADD("DUPSCORE%"),3,4),1:100)
76 S XDRDFR=$S(XDRCD<XDRCD2:XDRCD,1:XDRCD2)
77 S XDRDTO=$S(XDRDFR=XDRCD:XDRCD2,1:XDRCD)
78 S XDRMADD("STATUS")="X"
79 Q
80 ;
81ADD ;
82 ;ADD TO DUPLICATE RECORD FILE
83 S XDRMAINI="MERGE" D ^XDRMAINI ;LAB/OHPRD ADDED THIS
84 S DIC="^VA(15,",DIC(0)="L",X=XDRDFR_";"_$P(XDRGL,U,2),DLAYGO=15
85 S XDRMADDX=XDRDTO_";"_$P(XDRGL,U,2)
86 S DIC("DR")=".02////^S X=XDRMADDX"_";.03////"_XDRMADD("STATUS")
87 ;S DIC("DR")=DIC("DR")_";.04//2" ;REM -10/2/96 this will be asked in XDRRMRG!
88 S DIC("DR")=DIC("DR")_";.03///P"_";.06////"_DT_";.09////"_DUZ
89 S DIC("DR")=DIC("DR")_";.15////"_XDRDSCOR("MAX")_";.17////"_XDRDSCOR("PDT%")_";.18////"_XDRD("DUPSCORE")_";.19////"_XDRMADD("DUPSCORE%")
90 S:$D(XDRDSCOR("VDT%")) DIC("DR")=DIC("DR")_";.16////"_XDRDSCOR("VDT%")
91 D
92 . N I,X1,X2,X3
93 . S X1=X_U_XDRMADDX,X2=XDRMADDX_U_X
94 . F I=0:0 S I=$O(^VA(15,"B",X,I)) Q:I'>0 S X3=$P($G(^VA(15,I,0)),U,1,2) I X3=X1!(X3=X2) K X Q
95 S Y=-1 I $D(X) D FILE^DICN
96 K DIC,DR,X,DLAYGO
97 I Y'>0 S XDRQFLG=1 K XDRCD,XDRCD2 G ADDX
98 S DIE="^VA(15,",(XDRDA,XDRMPDA,DA)=+Y ; ADDED XDRDA TO LIST 4/11/96 JLI
99 F XDRMORD=0:0 S XDRMORD=$O(XDRDTEST(XDRMORD)) Q:'XDRMORD S DR="2101///"_$P(XDRDTEST(XDRMORD),U,1),DR(2,15.02101)=".02////"_XDRDUP("TEST SCORE",XDRMORD) D ^DIE K DR
100ADDX K DIE,DR,DA,XDRMORD,XDRMADDX,XDRDUP("TEST SCORE")
101 Q
102 ;
103MERGE Q ;
104 S XDRMPAIR=XDRDFR_"^"_XDRDTO,XDRM("NOVERIFY")=""
105 D EN^XDRMAIN
106MERGEX K XDRM
107 Q
108 ;
109BYPASS ;REM -8/20/96 Add record directly into file 15, bypass threshold.
110 N X,XDRKEY
111 S (X,XDRKEY)=0 F S X=$O(^VA(200,DUZ,51,"B",X)) Q:X'>0!(XDRKEY) D
112 .I $$GET1^DIQ(19.1,X,.01)="XDRMGR" S XDRKEY=1 Q
113 Q:'XDRKEY
114 S DIR(0)="Y",DIR("A")="Do you want to bypass the potential duplicate threshold % check (Y/N)"
115 S DIR("??")="^W !!,""This will add the pair of records to the Duplicate Record file without checking the potential duplicate threshold %."""
116 D ^DIR K DIR S XDRADFLG=Y I $D(DTOUT)!($D(DUOUT)) S XDRQFLG=1 Q
117 I 'XDRADFLG W !!,*7,"Potential duplicate threshold % will NOT be bypassed!",!
118 I XDRADFLG D
119 .W !!,"This will add the pair of records directly into the Duplicate Record file."
120 .S DIR(0)="YO",DIR("A")="Are you sure you want to continue",DIR("B")="NO"
121 .D ^DIR K DIR S XDRADFLG=Y W ! I $D(DIRUT) S XDRQFLG=1 Q
122 .I 'XDRADFLG W *7,!!,"Potential duplicate threshold % will NOT be bypassed!",!
123 Q
124 ;
125EOJ ;
126 K XDRMADD,XDRMORD,XDRDFR,XDRDTO,X,Y,XDRCD,XDRCD2,XDRD,XDRFL,XDRGL
127 K XDRFL,XDRMPAIR,XDRMPDA,XDRQFLG,XDRDSCOR,XDRDTEST
128 Q
Note: See TracBrowser for help on using the repository browser.