DENTDUP ;ISC2/HAG-CHECK FOR DUPLICATE RECORD ; 10/12/88 3:04 PM ;
V ;;VERSION 1.2
DATE D DATE^DENTA1 G:Y<0 EXIT S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT:IO=""
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
W @IOF,!!,?5,"One moment please it may take awhile.",!
QUE U IO S U="^" K ^UTILITY($J,"DENTDUP") S DENTSD=DENTSD-.0001
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
D REPORT G EXIT
BUILDAR 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)
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)
Q
COMP1 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)
Q
SETA 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
SETB 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
REPORT 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 !
Q:Z5=U D HOLD Q
REPORT1 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)
Q
HOLD1 D HOLD D:Z5'=U HDR Q
HOLD Q:$D(ZTSK)!(IO'=IO(0)) S Z5="" R !,"Press return to continue, uparrow (^) to exit: ",Z5:DTIME Q
HDR 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
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."
Q
EXIT 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTDUP 2543 printed Dec 13, 2024@01:46:33 Page 2
DENTDUP ;ISC2/HAG-CHECK FOR DUPLICATE RECORD ; 10/12/88 3:04 PM ;
V ;;VERSION 1.2
DATE DO DATE^DENTA1
if Y<0
GOTO EXIT
SET %ZIS="MQ"
KILL IO("Q")
DO ^%ZIS
if IO=""
GOTO EXIT
+1 IF $DATA(IO("Q"))
SET ZTRTN="QUE^DENTDUP"
SET ZTSAVE("DENTSTA")=""
SET ZTSAVE("DENTSD")=""
SET DENT("DENTSD1")=""
SET ZTSAVE("DENTED")=""
SET ZTSAVE("H1")=""
SET ZTSAVE("H2")=""
DO ^%ZTLOAD
KILL ZTSK,ZTRTN,ZTSAVE
GOTO EXIT
+2 WRITE @IOF,!!,?5,"One moment please it may take awhile.",!
QUE USE IO
SET U="^"
KILL ^UTILITY($JOB,"DENTDUP")
SET DENTSD=DENTSD-.0001
+1 FOR A=1:1
SET DENTP=""
SET DENTSD=$ORDER(^DENT(221,"AC1",DENTSTA,DENTSD))
if DENTSD=""!(DENTSD>DENTED)
QUIT
FOR B=1:1
SET N=""
SET DENTP=$ORDER(^DENT(221,"AC1",DENTSTA,DENTSD,DENTP))
if DENTP=""
QUIT
DO BUILDAR
+2 DO REPORT
GOTO EXIT
BUILDAR FOR C=0:0
SET N=$ORDER(^DENT(221,"AC1",DENTSTA,DENTSD,DENTP,N))
if N=""
QUIT
if '$DATA(^DENT(221,N,.1))&($DATA(^DENT(221,N,0)))
SET AR(N)=^(0)
+1 SET D=""
FOR X=0:0
SET F1=""
SET D=$ORDER(AR(D))
if D=""
QUIT
DO SETA
SET D1=D
DO COMP1
if F1=1
SET ^UTILITY($JOB,"DENTDUP",A,D,D)=$PIECE(AR(D),U,1)_U_$PIECE(AR(D),U,2)_U_$PIECE(AR(D),U,39)
KILL AR(D)
+2 QUIT
COMP1 FOR W=1:1
SET D1=$ORDER(AR(D1))
SET E=0
if D1=""
QUIT
DO SETB
if A1=A2!(($PIECE(A1,U,1,3)=$PIECE(A2,U,1,3))&(($PIECE(A1,U,4,41)?."^")!($PIECE(A2,U,4,41)?."^")))
SET ^UTILITY($JOB,"DENTDUP",A,D,D1)=$PIECE(AR(D1),U,1)_U_$PIECE(AR(D1),U,2)_U_$PIECE(AR(D1),U,39)
SET (E,F1)=1
if E
KILL AR(D1)
+1 QUIT
SETA SET A1=$PIECE(AR(D),U,2)_U_$PIECE(AR(D),U,6)_U_$PIECE(AR(D),U,19)_U_$PIECE(AR(D),U,3,4)_U_$PIECE(AR(D),U,7,18)_U_$PIECE(AR(D),U,20,38)_U_$PIECE(AR(D),U,41,45)
QUIT
SETB SET A2=$PIECE(AR(D1),U,2)_U_$PIECE(AR(D1),U,6)_U_$PIECE(AR(D1),U,19)_U_$PIECE(AR(D1),U,3,4)_U_$PIECE(AR(D1),U,7,18)_U_$PIECE(AR(D1),U,20,38)_U_$PIECE(AR(D1),U,41,45)
QUIT
REPORT DO HDR
if '$DATA(^UTILITY($JOB))
QUIT
SET (A,Z5)=""
FOR I=1:1
SET A=$ORDER(^UTILITY($JOB,"DENTDUP",A))
if A=""
QUIT
SET B=""
FOR Y=0:0
SET B=$ORDER(^UTILITY($JOB,"DENTDUP",A,B))
if B=""
QUIT
SET C=""
DO REPORT1
WRITE !
+1 if Z5=U
QUIT
DO HOLD
QUIT
REPORT1 FOR J=0:0
if $Y#(IOSL-2)=0
DO HOLD1
if Z5=U
QUIT
SET C=$ORDER(^UTILITY($JOB,"DENTDUP",A,B,C))
if C=""
QUIT
SET Y=$PIECE(^(C),U,1)
SET Y2=$PIECE(^(C),U,3)
SET Y3=$PIECE(^(C),U,2)
XECUTE ^DD("DD")
WRITE !,?6,Y,?28,Y2,?49,$EXTRACT(Y3,1,3)_"-"_$EXTRACT(Y3,4,5)_"-"_$EXTRACT(Y3,6,9)
+1 QUIT
HOLD1 DO HOLD
if Z5'=U
DO HDR
QUIT
HOLD if $DATA(ZTSK)!(IO'=IO(0))
QUIT
SET Z5=""
READ !,"Press return to continue, uparrow (^) to exit: ",Z5:DTIME
QUIT
HDR SET HD="DUPLICATE TREATMENT DATA REPORT"
SET HD1="STATION: "_DENTSTA
SET H3="("_$SELECT(H1=H2:"For "_H1,1:"From "_H1_" to "_H2)_")"
WRITE @IOF,!,?(80-$LENGTH(HD)/2),HD,!,?(80-$LENGTH(HD1)/2),HD1,!,?(80-$LENGTH(H3)/2),H3
+1 WRITE !!,?6,"DATE TIME",?28,"PATIENT NAME",?49,"SOCIAL SECURITY",!
if '$DATA(^UTILITY($JOB))
WRITE !!,?5,"There are no duplicate records in the time frame you specified."
+2 QUIT
EXIT XECUTE ^%ZIS("C")
KILL A,A1,A2,B,C,D,D1,E,F1,DENTSD,DENTED,DENTP,DENTSD1,DENTSTA,DIC,H1,H2,H3,HD,N,^UTILITY($JOB),W,X,Y,Y2,Y3,Z1,Z2,Z5,ZTRTN,ZTSAVE
if $DATA(ZTSK)
KILL ^%ZTSK(ZTSK),ZTSK
QUIT
