APCDRDEM ; IHS/CMI/LAB - report of visits re-linked ;
;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
;
;
START ;EP - called from option
D XIT
W:$D(IOF) @IOF
W !!,"This option will print a list of visits that were merged into another visit,"
W !,"or that were deleted. If a reason for the deletion/merge can be determined "
W !,"it will be displayed.",!
;
TYPE ;
S APCDTYPE=""
S DIR(0)="S^1:Deleted/Merged Visits by Visit Date Range;2:Deleted/Merged Visits by Date Visit Deleted/Merged",DIR("A")="Which set of Visits",DIR("B")="1" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S APCDTYPE=$E(Y)
GETDATES ;
W !!,"Please enter the range of dates on which the deletion/merge occurred."
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G XIT
S APCDBD=Y
ED ;get ending date
W ! S DIR(0)="D^"_APCDBD_":DT:EP",DIR("A")="Enter ending Date" S Y=APCDBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCDED=Y
S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X S Y=APCDBD D DD^%DT S APCDBDD=Y S Y=APCDED D DD^%DT S APCDEDD=Y
DEMO ;
D DEMOCHK^APCLUTL(.APCDDEMO)
I APCDDEMO=-1 G BD
ZIS ;
S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G XIT
I $G(Y)="B" D BROWSE,XIT Q
W !! S XBRP="PRINT^APCDRDEM",XBRC="PROC^APCDRDEM",XBNS="APCD*",XBRX="XIT^APCDRDEM"
D ^XBDBQUE
D XIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCDRDEM"")"
S XBNS="APCD",XBRC="PROC^APCDRDEM",XBRX="XIT^APCDRDEM",XBIOP=0 D ^XBDBQUE
Q
;
PROC ;EP - called from xbdbque
;loop through all visits in date range and look for problem 8-8.9 or visit type of N
S APCDJOB=$J,APCDTOT=0,APCDBT=$H
S APCDXREF=$S(APCDTYPE=1:"AD",1:"AC")
D XTMP("APCDRDEM","VISIT MERGE/DELETION LIST")
S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
S APCDODAT=APCDSD_".9999" F S APCDODAT=$O(^APCDVDEL(APCDXREF,APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED) D
.S APCDR=0 F S APCDR=$O(^APCDVDEL(APCDXREF,APCDODAT,APCDR)) Q:APCDR'=+APCDR D
..S F=$P(^APCDVDEL(APCDR,0),U) Q:$$DEMO^APCLUTL($P(^AUPNVSIT(F,0),U,5),APCDDEMO)
..S ^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS",APCDODAT,APCDR)="",APCDTOT=APCDTOT+1
Q
PRINT ;EP - called from xbdbque
K APCDQ S APCDPG=0
I '$D(^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS")) D HEADER W !!,"There are no visits in the Visit Delete/Merge Log for that time period.",! Q
D HEADER
S APCDD=0 F S APCDD=$O(^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS",APCDD)) Q:APCDD=""!($D(APCDQ)) D
.;I $Y>(IOSL-5) D HEADER Q:$D(APCDQ)
.;W !!,"Date Deleted/Merged: ",$$FMTE^XLFDT(APCDD)
.S APCDR=0 F S APCDR=$O(^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS",APCDD,APCDR)) Q:APCDR'=+APCDR!($D(APCDQ)) D
..I $Y>(IOSL-4) D HEADER Q:$D(APCDQ)
..S APCDN=^APCDVDEL(APCDR,0)
..S APCDFV=$P(APCDN,U)
..S APCDTV=$P(APCDN,U,4)
..S DFN=$P($G(^AUPNVSIT(APCDFV,0)),U,5)
..W !!,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$E($P(^DPT(DFN,0),U),1,18),?25,$$FMTE^XLFDT($P(^AUPNVSIT(APCDFV,0),U),2)," (",APCDFV,")" I APCDTV W ?53,$$FMTE^XLFDT($P(^AUPNVSIT(APCDTV,0),U),2)," (",APCDTV,")"
..W !?3,"User who Updated: ",$E($$VAL^XBDIQ1(9001003.92,APCDR,.05),1,18)," Date/Time Deleted: ",$$FMTE^XLFDT($P(^APCDVDEL(APCDR,0),U,2))
..W !?3,"Reason for deletion/merge: ",$P($G(^AUPNVSIT(APCDFV,22)),U,1)
W !!,"Total # of Visits: ",APCDTOT,!
K ^XTMP("APCDRDEM",APCDJOB,APCDBT)
XIT ;
D EN^XBVK("APCD")
D KILL^AUPNPAT
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
I 'APCDPG G HEADER1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQ="" Q
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?($S(80=132:120,1:72)),"Page ",APCDPG,!
S APCDTEXT="DELETED/MERGED VISITS"
W !?(80-$L(APCDTEXT)/2),APCDTEXT,!
S APCDTEXT="Deletion/Merge Dates: "_APCDBDD_" and "_APCDEDD
W ?(80-$L(APCDTEXT)/2),APCDTEXT,!
W $TR($J(" ",80)," ","-")
W !,?25,"DELETED/MERGED VISIT",?53,"MERGED TO VISIT"
W !,"HRN",?7,"PATIENT",?25,"DATE/TIME (IEN)",?53,"DATE/TIME (IEN)"
W !,$TR($J(" ",80)," ","-")
Q
DATE(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
;
XTMP(N,D) ;EP - set xtmp 0 node
Q:$G(N)=""
S ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$G(D)
Q
;
;
PURGERL ;EP - CALLED FROM OPTION
D INIT
D GETDATE
I $D(APCDQUIT) D EOJ Q
ZIS1 W !! S %ZIS="PQ" D ^%ZIS
I POP D EOJ Q
I $D(IO("Q")) D TSKMN,EOJ Q
DRIVER ;
D PURGE
W !!,"A Total of ",APCDCNT," Entries Purged.",!
D EOJ
Q
;
INIT ;
W !!,"Purge Data from Visit Delete/Merge Log!"
S APCDCNT=0
K APCDQUIT
Q
;
GETDATE ;
S Y=DT X ^DD("DD") S APCDDTP=Y
S %DT("A")="Purge data up to and including what DELETE/MERGE DATE? ",%DT="AEPX" W ! D ^%DT
I Y=-1 S APCDQUIT="" Q
S APCDPGE=Y X ^DD("DD") S APCDPGEY=Y
Q
;
PURGE ;
S APCDX=0 F S APCDX=$O(^APCDVDEL("AC",APCDX)) Q:APCDX=""!($P(APCDX,".")>APCDPGE) D
.S APCDY=0 F S APCDY=$O(^APCDVDEL("AC",APCDX,APCDY)) Q:APCDY'=+APCDY D
..S DA=APCDY,DIK="^APCDVDEL(" D ^DIK S APCDCNT=APCDCNT+1
Q
;
;
TSKMN ;
K ZTSAVE F %="APCDPGE","APCDCNT" S ZTSAVE(%)=""
S ZTIO=ION,ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCDRDEM",ZTDTH="",ZTDESC="PURGE VISIT DELETE/MERGE FILE" D ^%ZTLOAD
Q
EOJ ;
K APCDCNT,APCDPGE,X,Y,DIC,DA,DIE,DR,%DT,D,D0,D1,DQ,APCDDTP,APCDPGEY,POP,APCDX,APCDDUZ,APCDY
I $D(ZTQUEUED) S ZTREQ="@" K ZTSK
D ^%ZISC
Q
APCDRDEM ; IHS/CMI/LAB - report of visits re-linked ;
+1 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
+2 ;
+3 ;
START ;EP - called from option
+1 DO XIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"This option will print a list of visits that were merged into another visit,"
+4 WRITE !,"or that were deleted. If a reason for the deletion/merge can be determined "
+5 WRITE !,"it will be displayed.",!
+6 ;
TYPE ;
+1 SET APCDTYPE=""
+2 SET DIR(0)="S^1:Deleted/Merged Visits by Visit Date Range;2:Deleted/Merged Visits by Date Visit Deleted/Merged"
SET DIR("A")="Which set of Visits"
SET DIR("B")="1"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO XIT
QUIT
+4 SET APCDTYPE=$EXTRACT(Y)
GETDATES ;
+1 WRITE !!,"Please enter the range of dates on which the deletion/merge occurred."
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET APCDBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_APCDBD_":DT:EP"
SET DIR("A")="Enter ending Date"
SET Y=APCDBD
DO DD^%DT
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCDED=Y
+4 SET X1=APCDBD
SET X2=-1
DO C^%DTC
SET APCDSD=X
SET Y=APCDBD
DO DD^%DT
SET APCDBDD=Y
SET Y=APCDED
DO DD^%DT
SET APCDEDD=Y
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCDDEMO)
+2 IF APCDDEMO=-1
GOTO BD
ZIS ;
+1 SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to "
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+4 WRITE !!
SET XBRP="PRINT^APCDRDEM"
SET XBRC="PROC^APCDRDEM"
SET XBNS="APCD*"
SET XBRX="XIT^APCDRDEM"
+5 DO ^XBDBQUE
+6 DO XIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCDRDEM"")"
+2 SET XBNS="APCD"
SET XBRC="PROC^APCDRDEM"
SET XBRX="XIT^APCDRDEM"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
PROC ;EP - called from xbdbque
+1 ;loop through all visits in date range and look for problem 8-8.9 or visit type of N
+2 SET APCDJOB=$JOB
SET APCDTOT=0
SET APCDBT=$HOROLOG
+3 SET APCDXREF=$SELECT(APCDTYPE=1:"AD",1:"AC")
+4 DO XTMP("APCDRDEM","VISIT MERGE/DELETION LIST")
+5 SET X1=APCDBD
SET X2=-1
DO C^%DTC
SET APCDSD=X
+6 SET APCDODAT=APCDSD_".9999"
FOR
SET APCDODAT=$ORDER(^APCDVDEL(APCDXREF,APCDODAT))
IF APCDODAT=""!((APCDODAT\1)>APCDED)
QUIT
Begin DoDot:1
+7 SET APCDR=0
FOR
SET APCDR=$ORDER(^APCDVDEL(APCDXREF,APCDODAT,APCDR))
IF APCDR'=+APCDR
QUIT
Begin DoDot:2
+8 SET F=$PIECE(^APCDVDEL(APCDR,0),U)
IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(F,0),U,5),APCDDEMO)
QUIT
+9 SET ^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS",APCDODAT,APCDR)=""
SET APCDTOT=APCDTOT+1
End DoDot:2
End DoDot:1
+10 QUIT
PRINT ;EP - called from xbdbque
+1 KILL APCDQ
SET APCDPG=0
+2 IF '$DATA(^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS"))
DO HEADER
WRITE !!,"There are no visits in the Visit Delete/Merge Log for that time period.",!
QUIT
+3 DO HEADER
+4 SET APCDD=0
FOR
SET APCDD=$ORDER(^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS",APCDD))
IF APCDD=""!($DATA(APCDQ))
QUIT
Begin DoDot:1
+5 ;I $Y>(IOSL-5) D HEADER Q:$D(APCDQ)
+6 ;W !!,"Date Deleted/Merged: ",$$FMTE^XLFDT(APCDD)
+7 SET APCDR=0
FOR
SET APCDR=$ORDER(^XTMP("APCDRDEM",APCDJOB,APCDBT,"VISITS",APCDD,APCDR))
IF APCDR'=+APCDR!($DATA(APCDQ))
QUIT
Begin DoDot:2
+8 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCDQ)
QUIT
+9 SET APCDN=^APCDVDEL(APCDR,0)
+10 SET APCDFV=$PIECE(APCDN,U)
+11 SET APCDTV=$PIECE(APCDN,U,4)
+12 SET DFN=$PIECE($GET(^AUPNVSIT(APCDFV,0)),U,5)
+13 WRITE !!,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$EXTRACT($PIECE(^DPT(DFN,0),U),1,18),?25,$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDFV,0),U),2)," (",APCDFV,")"
IF APCDTV
WRITE ?53,$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDTV,0),U),2)," (",APCDTV,")"
+14 WRITE !?3,"User who Updated: ",$EXTRACT($$VAL^XBDIQ1(9001003.92,APCDR,.05),1,18)," Date/Time Deleted: ",$$FMTE^XLFDT($PIECE(^APCDVDEL(APCDR,0),U,2))
+15 WRITE !?3,"Reason for deletion/merge: ",$PIECE($GET(^AUPNVSIT(APCDFV,22)),U,1)
End DoDot:2
End DoDot:1
+16 WRITE !!,"Total # of Visits: ",APCDTOT,!
+17 KILL ^XTMP("APCDRDEM",APCDJOB,APCDBT)
XIT ;
+1 DO EN^XBVK("APCD")
+2 DO KILL^AUPNPAT
+3 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
+1 IF 'APCDPG
GOTO HEADER1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCDQ=""
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 WRITE !?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?($SELECT(80=132:120,1:72)),"Page ",APCDPG,!
+4 SET APCDTEXT="DELETED/MERGED VISITS"
+5 WRITE !?(80-$LENGTH(APCDTEXT)/2),APCDTEXT,!
+6 SET APCDTEXT="Deletion/Merge Dates: "_APCDBDD_" and "_APCDEDD
+7 WRITE ?(80-$LENGTH(APCDTEXT)/2),APCDTEXT,!
+8 WRITE $TRANSLATE($JUSTIFY(" ",80)," ","-")
+9 WRITE !,?25,"DELETED/MERGED VISIT",?53,"MERGED TO VISIT"
+10 WRITE !,"HRN",?7,"PATIENT",?25,"DATE/TIME (IEN)",?53,"DATE/TIME (IEN)"
+11 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+12 QUIT
DATE(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
+3 ;
XTMP(N,D) ;EP - set xtmp 0 node
+1 IF $GET(N)=""
QUIT
+2 SET ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$GET(D)
+3 QUIT
+4 ;
+5 ;
PURGERL ;EP - CALLED FROM OPTION
+1 DO INIT
+2 DO GETDATE
+3 IF $DATA(APCDQUIT)
DO EOJ
QUIT
ZIS1 WRITE !!
SET %ZIS="PQ"
DO ^%ZIS
+1 IF POP
DO EOJ
QUIT
+2 IF $DATA(IO("Q"))
DO TSKMN
DO EOJ
QUIT
DRIVER ;
+1 DO PURGE
+2 WRITE !!,"A Total of ",APCDCNT," Entries Purged.",!
+3 DO EOJ
+4 QUIT
+5 ;
INIT ;
+1 WRITE !!,"Purge Data from Visit Delete/Merge Log!"
+2 SET APCDCNT=0
+3 KILL APCDQUIT
+4 QUIT
+5 ;
GETDATE ;
+1 SET Y=DT
XECUTE ^DD("DD")
SET APCDDTP=Y
+2 SET %DT("A")="Purge data up to and including what DELETE/MERGE DATE? "
SET %DT="AEPX"
WRITE !
DO ^%DT
+3 IF Y=-1
SET APCDQUIT=""
QUIT
+4 SET APCDPGE=Y
XECUTE ^DD("DD")
SET APCDPGEY=Y
+5 QUIT
+6 ;
PURGE ;
+1 SET APCDX=0
FOR
SET APCDX=$ORDER(^APCDVDEL("AC",APCDX))
IF APCDX=""!($PIECE(APCDX,".")>APCDPGE)
QUIT
Begin DoDot:1
+2 SET APCDY=0
FOR
SET APCDY=$ORDER(^APCDVDEL("AC",APCDX,APCDY))
IF APCDY'=+APCDY
QUIT
Begin DoDot:2
+3 SET DA=APCDY
SET DIK="^APCDVDEL("
DO ^DIK
SET APCDCNT=APCDCNT+1
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
+6 ;
TSKMN ;
+1 KILL ZTSAVE
FOR %="APCDPGE","APCDCNT"
SET ZTSAVE(%)=""
+2 SET ZTIO=ION
SET ZTCPU=$GET(IOCPU)
SET ZTRTN="DRIVER^APCDRDEM"
SET ZTDTH=""
SET ZTDESC="PURGE VISIT DELETE/MERGE FILE"
DO ^%ZTLOAD
+3 QUIT
EOJ ;
+1 KILL APCDCNT,APCDPGE,X,Y,DIC,DA,DIE,DR,%DT,D,D0,D1,DQ,APCDDTP,APCDPGEY,POP,APCDX,APCDDUZ,APCDY
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ZTSK
+3 DO ^%ZISC
+4 QUIT
