APCDRDEM.m

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

 ;----------

HEADER ;EP

 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

HEADER1 ;

 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       ;----------

HEADER    ;EP

 +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 

HEADER1   ;

 +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