source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTDUP.m@ 1133

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1DENTDUP ;ISC2/HAG-CHECK FOR DUPLICATE RECORD ; 10/12/88 3:04 PM ;
2V ;;VERSION 1.2
3DATE D DATE^DENTA1 G:Y<0 EXIT S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
4 I $D(IO("Q")) S ZTRTN="QUE^DENTDUP",ZTSAVE("DENTSTA")="",ZTSAVE("DENTSD")="",DENT("DENTSD1")="",ZTSAVE("DENTED")="",ZTSAVE("H1")="",ZTSAVE("H2")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G EXIT
5 W @IOF,!!,?5,"One moment please it may take awhile.",!
6QUE U IO S U="^" K ^UTILITY($J,"DENTDUP") S DENTSD=DENTSD-.0001
7 F A=1:1 S DENTP="",DENTSD=$O(^DENT(221,"AC1",DENTSTA,DENTSD)) Q:DENTSD=""!(DENTSD>DENTED) F B=1:1 S N="",DENTP=$O(^DENT(221,"AC1",DENTSTA,DENTSD,DENTP)) Q:DENTP="" D BUILDAR
8 D REPORT G EXIT
9BUILDAR F C=0:0 S N=$O(^DENT(221,"AC1",DENTSTA,DENTSD,DENTP,N)) Q:N="" S:'$D(^DENT(221,N,.1))&($D(^DENT(221,N,0))) AR(N)=^(0)
10 S D="" F X=0:0 S F1="",D=$O(AR(D)) Q:D="" D SETA S D1=D D COMP1 S:F1=1 ^UTILITY($J,"DENTDUP",A,D,D)=$P(AR(D),U,1)_U_$P(AR(D),U,2)_U_$P(AR(D),U,39) K AR(D)
11 Q
12COMP1 F W=1:1 S D1=$O(AR(D1)),E=0 Q:D1="" D SETB S:A1=A2!(($P(A1,U,1,3)=$P(A2,U,1,3))&(($P(A1,U,4,41)?."^")!($P(A2,U,4,41)?."^"))) ^UTILITY($J,"DENTDUP",A,D,D1)=$P(AR(D1),U,1)_U_$P(AR(D1),U,2)_U_$P(AR(D1),U,39),(E,F1)=1 K:E AR(D1)
13 Q
14SETA S A1=$P(AR(D),U,2)_U_$P(AR(D),U,6)_U_$P(AR(D),U,19)_U_$P(AR(D),U,3,4)_U_$P(AR(D),U,7,18)_U_$P(AR(D),U,20,38)_U_$P(AR(D),U,41,45) Q
15SETB S A2=$P(AR(D1),U,2)_U_$P(AR(D1),U,6)_U_$P(AR(D1),U,19)_U_$P(AR(D1),U,3,4)_U_$P(AR(D1),U,7,18)_U_$P(AR(D1),U,20,38)_U_$P(AR(D1),U,41,45) Q
16REPORT D HDR Q:'$D(^UTILITY($J)) S (A,Z5)="" F I=1:1 S A=$O(^UTILITY($J,"DENTDUP",A)) Q:A="" S B="" F Y=0:0 S B=$O(^UTILITY($J,"DENTDUP",A,B)) Q:B="" S C="" D REPORT1 W !
17 Q:Z5=U D HOLD Q
18REPORT1 F J=0:0 D:$Y#(IOSL-2)=0 HOLD1 Q:Z5=U S C=$O(^UTILITY($J,"DENTDUP",A,B,C)) Q:C="" S Y=$P(^(C),U,1),Y2=$P(^(C),U,3),Y3=$P(^(C),U,2) X ^DD("DD") W !,?6,Y,?28,Y2,?49,$E(Y3,1,3)_"-"_$E(Y3,4,5)_"-"_$E(Y3,6,9)
19 Q
20HOLD1 D HOLD D:Z5'=U HDR Q
21HOLD Q:$D(ZTSK)!(IO'=IO(0)) S Z5="" R !,"Press return to continue, uparrow (^) to exit: ",Z5:DTIME Q
22HDR S HD="DUPLICATE TREATMENT DATA REPORT",HD1="STATION: "_DENTSTA,H3="("_$S(H1=H2:"For "_H1,1:"From "_H1_" to "_H2)_")" W @IOF,!,?(80-$L(HD)/2),HD,!,?(80-$L(HD1)/2),HD1,!,?(80-$L(H3)/2),H3
23 W !!,?6,"DATE TIME",?28,"PATIENT NAME",?49,"SOCIAL SECURITY",! W:'$D(^UTILITY($J)) !!,?5,"There are no duplicate records in the time frame you specified."
24 Q
25EXIT X ^%ZIS("C") K A,A1,A2,B,C,D,D1,E,F1,DENTSD,DENTED,DENTP,DENTSD1,DENTSTA,DIC,H1,H2,H3,HD,N,^UTILITY($J),W,X,Y,Y2,Y3,Z1,Z2,Z5,ZTRTN,ZTSAVE K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK Q
Note: See TracBrowser for help on using the repository browser.